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: Wed, 21 Jan 2004 11:40:22 +0100
- Subject: committed: Ada updates
Tested on x86-linux
--
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.
--
Index: 7staprop.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/7staprop.adb,v
retrieving revision 1.8
diff -u -p -r1.8 7staprop.adb
--- 7staprop.adb 5 Jan 2004 15:20:43 -0000 1.8
+++ 7staprop.adb 21 Jan 2004 09:36:47 -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. --
-- --
-- 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.Oper
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;
Index: exp_aggr.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_aggr.adb,v
retrieving revision 1.13
diff -u -p -r1.13 exp_aggr.adb
--- exp_aggr.adb 12 Jan 2004 11:45:23 -0000 1.13
+++ exp_aggr.adb 21 Jan 2004 09:36:47 -0000
@@ -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;
Index: exp_ch9.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_ch9.adb,v
retrieving revision 1.12
diff -u -p -r1.12 exp_ch9.adb
--- exp_ch9.adb 13 Jan 2004 11:51:31 -0000 1.12
+++ exp_ch9.adb 21 Jan 2004 09:36:47 -0000
@@ -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
Index: exp_pakd.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/exp_pakd.adb,v
retrieving revision 1.8
diff -u -p -r1.8 exp_pakd.adb
--- exp_pakd.adb 12 Jan 2004 11:45:23 -0000 1.8
+++ exp_pakd.adb 21 Jan 2004 09:36:47 -0000
@@ -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;
Index: Makefile.in
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/Makefile.in,v
retrieving revision 1.65
diff -u -p -r1.65 Makefile.in
--- Makefile.in 16 Jan 2004 08:51:38 -0000 1.65
+++ Makefile.in 21 Jan 2004 09:36:47 -0000
@@ -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 \
Index: mlib-prj.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/mlib-prj.adb,v
retrieving revision 1.9
diff -u -p -r1.9 mlib-prj.adb
--- mlib-prj.adb 19 Jan 2004 10:37:59 -0000 1.9
+++ mlib-prj.adb 21 Jan 2004 09:36:48 -0000
@@ -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);
Index: prj-tree.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/prj-tree.adb,v
retrieving revision 1.9
diff -u -p -r1.9 prj-tree.adb
--- prj-tree.adb 8 Dec 2003 10:33:15 -0000 1.9
+++ prj-tree.adb 21 Jan 2004 09:36:48 -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- --
@@ -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;
Index: sem_ch3.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch3.adb,v
retrieving revision 1.28
diff -u -p -r1.28 sem_ch3.adb
--- sem_ch3.adb 12 Jan 2004 11:45:24 -0000 1.28
+++ sem_ch3.adb 21 Jan 2004 09:36:48 -0000
@@ -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);
Index: sem_ch9.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/sem_ch9.adb,v
retrieving revision 1.7
diff -u -p -r1.7 sem_ch9.adb
--- sem_ch9.adb 14 Nov 2003 10:24:43 -0000 1.7
+++ sem_ch9.adb 21 Jan 2004 09:36:48 -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- --
@@ -481,6 +481,13 @@ package body Sem_Ch9 is
else
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);
Index: xr_tabls.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/xr_tabls.adb,v
retrieving revision 1.8
diff -u -p -r1.8 xr_tabls.adb
--- xr_tabls.adb 5 Jan 2004 15:20:47 -0000 1.8
+++ xr_tabls.adb 21 Jan 2004 09:36:48 -0000
@@ -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;
Index: vms_conv.adb
===================================================================
RCS file: /cvs/gcc/gcc/gcc/ada/vms_conv.adb,v
retrieving revision 1.3
diff -u -p -r1.3 vms_conv.adb
--- vms_conv.adb 5 Jan 2004 15:20:47 -0000 1.3
+++ vms_conv.adb 21 Jan 2004 09:36:48 -0000
@@ -793,7 +793,7 @@ package body VMS_Conv is
for C in Real_Command_Type loop
declare
- Command : Item_Ptr := new Command_Item;
+ Command : constant Item_Ptr := new Command_Item;
Last_Switch : Item_Ptr;
-- Last switch in list
@@ -975,8 +975,9 @@ package body VMS_Conv is
P := P + 1; -- bump past =
while P <= SS'Last loop
declare
- Opt : Item_Ptr := new Option_Item;
+ Opt : constant Item_Ptr := new Option_Item;
Q : Natural;
+
begin
-- Link new option item into options list
@@ -1088,7 +1089,6 @@ package body VMS_Conv is
-- The first one must be a command name
if Arg_Num = 1 and then Arg_Idx = Argv'First then
-
Command := Matching_Name (Arg.all, Commands);
if Command = null then
@@ -1159,8 +1159,7 @@ package body VMS_Conv is
if Sw.Translation = T_File
and then Sw.Unix_String
- (Sw.Unix_String'Last)
- /= '='
+ (Sw.Unix_String'Last) /= '='
then
Put (' ');
end if;
@@ -1171,8 +1170,8 @@ package body VMS_Conv is
Put ("=nnn");
Set_Col (53);
- if Sw.Unix_String (Sw.Unix_String'First)
- = '`'
+ if Sw.Unix_String
+ (Sw.Unix_String'First) = '`'
then
Put (Sw.Unix_String
(Sw.Unix_String'First + 1
@@ -1187,8 +1186,8 @@ package body VMS_Conv is
Put ("=xyz");
Set_Col (53);
- if Sw.Unix_String (Sw.Unix_String'First)
- = '`'
+ if Sw.Unix_String
+ (Sw.Unix_String'First) = '`'
then
Put (Sw.Unix_String
(Sw.Unix_String'First + 1
@@ -1208,8 +1207,8 @@ package body VMS_Conv is
Put (Sw.Unix_String.all);
- if Sw.Unix_String (Sw.Unix_String'Last)
- /= '='
+ if Sw.Unix_String
+ (Sw.Unix_String'Last) /= '='
then
Put (' ');
end if;
@@ -1297,8 +1296,8 @@ package body VMS_Conv is
when File | Optional_File =>
declare
Normal_File : constant String_Access :=
- To_Canonical_File_Spec
- (Arg.all);
+ To_Canonical_File_Spec
+ (Arg.all);
begin
Place (' ');
@@ -1314,12 +1313,12 @@ package body VMS_Conv is
when Unlimited_Files =>
declare
- Normal_File :
- constant String_Access :=
- To_Canonical_File_Spec (Arg.all);
+ Normal_File : constant String_Access :=
+ To_Canonical_File_Spec
+ (Arg.all);
- File_Is_Wild : Boolean := False;
- File_List : String_Access_List_Access;
+ File_Is_Wild : Boolean := False;
+ File_List : String_Access_List_Access;
begin
for J in Arg'Range loop
@@ -1599,8 +1598,8 @@ package body VMS_Conv is
(Arg_Num + 1));
Arg_Num := Arg_Num + 1;
Arg_Idx := Argv'First;
- Next_Arg_Idx
- := Get_Arg_End (Argv.all, Arg_Idx);
+ Next_Arg_Idx :=
+ Get_Arg_End (Argv.all, Arg_Idx);
Arg := new String'
(Argv (Arg_Idx .. Next_Arg_Idx));
goto Tryagain_After_Coalesce;
@@ -1621,14 +1620,15 @@ package body VMS_Conv is
declare
Dir_Is_Wild : Boolean := False;
Dir_Maybe_Is_Wild : Boolean := False;
+
Dir_List : String_Access_List_Access;
+
begin
P2 := SwP;
while P2 < Endp
and then Arg (P2 + 1) /= ','
loop
-
-- A wildcard directory spec on
-- VMS will contain either * or
-- % or ...
@@ -1660,8 +1660,9 @@ package body VMS_Conv is
end loop;
if Dir_Is_Wild then
- Dir_List := To_Canonical_File_List
- (Arg (SwP .. P2), True);
+ Dir_List :=
+ To_Canonical_File_List
+ (Arg (SwP .. P2), True);
for J in Dir_List.all'Range loop
Place_Unix_Switches
@@ -1696,7 +1697,7 @@ package body VMS_Conv is
-- here
if Sw.Unix_String
- (Sw.Unix_String'Last) /= '='
+ (Sw.Unix_String'Last) /= '='
then
Place (' ');
end if;
@@ -1722,7 +1723,7 @@ package body VMS_Conv is
if Sw.Translation = T_File
and then Sw.Unix_String
- (Sw.Unix_String'Last) /= '='
+ (Sw.Unix_String'Last) /= '='
then
Place (' ');
end if;
@@ -1733,9 +1734,7 @@ package body VMS_Conv is
end if;
when T_Numeric =>
- if
- OK_Integer (Arg (SwP + 2 .. Arg'Last))
- then
+ if OK_Integer (Arg (SwP + 2 .. Arg'Last)) then
Place_Unix_Switches (Sw.Unix_String);
Place (Arg (SwP + 2 .. Arg'Last));
@@ -1748,9 +1747,8 @@ package body VMS_Conv is
end if;
when T_Alphanumplus =>
- if
- OK_Alphanumerplus
- (Arg (SwP + 2 .. Arg'Last))
+ if OK_Alphanumerplus
+ (Arg (SwP + 2 .. Arg'Last))
then
Place_Unix_Switches (Sw.Unix_String);
Place (Arg (SwP + 2 .. Arg'Last));
@@ -1768,7 +1766,7 @@ package body VMS_Conv is
-- A String value must be extended to the
-- end of the Argv, otherwise strings like
-- "foo/bar" get split at the slash.
- --
+
-- The begining and ending of the string
-- are flagged with embedded nulls which
-- are removed when building the Spawn
@@ -1778,6 +1776,7 @@ package body VMS_Conv is
-- difficult to embed them.
Place_Unix_Switches (Sw.Unix_String);
+
if Next_Arg_Idx /= Argv'Last then
Next_Arg_Idx := Argv'Last;
Arg := new String'
@@ -1789,6 +1788,7 @@ package body VMS_Conv is
SwP := SwP + 1;
end loop;
end if;
+
Place (ASCII.NUL);
Place (Arg (SwP + 2 .. Arg'Last));
Place (ASCII.NUL);
@@ -1803,9 +1803,8 @@ package body VMS_Conv is
Sw.Unix_String'First + 5));
if Sw.Unix_String
- (Sw.Unix_String'First + 7 ..
- Sw.Unix_String'Last) =
- "MAKE"
+ (Sw.Unix_String'First + 7 ..
+ Sw.Unix_String'Last) = "MAKE"
then
Make_Commands_Active := null;