Skip to content

R
riscv-gcc-1
Commit adc04486 by Arnaud Charlet
Options

[multiple changes] 

2004-01-21  Javier Miranda  <miranda@gnat.com>

	* exp_aggr.adb (Build_Record_Aggr_Code): Do not build the master
	entity if already built in the current scope.

	* exp_ch9.adb (Build_Master_Entity): Do not set the has_master_entity
	reminder in internal scopes. Required for nested limited aggregates.

2004-01-21  Doug Rupp  <rupp@gnat.com>

	* Makefile.in (hyphen): New variable, default value '-'. Set to '_' on
	VMS. Replace all occurences of libgnat- and libgnarl- with
	libgnat$(hyphen) and libgnarl$(hyphen).
	Fixed shared library build problem on VMS.

2004-01-21  Robert Dewar  <dewar@gnat.com>

	* mlib-prj.adb: Minor reformatting

2004-01-21  Thomas Quinot  <quinot@act-europe.fr>

	* prj-tree.adb, 7staprop.adb, vms_conv.adb, xr_tabls.adb: Add missing
	'constant' keywords for declaration of pointers that are not modified.

	* exp_pakd.adb: Fix English in comment.

2004-01-21  Ed Schonberg  <schonberg@gnat.com>

	PR ada/10889
	* sem_ch3.adb (Analyze_Subtype_Declaration): For an array subtype,
	copy all attributes of the parent, including the foreign language
	convention.

2004-01-21  Sergey Rybin  <rybin@act-europe.fr>

	PR ada/10565
	* sem_ch9.adb (Analyze_Delay_Alternative): Add expression type check
	for 'delay until' statement.

