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 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -218,7 +218,7 @@ package body System.Task_Primitives.Operations is
procedure Abort_Handler (Sig : Signal) is
pragma Warnings (Off, Sig);
T : Task_ID := Self;
T : constant Task_ID := Self;
Result : Interfaces.C.int;
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>
* Make-lang.in: Replace $(docdir) with doc.
......
gcc/ada/Makefile.in
......@@ -144,6 +144,7 @@ exeext =
arext = .a
soext = .so
shext =
hyphen = -
# Define this as & to perform parallel make on a Sequent.
# Note that this has some bugs, and it seems currently necessary
......@@ -1126,6 +1127,7 @@ endif
ifeq ($(strip $(filter-out alpha% ia64 dec vms% openvms% alphavms%,$(host))),)
soext = .exe
hyphen = _
.SUFFIXES: .sym
......@@ -1704,12 +1706,12 @@ install-gnatlib: ../stamp-gnatlib
# for shared libraries on some targets, e.g. on HP-UX where the x
# permission is required.
for file in gnat gnarl; do \
if [ -f rts/lib$$file-$(LIBRARY_VERSION)$(soext) ]; then \
$(INSTALL) rts/lib$$file-$(LIBRARY_VERSION)$(soext) \
if [ -f rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) ]; then \
$(INSTALL) rts/lib$$file$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(DESTDIR)$(ADA_RTL_OBJ_DIR); \
fi; \
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); \
fi; \
done
......@@ -1892,15 +1894,19 @@ gnatlib-shared-default:
gnatlib
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
-o libgnat-$(LIBRARY_VERSION)$(soext) \
-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(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) \
-o libgnarl-$(LIBRARY_VERSION)$(soext) \
-o libgnarl$(hyphen)$(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)
$(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(THREADSLIB)
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:
$(MAKE) $(FLAGS_TO_PASS) \
......@@ -1944,14 +1950,14 @@ gnatlib-shared-win32:
gnatlib
$(RM) rts/libgnat$(soext) rts/libgnarl$(soext)
cd rts; ../../xgcc -B../../ -shared $(TARGET_LIBGCC2_CFLAGS) \
-o libgnat-$(LIBRARY_VERSION)$(soext) \
-o libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(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) \
-o libgnarl-$(LIBRARY_VERSION)$(soext) \
-o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(GNATRTL_TASKING_OBJS) \
$(SO_OPTS)libgnarl-$(LIBRARY_VERSION)$(soext) \
$(THREADSLIB) -Wl,libgnat-$(LIBRARY_VERSION)$(soext)
$(SO_OPTS)libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
$(THREADSLIB) -Wl,libgnat$(hyphen)$(LIBRARY_VERSION)$(soext)
gnatlib-shared-vms:
$(MAKE) $(FLAGS_TO_PASS) \
......@@ -1965,7 +1971,7 @@ gnatlib-shared-vms:
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \
../../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 \
--for-linker=/noinform \
--for-linker=SYMVEC_$$$$.opt \
......@@ -1975,8 +1981,8 @@ gnatlib-shared-vms:
$(SHLIB_SYMVEC) >> SYMVEC_$$$$.opt && \
echo "case_sensitive=NO" >> SYMVEC_$$$$.opt && \
../../xgcc -g -B../../ -nostartfiles -shared -shared-libgcc \
-o libgnarl_$(LIBRARY_VERSION)$(soext) \
libgnarl.a libgnat_$(LIBRARY_VERSION)$(soext) \
-o libgnarl$(hyphen)$(LIBRARY_VERSION)$(soext) \
libgnarl.a libgnat$(hyphen)$(LIBRARY_VERSION)$(soext) \
sys\$$library:trace.exe \
--for-linker=/noinform \
--for-linker=SYMVEC_$$$$.opt \
......
gcc/ada/exp_aggr.adb
......@@ -1949,7 +1949,9 @@ package body Exp_Aggr is
if not Inside_Init_Proc and not Inside_Allocator then
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;
......
gcc/ada/exp_ch9.adb
......@@ -1198,15 +1198,37 @@ package body Exp_Ch9 is
Loc : constant Source_Ptr := Sloc (E);
P : Node_Id;
Decl : Node_Id;
S : Entity_Id := Scope (E);
begin
-- Nothing to do if we already built a master entity for this scope
-- or if there is no task hierarchy.
-- Ada0Y (AI-287): Do not set/get the has_master_entity reminder in
-- 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;
-- Otherwise first build the master entity
......@@ -1226,7 +1248,15 @@ package body Exp_Ch9 is
P := Parent (E);
Insert_Before (P, 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
......
gcc/ada/exp_pakd.adb
......@@ -1061,11 +1061,11 @@ package body Exp_Pakd is
Set_Parent (Len_Expr, Typ);
Analyze_Per_Use_Expression (Len_Expr, Standard_Integer);
-- Use a modular type if possible. We can do this if we are we
-- have static bounds, and the length is small enough, and the
-- length is not zero. We exclude the zero length case because the
-- size of things is always at least one, and the zero length object
-- would have an anomous size.
-- Use a modular type if possible. We can do this if we have
-- static bounds, and the length is small enough, and the length
-- is not zero. We exclude the zero length case because the size
-- of things is always at least one, and the zero length object
-- would have an anomalous size.
if Compile_Time_Known_Value (Len_Expr) then
Len_Bits := Expr_Value (Len_Expr) * Csize;
......
gcc/ada/mlib-prj.adb
......@@ -389,8 +389,9 @@ package body MLib.Prj 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;
begin
if Bind then
Add_Argument (ALI);
......@@ -665,7 +666,7 @@ package body MLib.Prj is
Element : Project_Element;
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
Processed_Projects.Set (Data.Name, True);
......@@ -879,6 +880,7 @@ package body MLib.Prj is
Library_ALIs.Reset;
Interface_ALIs.Reset;
Processed_ALIs.Reset;
for Source in 1 .. Com.Units.Last loop
Unit := Com.Units.Table (Source);
......@@ -924,12 +926,12 @@ package body MLib.Prj is
exit when not Bind;
end if;
end loop;
end;
-- Continue setup and call gnatbind if Bind is True
if Bind then
-- Get an eventual --RTS from the ALI file
if First_ALI /= No_Name then
......@@ -991,7 +993,6 @@ package body MLib.Prj is
Com.Fail ("could not bind standalone library ",
Get_Name_String (Data.Library_Name));
end if;
end if;
-- Compile the binder generated file only if Link is true
......@@ -1196,9 +1197,9 @@ package body MLib.Prj is
-- If in the object directory of an extended project,
-- do not consider generated object files.
if In_Main_Object_Directory or else
Last < 5 or else
Filename (1 .. B_Start'Length) /= B_Start
if In_Main_Object_Directory
or else Last < 5
or else Filename (1 .. B_Start'Length) /= B_Start
then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Filename (1 .. Last);
......@@ -1233,8 +1234,7 @@ package body MLib.Prj is
Check_Libs (ALI_File);
else
-- The object file is a foreign object
-- file.
-- Object file is a foreign object file
Foreigns.Increment_Last;
Foreigns.Table (Foreigns.Last) :=
......@@ -1338,7 +1338,6 @@ package body MLib.Prj is
if Object_Files'Length = 0 then
Com.Fail ("no object files for library """ &
Lib_Filename.all & '"');
end if;
if not Opt.Quiet_Output then
......@@ -1470,8 +1469,7 @@ package body MLib.Prj is
Copy_Dir := Projects.Table (For_Project).Library_Dir;
Clean (Copy_Dir);
-- Call the procedure to build the library, depending on the build
-- mode.
-- Call procedure to build the library, depending on the build mode
case The_Build_Mode is
when Dynamic | Relocatable =>
......@@ -1501,11 +1499,11 @@ package body MLib.Prj is
null;
end case;
-- We need to copy the ALI files from the object directory
-- to the library directory, so that the linker find them there,
-- and does not need to look in the object directory where it would
-- also find the object files; and we don't want that: we want the
-- linker to use the library.
-- We need to copy the ALI files from the object directory to
-- the library directory, so that the linker find them there,
-- and does not need to look in the object directory where it
-- would also find the object files; and we don't want that:
-- we want the linker to use the library.
-- Copy the ALI files and make the copies read-only. For interfaces,
-- mark the copies as interfaces.
......@@ -1521,8 +1519,8 @@ package body MLib.Prj is
and then Projects.Table (For_Project).Library_Src_Dir /= No_Name
then
-- Clean the interface copy directory, if it is not also the
-- library directory. If it is also the library directory, it has
-- already been cleaned before the generation of the library.
-- library directory. If it is also the library directory, it
-- has already been cleaned before generation of the library.
if Projects.Table (For_Project).Library_Src_Dir /= Copy_Dir then
Copy_Dir := Projects.Table (For_Project).Library_Src_Dir;
......@@ -1558,7 +1556,7 @@ package body MLib.Prj is
procedure Check_Context is
begin
-- check that each object file exists
-- Check that each object file exists
for F in Object_Files'Range loop
Check (Object_Files (F).all);
......@@ -1609,7 +1607,6 @@ package body MLib.Prj is
if Is_Obj (Name_Buffer (1 .. Name_Len))
and then Name_Buffer (1 .. B_Start'Length) /= B_Start
then
-- Get the object file time stamp
Obj_TS := File_Stamp (Name_Find);
......
gcc/ada/prj-tree.adb
......@@ -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- --
......@@ -1242,8 +1242,7 @@ package body Prj.Tree is
function Project_File_Includes_Unkept_Comments
(Node : Project_Node_Id) return Boolean
is
Declaration : constant Project_Node_Id :=
Project_Declaration_Of (Node);
Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
begin
return Project_Nodes.Table (Declaration).Flag1;
end Project_File_Includes_Unkept_Comments;
......@@ -1329,7 +1328,8 @@ package body Prj.Tree 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
for J in 1 .. Comments.Last loop
Cmts (J) := Comments.Table (J);
......@@ -1393,7 +1393,7 @@ package body Prj.Tree is
elsif End_Of_Line_Node /= Empty_Node then
declare
Zones : constant Project_Node_Id :=
Comment_Zones_Of (End_Of_Line_Node);
Comment_Zones_Of (End_Of_Line_Node);
begin
Project_Nodes.Table (Zones).Value := Comment_Id;
end;
......@@ -1722,8 +1722,7 @@ package body Prj.Tree is
(Node : Project_Node_Id;
To : Project_Node_Id)
is
Zone : constant Project_Node_Id :=
Comment_Zones_Of (Node);
Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Field2 := To;
end Set_First_Comment_After;
......@@ -1736,8 +1735,7 @@ package body Prj.Tree is
(Node : Project_Node_Id;
To : Project_Node_Id)
is
Zone : constant Project_Node_Id :=
Comment_Zones_Of (Node);
Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Comments := To;
end Set_First_Comment_After_End;
......@@ -1751,8 +1749,7 @@ package body Prj.Tree is
To : Project_Node_Id)
is
Zone : constant Project_Node_Id :=
Comment_Zones_Of (Node);
Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Field1 := To;
end Set_First_Comment_Before;
......@@ -1765,8 +1762,7 @@ package body Prj.Tree is
(Node : Project_Node_Id;
To : Project_Node_Id)
is
Zone : constant Project_Node_Id :=
Comment_Zones_Of (Node);
Zone : constant Project_Node_Id := Comment_Zones_Of (Node);
begin
Project_Nodes.Table (Zone).Field2 := To;
end Set_First_Comment_Before_End;
......@@ -2275,8 +2271,7 @@ package body Prj.Tree is
(Node : Project_Node_Id;
To : Boolean)
is
Declaration : constant Project_Node_Id :=
Project_Declaration_Of (Node);
Declaration : constant Project_Node_Id := Project_Declaration_Of (Node);
begin
Project_Nodes.Table (Declaration).Flag1 := To;
end Set_Project_File_Includes_Unkept_Comments;
......
gcc/ada/sem_ch3.adb
......@@ -2115,13 +2115,8 @@ package body Sem_Ch3 is
case Ekind (T) is
when Array_Kind =>
Set_Ekind (Id, E_Array_Subtype);
-- 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));
Set_Ekind (Id, E_Array_Subtype);
Copy_Array_Subtype_Attributes (Id, T);
when Decimal_Fixed_Point_Kind =>
Set_Ekind (Id, E_Decimal_Fixed_Point_Subtype);
......
gcc/ada/sem_ch9.adb
......@@ -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- --
......@@ -483,6 +483,13 @@ package body Sem_Ch9 is
Pre_Analyze_And_Resolve (Expr);
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);
else
Analyze (Delay_Statement (N));
......
gcc/ada/xr_tabls.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -1413,7 +1413,7 @@ package body Xr_Tabls is
(Sorted : Boolean := True)
return Declaration_Array_Access
is
Arr : Declaration_Array_Access :=
Arr : constant Declaration_Array_Access :=
new Declaration_Array (1 .. Entities_Count);
Decl : Declaration_Reference := Entities_HTable.Get_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