This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
committed: Ada updates
- From: Arnaud Charlet <charlet at ACT-Europe dot FR>
- To: gcc-patches at gcc dot gnu dot org
- Date: Thu, 15 Jan 2004 18:24:48 +0100
- Subject: committed: Ada updates
Test on x86-linux
--
2004-01-15 Olivier Hainque <hainque@act-europe.fr>
* decl.c (gnat_to_gnu_entity, E_Variable): Retrieve the object size
also when not defining if a Size clause applies. That information is
not to be ignored.
2004-01-15 Arnaud Charlet <charlet@act-europe.fr>
* Makefile.in (install-gnatlib, gnatlib-shared-default): Set up
symbolic links for the shared gnat run time when needed.
2004-01-15 Vasiliy Fofanov <fofanov@act-europe.fr>
* memtrack.adb (Gmem_Initialize): check that gmem.out could be opened
for writing, and terminate with an error message if not.
2004-01-15 Ed Schonberg <schonberg@gnat.com>
* sem_attr.adb (Resolve_Attribute, case 'Access): Remove spurious
warning on an access to subprogram in an instance, when the target
type is declared in the same generic unit.
(Eval_Attribute): If 'access is known to fail accessibility check,
rewrite as a raise statement.
2004-01-15 GNAT Script <nobody@gnat.com>
* Make-lang.in: Makefile automatically updated
--
Index: decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/decl.c,v
retrieving revision 1.24
diff -u -p -r1.24 decl.c
--- decl.c 5 Jan 2004 15:20:43 -0000 1.24
+++ decl.c 15 Jan 2004 16:23:49 -0000
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2003, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2004, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -548,11 +548,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
}
/* If we are defining the object, see if it has a Size value and
- validate it if so. Then get the new type, if any. */
+ validate it if so. If we are not defining the object and a Size
+ clause applies, simply retrieve the value. We don't want to ignore
+ the clause and it is expected to have been validated already. Then
+ get the new type, if any. */
if (definition)
gnu_size = validate_size (Esize (gnat_entity), gnu_type,
gnat_entity, VAR_DECL, 0,
Has_Size_Clause (gnat_entity));
+ else if (Has_Size_Clause (gnat_entity))
+ gnu_size = UI_To_gnu (Esize (gnat_entity), bitsizetype);
if (gnu_size != 0)
{
Index: Makefile.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.in,v
retrieving revision 1.63
diff -u -p -r1.63 Makefile.in
--- Makefile.in 12 Jan 2004 11:36:13 -0000 1.63
+++ Makefile.in 15 Jan 2004 16:23:49 -0000
@@ -1703,15 +1703,16 @@ install-gnatlib: ../stamp-gnatlib
# of $(INSTALL_DATA). The latter may force a mode inappropriate
# for shared libraries on some targets, e.g. on HP-UX where the x
# permission is required.
-ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(targ))),)
- -for file in rts/lib*$(soext);do \
- $(INSTALL) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
+ for file in gnat gnarl; do \
+ if [ -f rts/lib$$file-$(LIBRARY_VERSION)$(soext) ]; then \
+ $(INSTALL) rts/lib$$file-$(LIBRARY_VERSION)$(soext) \
+ $(ADA_RTL_OBJ_DIR); \
+ fi; \
+ if [ -f rts/lib$$file$(soext) ]; then \
+ $(LN_S) lib$$file-$(LIBRARY_VERSION)$(soext) \
+ $(ADA_RTL_OBJ_DIR)/lib$$file$(soext); \
+ fi; \
done
-else
- -for file in rts/lib*-*$(soext);do \
- $(INSTALL) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
- done
-endif
# This copy must be done preserving the date on the original file.
for file in rts/*.adb rts/*.ads; do \
$(INSTALL_DATA_DATE) $$file $(DESTDIR)$(ADA_INCLUDE_DIR); \
@@ -1898,6 +1899,8 @@ gnatlib-shared-default:
-o libgnarl-$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_TASKING_OBJS) \
$(SO_OPTS)libgnarl-$(LIBRARY_VERSION)$(soext) $(THREADSLIB)
+ cd rts; $(LN_S) libgnat-$(LIBRARY_VERSION)$(soext) libgnat$(soext)
+ cd rts; $(LN_S) libgnarl-$(LIBRARY_VERSION)$(soext) libgnarl$(soext)
gnatlib-shared-dual:
$(MAKE) $(FLAGS_TO_PASS) \
Index: Make-lang.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Make-lang.in,v
retrieving revision 1.69
diff -u -p -r1.69 Make-lang.in
--- Make-lang.in 15 Jan 2004 04:02:23 -0000 1.69
+++ Make-lang.in 15 Jan 2004 16:23:49 -0000
@@ -2516,10 +2516,10 @@ ada/live.o : ada/ada.ads ada/a-except.ad
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
-ada/memtrack.o : ada/ada.ads ada/a-except.ads ada/system.ads \
- ada/s-memory.ads ada/memtrack.adb ada/s-soflin.ads ada/s-stache.ads \
- ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-traceb.ads \
- ada/s-traent.ads ada/s-traent.adb ada/unchconv.ads
+ada/memtrack.o : ada/ada.ads ada/a-except.ads ada/gnat.ads ada/g-io.ads \
+ ada/system.ads ada/s-memory.ads ada/memtrack.adb ada/s-soflin.ads \
+ ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
+ ada/s-traceb.ads ada/s-traent.ads ada/s-traent.adb ada/unchconv.ads
ada/namet.o : ada/ada.ads ada/a-except.ads ada/alloc.ads ada/debug.ads \
ada/gnat.ads ada/g-os_lib.ads ada/g-string.ads ada/gnatvsn.ads \
Index: memtrack.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/memtrack.adb,v
retrieving revision 1.6
diff -u -p -r1.6 memtrack.adb
--- memtrack.adb 21 Oct 2003 13:42:09 -0000 1.6
+++ memtrack.adb 15 Jan 2004 16:23:49 -0000
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2004 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -71,6 +71,7 @@ with Ada.Exceptions;
with System.Soft_Links;
with System.Traceback;
with System.Traceback_Entries;
+with GNAT.IO;
package body System.Memory is
@@ -78,6 +79,7 @@ package body System.Memory is
use System.Soft_Links;
use System.Traceback;
use System.Traceback_Entries;
+ use GNAT.IO;
function c_malloc (Size : size_t) return System.Address;
pragma Import (C, c_malloc, "malloc");
@@ -89,11 +91,15 @@ package body System.Memory is
(Ptr : System.Address; Size : size_t) return System.Address;
pragma Import (C, c_realloc, "realloc");
- type File_Ptr is new System.Address;
+ subtype File_Ptr is System.Address;
function fopen (Path : String; Mode : String) return File_Ptr;
pragma Import (C, fopen);
+ procedure OS_Exit (Status : Integer);
+ pragma Import (C, OS_Exit, "__gnat_os_exit");
+ pragma No_Return (OS_Exit);
+
procedure fwrite
(Ptr : System.Address;
Size : size_t;
@@ -274,6 +280,10 @@ package body System.Memory is
if Needs_Init then
Needs_Init := False;
Gmemfile := fopen (Gmemfname, "wb" & ASCII.NUL);
+ if Gmemfile = System.Null_Address then
+ Put_Line ("Couldn't open gnatmem log file for writing");
+ OS_Exit (255);
+ end if;
fwrite ("GMEM DUMP" & ASCII.LF, 10, 1, Gmemfile);
end if;
end Gmem_Initialize;
Index: sem_attr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_attr.adb,v
retrieving revision 1.17
diff -u -p -r1.17 sem_attr.adb
--- sem_attr.adb 5 Jan 2004 15:20:45 -0000 1.17
+++ sem_attr.adb 15 Jan 2004 16:23:49 -0000
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -4457,6 +4457,18 @@ package body Sem_Attr is
Compile_Time_Known_Attribute (N, Alignment (P_Entity));
return;
+ -- If this is an access attribute that is known to fail accessibility
+ -- check, rewrite accordingly.
+
+ elsif Attribute_Name (N) = Name_Access
+ and then Raises_Constraint_Error (N)
+ then
+ Rewrite (N,
+ Make_Raise_Program_Error (Loc,
+ Reason => PE_Accessibility_Check_Failed));
+ Set_Etype (N, C_Type);
+ return;
+
-- No other cases are foldable (they certainly aren't static, and at
-- the moment we don't try to fold any cases other than these three).
@@ -6501,6 +6513,9 @@ package body Sem_Attr is
null; -- Nothing to check
-- Check the static accessibility rule of 3.10.2(32)
+ -- In an instance body, if subprogram and type are both
+ -- local, other rules prevent dangling references, and no
+ -- warning is needed.
elsif Attr_Id = Attribute_Access
and then Subprogram_Access_Level (Entity (P))
@@ -6510,7 +6525,8 @@ package body Sem_Attr is
Error_Msg_N
("subprogram must not be deeper than access type",
P);
- else
+
+ elsif Scope (Entity (P)) /= Scope (Btyp) then
Error_Msg_N
("subprogram must not be deeper than access type?",
P);
@@ -6521,7 +6537,7 @@ package body Sem_Attr is
-- Check the restriction of 3.10.2(32) that disallows
-- the type of the access attribute to be declared
- -- outside a generic body when the attribute occurs
+ -- outside a generic body when the subprogram is declared
-- within that generic body.
elsif Enclosing_Generic_Body (Entity (P))