From-SVN: r76271
parent 1ef82ef2
Showing with 184 additions and 114 deletions
gcc/ada/7staprop.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- -- -- --
-- GNARL is free software; you can redistribute it and/or modify it under -- -- GNARL 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -218,7 +218,7 @@ package body System.Task_Primitives.Operations is ...@@ -218,7 +218,7 @@ package body System.Task_Primitives.Operations is
procedure Abort_Handler (Sig : Signal) is procedure Abort_Handler (Sig : Signal) is
pragma Warnings (Off, Sig); pragma Warnings (Off, Sig);
T : Task_ID := Self; T : constant Task_ID := Self;
Result : Interfaces.C.int; Result : Interfaces.C.int;
Old_Set : aliased sigset_t; Old_Set : aliased sigset_t;
......
gcc/ada/ChangeLog
2004-01-21 Javier Miranda <miranda@gnat.com>
* exp_aggr.adb (Build_Record_Aggr_Code): Do not build the master
entity if already built in the current scope.
* exp_ch9.adb (Build_Master_Entity): Do not set the has_master_entity
reminder in internal scopes. Required for nested limited aggregates.
2004-01-21 Doug Rupp <rupp@gnat.com>
* Makefile.in (hyphen): New variable, default value '-'. Set to '_' on
VMS. Replace all occurences of libgnat- and libgnarl- with
libgnat$(hyphen) and libgnarl$(hyphen).
Fixed shared library build problem on VMS.
2004-01-21 Robert Dewar <dewar@gnat.com>
* mlib-prj.adb: Minor reformatting
2004-01-21 Thomas Quinot <quinot@act-europe.fr>
* prj-tree.adb, 7staprop.adb, vms_conv.adb, xr_tabls.adb: Add missing
'constant' keywords for declaration of pointers that are not modified.
* exp_pakd.adb: Fix English in comment.
2004-01-21 Ed Schonberg <schonberg@gnat.com>
PR ada/10889
* sem_ch3.adb (Analyze_Subtype_Declaration): For an array subtype,
copy all attributes of the parent, including the foreign language
convention.
2004-01-21 Sergey Rybin <rybin@act-europe.fr>
PR ada/10565
* sem_ch9.adb (Analyze_Delay_Alternative): Add expression type check
for 'delay until' statement.
2004-01-20 Kelley Cook <kcook@gcc.gnu.org> 2004-01-20 Kelley Cook <kcook@gcc.gnu.org>
* Make-lang.in: Replace $(docdir) with doc. * Make-lang.in: Replace $(docdir) with doc.
......
gcc/ada/Makefile.in
...@@ -144,6 +144,7 @@ exeext = ...@@ -144,6 +144,7 @@ exeext =
arext = .a arext = .a
soext = .so soext = .so
shext = shext =
hyphen = -
# Define this as & to perform parallel make on a Sequent. # Define this as & to perform parallel make on a Sequent.
# Note that this has some bugs, and it seems currently necessary # Note that this has some bugs, and it seems currently necessary
...@@ -1126,6 +1127,7 @@ endif ...@@ -1126,6 +1127,7 @@ endif
ifeq ($(strip $(filter-out alpha% ia64 dec vms% openvms% alphavms%,$(host))),) ifeq ($(strip $(filter-out alpha% ia64 dec vms% openvms% alphavms%,$(host))),)
soext = .exe soext = .exe
hyphen = _
.SUFFIXES: .sym .SUFFIXES: .sym
...@@ -1704,12 +1706,12 @@ install-gnatlib: ../stamp-gnatlib ...@@ -1704,12 +1706,12 @@ install-gnatlib: ../stamp-gnatlib
# for shared libraries on some targets, e.g. on HP-UX where the x # for shared libraries on some targets, e.g. on HP-UX where the x
# permission is required. # permission is required.
for file in gnat gnarl; do \ for file in gnat gnarl; do \
if [ -f rts/lib$$file-$(LIBRARY_VERSION)$(soext) ]; then \ if [ -f rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) ]; then \
$(INSTALL) rts/lib$$file-$(LIBRARY_VERSION)$(soext) \ $(INSTALL) rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(DESTDIR)$(ADA_RTL_OBJ_DIR); \ $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
fi; \ fi; \
if [ -f rts/lib$$file$(soext) ]; then \ if [ -f rts/lib$$file$(soext) ]; then \
$(LN_S) lib$$file-$(LIBRARY_VERSION)$(soext) \ $(LN_S) lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(DESTDIR)$(ADA_RTL_OBJ_DIR)/lib$$file$(soext); \ $(DESTDIR)$(ADA_RTL_OBJ_DIR)/lib$$file$(soext); \
fi; \ fi; \
done done
...@@ -1892,15 +1894,19 @@ gnatlib-shared-default: ...@@ -1892,15 +1894,19 @@ gnatlib-shared-default:
gnatlib gnatlib
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext) $(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \ cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
-o libgnat-$(LIBRARY_VERSION)$(soext) \ -o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \ $(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
$(SO_OPTS)libgnat-$(LIBRARY_VERSION)$(soext) $(MISCLIB) -lm $(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(MISCLIB) -lm
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \ cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
-o libgnarl-$(LIBRARY_VERSION)$(soext) \ -o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_TASKING_OBJS) \ $(GNATRTL_TASKING_OBJS) \
$(SO_OPTS)libgnarl-$(LIBRARY_VERSION)$(soext) $(THREADSLIB) $(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
cd rts; $(LN_S) libgnat-$(LIBRARY_VERSION)$(soext) libgnat$(soext) $(THREADSLIB)
cd rts; $(LN_S) libgnarl-$(LIBRARY_VERSION)$(soext) libgnarl$(soext) cd rts; $(LN_S) libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
libgnat$(soext)
cd rts; $(LN_S) libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
libgnarl$(soext)
gnatlib-shared-dual: gnatlib-shared-dual:
$(MAKE) $(FLAGS_TO_PASS) \ $(MAKE) $(FLAGS_TO_PASS) \
...@@ -1944,14 +1950,14 @@ gnatlib-shared-win32: ...@@ -1944,14 +1950,14 @@ gnatlib-shared-win32:
gnatlib gnatlib
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext) $(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \ cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
-o libgnat-$(LIBRARY_VERSION)$(soext) \ -o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \ $(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS) \
$(SO_OPTS)libgnat-$(LIBRARY_VERSION)$(soext) $(MISCLIB) $(SO_OPTS)libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) $(MISCLIB)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \ cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
-o libgnarl-$(LIBRARY_VERSION)$(soext) \ -o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_TASKING_OBJS) \ $(GNATRTL_TASKING_OBJS) \
$(SO_OPTS)libgnarl-$(LIBRARY_VERSION)$(soext) \ $(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(THREADSLIB) -Wl,libgnat-$(LIBRARY_VERSION)$(soext) $(THREADSLIB) -Wl,libgnat$(hyphen)$(LIBRARY_VERSION)$(soext)
gnatlib-shared-vms: gnatlib-shared-vms:
$(MAKE) $(FLAGS_TO_PASS) \ $(MAKE) $(FLAGS_TO_PASS) \
...@@ -1965,7 +1971,7 @@ gnatlib-shared-vms: ...@@ -1965,7 +1971,7 @@ gnatlib-shared-vms:
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \ $(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \ echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \
../../xgcc -g -B../../ -nostartfiles -shared -shared-libgcc \ ../../xgcc -g -B../../ -nostartfiles -shared -shared-libgcc \
-o libgnat_$(LIBRARY_VERSION)$(soext) libgnat.a \ -o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) libgnat.a \
sys\$$library:trace.exe \ sys\$$library:trace.exe \
--for-linker=/noinform \ --for-linker=/noinform \
--for-linker=SYMVEC_$$$$.opt \ --for-linker=SYMVEC_$$$$.opt \
...@@ -1975,8 +1981,8 @@ gnatlib-shared-vms: ...@@ -1975,8 +1981,8 @@ gnatlib-shared-vms:
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \ $(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \ echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \
../../xgcc -g -B../../ -nostartfiles -shared -shared-libgcc \ ../../xgcc -g -B../../ -nostartfiles -shared -shared-libgcc \
-o libgnarl_$(LIBRARY_VERSION)$(soext) \ -o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
libgnarl.a libgnat_$(LIBRARY_VERSION)$(soext) \ libgnarl.a libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
sys\$$library:trace.exe \ sys\$$library:trace.exe \
--for-linker=/noinform \ --for-linker=/noinform \
--for-linker=SYMVEC_$$$$.opt \ --for-linker=SYMVEC_$$$$.opt \
......
gcc/ada/exp_aggr.adb
...@@ -1949,7 +1949,9 @@ package body Exp_Aggr is ...@@ -1949,7 +1949,9 @@ package body Exp_Aggr is
if not Inside_Init_Proc and not Inside_Allocator then if not Inside_Init_Proc and not Inside_Allocator then
Build_Activation_Chain_Entity (N); Build_Activation_Chain_Entity (N);
Build_Master_Entity (Etype (N)); if not Has_Master_Entity (Current_Scope) then
Build_Master_Entity (Etype (N));
end if;
end if; end if;
end if; end if;
end; end;
......
gcc/ada/exp_ch9.adb
...@@ -1198,15 +1198,37 @@ package body Exp_Ch9 is ...@@ -1198,15 +1198,37 @@ package body Exp_Ch9 is
Loc : constant Source_Ptr := Sloc (E); Loc : constant Source_Ptr := Sloc (E);
P : Node_Id; P : Node_Id;
Decl : Node_Id; Decl : Node_Id;
S : Entity_Id := Scope (E);
begin begin
-- Nothing to do if we already built a master entity for this scope -- Ada0Y (AI-287): Do not set/get the has_master_entity reminder in
-- or if there is no task hierarchy. -- internal scopes. Required for nested limited aggregates.
if not Extensions_Allowed then
-- Nothing to do if we already built a master entity for this scope
-- or if there is no task hierarchy.
if Has_Master_Entity (Scope (E))
or else Restrictions (No_Task_Hierarchy)
then
return;
end if;
else
-- Ada0Y (AI-287): Similar to the Ãprevious casebut skipping internal
-- scopes. If we are not inside an internal scope this code is
-- equivalent to the previous code.
while Is_Internal (S) loop
S := Scope (S);
end loop;
if Has_Master_Entity (S)
or else Restrictions (No_Task_Hierarchy)
then
return;
end if;
if Has_Master_Entity (Scope (E))
or else Restrictions (No_Task_Hierarchy)
then
return;
end if; end if;
-- Otherwise first build the master entity -- Otherwise first build the master entity
...@@ -1226,7 +1248,15 @@ package body Exp_Ch9 is ...@@ -1226,7 +1248,15 @@ package body Exp_Ch9 is
P := Parent (E); P := Parent (E);
Insert_Before (P, Decl); Insert_Before (P, Decl);
Analyze (Decl); Analyze (Decl);
Set_Has_Master_Entity (Scope (E));
-- Ada0Y (AI-287): Set the has_marter_entity reminder in the
-- non-internal scope selected above.
if not Extensions_Allowed then
Set_Has_Master_Entity (Scope (E));
else
Set_Has_Master_Entity (S);
end if;
-- Now mark the containing scope as a task master -- Now mark the containing scope as a task master
......
gcc/ada/exp_pakd.adb
...@@ -1061,11 +1061,11 @@ package body Exp_Pakd is ...@@ -1061,11 +1061,11 @@ package body Exp_Pakd is
Set_Parent (Len_Expr, Typ); Set_Parent (Len_Expr, Typ);
Analyze_Per_Use_Expression (Len_Expr, Standard_Integer); Analyze_Per_Use_Expression (Len_Expr, Standard_Integer);
-- Use a modular type if possible. We can do this if we are we -- Use a modular type if possible. We can do this if we have
-- have static bounds, and the length is small enough, and the -- static bounds, and the length is small enough, and the length
-- length is not zero. We exclude the zero length case because the -- is not zero. We exclude the zero length case because the size
-- size of things is always at least one, and the zero length object -- of things is always at least one, and the zero length object
-- would have an anomous size. -- would have an anomalous size.
if Compile_Time_Known_Value (Len_Expr) then if Compile_Time_Known_Value (Len_Expr) then
Len_Bits := Expr_Value (Len_Expr) * Csize; Len_Bits := Expr_Value (Len_Expr) * Csize;
......
gcc/ada/mlib-prj.adb
...@@ -389,8 +389,9 @@ package body MLib.Prj is ...@@ -389,8 +389,9 @@ package body MLib.Prj is
----------------- -----------------
procedure Add_ALI_For (Source : Name_Id) is procedure Add_ALI_For (Source : Name_Id) is
ALI : constant String := ALI_File_Name (Get_Name_String (Source)); ALI : constant String := ALI_File_Name (Get_Name_String (Source));
ALI_Id : Name_Id; ALI_Id : Name_Id;
begin begin
if Bind then if Bind then
Add_Argument (ALI); Add_Argument (ALI);
...@@ -665,7 +666,7 @@ package body MLib.Prj is ...@@ -665,7 +666,7 @@ package body MLib.Prj is
Element : Project_Element; Element : Project_Element;
begin begin
-- Nothing to do if process has already been processed. -- Nothing to do if process has already been processed
if not Processed_Projects.Get (Data.Name) then if not Processed_Projects.Get (Data.Name) then
Processed_Projects.Set (Data.Name, True); Processed_Projects.Set (Data.Name, True);
...@@ -879,6 +880,7 @@ package body MLib.Prj is ...@@ -879,6 +880,7 @@ package body MLib.Prj is
Library_ALIs.Reset; Library_ALIs.Reset;
Interface_ALIs.Reset; Interface_ALIs.Reset;
Processed_ALIs.Reset; Processed_ALIs.Reset;
for Source in 1 .. Com.Units.Last loop for Source in 1 .. Com.Units.Last loop
Unit := Com.Units.Table (Source); Unit := Com.Units.Table (Source);
...@@ -924,12 +926,12 @@ package body MLib.Prj is ...@@ -924,12 +926,12 @@ package body MLib.Prj is
exit when not Bind; exit when not Bind;
end if; end if;
end loop; end loop;
end; end;
-- Continue setup and call gnatbind if Bind is True -- Continue setup and call gnatbind if Bind is True
if Bind then if Bind then
-- Get an eventual --RTS from the ALI file -- Get an eventual --RTS from the ALI file
if First_ALI /= No_Name then if First_ALI /= No_Name then
...@@ -991,7 +993,6 @@ package body MLib.Prj is ...@@ -991,7 +993,6 @@ package body MLib.Prj is
Com.Fail ("could not bind standalone library ", Com.Fail ("could not bind standalone library ",
Get_Name_String (Data.Library_Name)); Get_Name_String (Data.Library_Name));
end if; end if;
end if; end if;
-- Compile the binder generated file only if Link is true -- Compile the binder generated file only if Link is true
...@@ -1196,9 +1197,9 @@ package body MLib.Prj is ...@@ -1196,9 +1197,9 @@ package body MLib.Prj is
-- If in the object directory of an extended project, -- If in the object directory of an extended project,
-- do not consider generated object files. -- do not consider generated object files.
if In_Main_Object_Directory or else if In_Main_Object_Directory
Last < 5 or else or else Last < 5
Filename (1 .. B_Start'Length) /= B_Start or else Filename (1 .. B_Start'Length) /= B_Start
then then
Name_Len := Last; Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Filename (1 .. Last); Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
...@@ -1233,8 +1234,7 @@ package body MLib.Prj is ...@@ -1233,8 +1234,7 @@ package body MLib.Prj is
Check_Libs (ALI_File); Check_Libs (ALI_File);
else else
-- The object file is a foreign object -- Object file is a foreign object file
-- file.
Foreigns.Increment_Last; Foreigns.Increment_Last;
Foreigns.Table (Foreigns.Last) := Foreigns.Table (Foreigns.Last) :=
...@@ -1338,7 +1338,6 @@ package body MLib.Prj is ...@@ -1338,7 +1338,6 @@ package body MLib.Prj is
if Object_Files'Length = 0 then if Object_Files'Length = 0 then
Com.Fail ("no object files for library """ & Com.Fail ("no object files for library """ &
Lib_Filename.all & '"'); Lib_Filename.all & '"');
end if; end if;
if not Opt.Quiet_Output then if not Opt.Quiet_Output then
...@@ -1470,8 +1469,7 @@ package body MLib.Prj is ...@@ -1470,8 +1469,7 @@ package body MLib.Prj is
Copy_Dir := Projects.Table (For_Project).Library_Dir; Copy_Dir := Projects.Table (For_Project).Library_Dir;
Clean (Copy_Dir); Clean (Copy_Dir);
-- Call the procedure to build the library, depending on the build -- Call procedure to build the library, depending on the build mode
-- mode.
case The_Build_Mode is case The_Build_Mode is
when Dynamic | Relocatable => when Dynamic | Relocatable =>
...@@ -1501,11 +1499,11 @@ package body MLib.Prj is ...@@ -1501,11 +1499,11 @@ package body MLib.Prj is
null; null;
end case; end case;
-- We need to copy the ALI files from the object directory -- We need to copy the ALI files from the object directory to
-- to the library directory, so that the linker find them there, -- the library directory, so that the linker find them there,
-- and does not need to look in the object directory where it would -- and does not need to look in the object directory where it
-- also find the object files; and we don't want that: we want the -- would also find the object files; and we don't want that:
-- linker to use the library. -- we want the linker to use the library.
-- Copy the ALI files and make the copies read-only. For interfaces, -- Copy the ALI files and make the copies read-only. For interfaces,
-- mark the copies as interfaces. -- mark the copies as interfaces.
...@@ -1521,8 +1519,8 @@ package body MLib.Prj is ...@@ -1521,8 +1519,8 @@ package body MLib.Prj is
and then Projects.Table (For_Project).Library_Src_Dir /= No_Name and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
then then
-- Clean the interface copy directory, if it is not also the -- Clean the interface copy directory, if it is not also the
-- library directory. If it is also the library directory, it has -- library directory. If it is also the library directory, it
-- already been cleaned before the generation of the library. -- has already been cleaned before generation of the library.
if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
Copy_Dir := Projects.Table (For_Project).Library_Src_Dir; Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
...@@ -1558,7 +1556,7 @@ package body MLib.Prj is ...@@ -1558,7 +1556,7 @@ package body MLib.Prj is
procedure Check_Context is procedure Check_Context is
begin begin
-- check that each object file exists -- Check that each object file exists
for F in Object_Files'Range loop for F in Object_Files'Range loop
Check (Object_Files (F).all); Check (Object_Files (F).all);
...@@ -1609,7 +1607,6 @@ package body MLib.Prj is ...@@ -1609,7 +1607,6 @@ package body MLib.Prj is
if Is_Obj (Name_Buffer (1 .. Name_Len)) if Is_Obj (Name_Buffer (1 .. Name_Len))
and then Name_Buffer (1 .. B_Start'Length) /= B_Start and then Name_Buffer (1 .. B_Start'Length) /= B_Start
then then
-- Get the object file time stamp -- Get the object file time stamp
Obj_TS := File_Stamp (Name_Find); Obj_TS := File_Stamp (Name_Find);
......
gcc/ada/prj-tree.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1242,8 +1242,7 @@ package body Prj.Tree is ...@@ -1242,8 +1242,7 @@ package body Prj.Tree is
function Project_File_Includes_Unkept_Comments function Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id) return Boolean (Node : Project_Node_Id) return Boolean
is is
Declaration : constant Project_Node_Id := Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
Project_Declaration_Of (Node);
begin begin
return Project_Nodes.Table (Declaration).Flag1; return Project_Nodes.Table (Declaration).Flag1;
end Project_File_Includes_Unkept_Comments; end Project_File_Includes_Unkept_Comments;
...@@ -1329,7 +1328,8 @@ package body Prj.Tree is ...@@ -1329,7 +1328,8 @@ package body Prj.Tree is
---------- ----------
procedure Save (S : out Comment_State) is procedure Save (S : out Comment_State) is
Cmts : Comments_Ptr := new Comment_Array (1 .. Comments.Last); Cmts : constant Comments_Ptr := new Comment_Array (1 .. Comments.Last);
begin begin
for J in 1 .. Comments.Last loop for J in 1 .. Comments.Last loop
Cmts (J) := Comments.Table (J); Cmts (J) := Comments.Table (J);
...@@ -1393,7 +1393,7 @@ package body Prj.Tree is ...@@ -1393,7 +1393,7 @@ package body Prj.Tree is
elsif End_Of_Line_Node /= Empty_Node then elsif End_Of_Line_Node /= Empty_Node then
declare declare
Zones : constant Project_Node_Id := Zones : constant Project_Node_Id :=
Comment_Zones_Of (End_Of_Line_Node); Comment_Zones_Of (End_Of_Line_Node);
begin begin
Project_Nodes.Table (Zones).Value := Comment_Id; Project_Nodes.Table (Zones).Value := Comment_Id;
end; end;
...@@ -1722,8 +1722,7 @@ package body Prj.Tree is ...@@ -1722,8 +1722,7 @@ package body Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id) To : Project_Node_Id)
is is
Zone : constant Project_Node_Id := Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
Comment_Zones_Of (Node);
begin begin
Project_Nodes.Table (Zone).Field2 := To; Project_Nodes.Table (Zone).Field2 := To;
end Set_First_Comment_After; end Set_First_Comment_After;
...@@ -1736,8 +1735,7 @@ package body Prj.Tree is ...@@ -1736,8 +1735,7 @@ package body Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id) To : Project_Node_Id)
is is
Zone : constant Project_Node_Id := Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
Comment_Zones_Of (Node);
begin begin
Project_Nodes.Table (Zone).Comments := To; Project_Nodes.Table (Zone).Comments := To;
end Set_First_Comment_After_End; end Set_First_Comment_After_End;
...@@ -1751,8 +1749,7 @@ package body Prj.Tree is ...@@ -1751,8 +1749,7 @@ package body Prj.Tree is
To : Project_Node_Id) To : Project_Node_Id)
is is
Zone : constant Project_Node_Id := Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
Comment_Zones_Of (Node);
begin begin
Project_Nodes.Table (Zone).Field1 := To; Project_Nodes.Table (Zone).Field1 := To;
end Set_First_Comment_Before; end Set_First_Comment_Before;
...@@ -1765,8 +1762,7 @@ package body Prj.Tree is ...@@ -1765,8 +1762,7 @@ package body Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Project_Node_Id) To : Project_Node_Id)
is is
Zone : constant Project_Node_Id := Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
Comment_Zones_Of (Node);
begin begin
Project_Nodes.Table (Zone).Field2 := To; Project_Nodes.Table (Zone).Field2 := To;
end Set_First_Comment_Before_End; end Set_First_Comment_Before_End;
...@@ -2275,8 +2271,7 @@ package body Prj.Tree is ...@@ -2275,8 +2271,7 @@ package body Prj.Tree is
(Node : Project_Node_Id; (Node : Project_Node_Id;
To : Boolean) To : Boolean)
is is
Declaration : constant Project_Node_Id := Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
Project_Declaration_Of (Node);
begin begin
Project_Nodes.Table (Declaration).Flag1 := To; Project_Nodes.Table (Declaration).Flag1 := To;
end Set_Project_File_Includes_Unkept_Comments; end Set_Project_File_Includes_Unkept_Comments;
......
gcc/ada/sem_ch3.adb
...@@ -2115,13 +2115,8 @@ package body Sem_Ch3 is ...@@ -2115,13 +2115,8 @@ package body Sem_Ch3 is
case Ekind (T) is case Ekind (T) is
when Array_Kind => when Array_Kind =>
Set_Ekind (Id, E_Array_Subtype); Set_Ekind (Id, E_Array_Subtype);
Copy_Array_Subtype_Attributes (Id, T);
-- Shouldn't we call Copy_Array_Subtype_Attributes here???
Set_First_Index (Id, First_Index (T));
Set_Is_Aliased (Id, Is_Aliased (T));
Set_Is_Constrained (Id, Is_Constrained (T));
when Decimal_Fixed_Point_Kind => when Decimal_Fixed_Point_Kind =>
Set_Ekind (Id, E_Decimal_Fixed_Point_Subtype); Set_Ekind (Id, E_Decimal_Fixed_Point_Subtype);
......
gcc/ada/sem_ch9.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -483,6 +483,13 @@ package body Sem_Ch9 is ...@@ -483,6 +483,13 @@ package body Sem_Ch9 is
Pre_Analyze_And_Resolve (Expr); Pre_Analyze_And_Resolve (Expr);
end if; end if;
if Nkind (Delay_Statement (N)) = N_Delay_Until_Statement and then
not Is_RTE (Base_Type (Etype (Expr)), RO_CA_Time) and then
not Is_RTE (Base_Type (Etype (Expr)), RO_RT_Time)
then
Error_Msg_N ("expect Time types for `DELAY UNTIL`", Expr);
end if;
Check_Restriction (No_Fixed_Point, Expr); Check_Restriction (No_Fixed_Point, Expr);
else else
Analyze (Delay_Statement (N)); Analyze (Delay_Statement (N));
......
gcc/ada/xr_tabls.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1998-2003 Free Software Foundation, Inc. -- -- Copyright (C) 1998-2004 Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1413,7 +1413,7 @@ package body Xr_Tabls is ...@@ -1413,7 +1413,7 @@ package body Xr_Tabls is
(Sorted : Boolean := True) (Sorted : Boolean := True)
return Declaration_Array_Access return Declaration_Array_Access
is is
Arr : Declaration_Array_Access := Arr : constant Declaration_Array_Access :=
new Declaration_Array (1 .. Entities_Count); new Declaration_Array (1 .. Entities_Count);
Decl : Declaration_Reference := Entities_HTable.Get_First; Decl : Declaration_Reference := Entities_HTable.Get_First;
Index : Natural := Arr'First; Index : Natural := Arr'First;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment