From adc04486ee5d4b2f20dfdba93f8c4fd52e1ef9b9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 21 Jan 2004 11:35:18 +0100 Subject: [multiple changes] 2004-01-21 Javier Miranda * 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 * 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 * mlib-prj.adb: Minor reformatting 2004-01-21 Thomas Quinot * 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 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 PR ada/10565 * sem_ch9.adb (Analyze_Delay_Alternative): Add expression type check for 'delay until' statement. From-SVN: r76271 --- gcc/ada/7staprop.adb | 4 +-- gcc/ada/ChangeLog | 39 +++++++++++++++++++++++++++++ gcc/ada/Makefile.in | 40 +++++++++++++++++------------- gcc/ada/exp_aggr.adb | 4 ++- gcc/ada/exp_ch9.adb | 46 +++++++++++++++++++++++++++++------ gcc/ada/exp_pakd.adb | 10 ++++---- gcc/ada/mlib-prj.adb | 39 ++++++++++++++--------------- gcc/ada/prj-tree.adb | 25 ++++++++----------- gcc/ada/sem_ch3.adb | 9 ++----- gcc/ada/sem_ch9.adb | 9 ++++++- gcc/ada/vms_conv.adb | 69 ++++++++++++++++++++++++++-------------------------- gcc/ada/xr_tabls.adb | 4 +-- 12 files changed, 184 insertions(+), 114 deletions(-) diff --git a/gcc/ada/7staprop.adb b/gcc/ada/7staprop.adb index 6e71f45..e79d39d 100644 --- a/gcc/ada/7staprop.adb +++ b/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; diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f0642f..23ccd1e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,42 @@ +2004-01-21 Javier Miranda + + * 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 + + * 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 + + * mlib-prj.adb: Minor reformatting + +2004-01-21 Thomas Quinot + + * 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 + + 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 + + PR ada/10565 + * sem_ch9.adb (Analyze_Delay_Alternative): Add expression type check + for 'delay until' statement. + 2004-01-20 Kelley Cook * Make-lang.in: Replace $(docdir) with doc. diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index bfcc541..ee2da91 100644 --- a/gcc/ada/Makefile.in +++ b/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 \ diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index a016925..7113102 100644 --- a/gcc/ada/exp_aggr.adb +++ b/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; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 9f02d51..39a1f31 100644 --- a/gcc/ada/exp_ch9.adb +++ b/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 diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 558e251..36b4b36 100644 --- a/gcc/ada/exp_pakd.adb +++ b/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; diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index daaed1c..7c894e8 100644 --- a/gcc/ada/mlib-prj.adb +++ b/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); diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb index 7e548e8..735b3fe 100644 --- a/gcc/ada/prj-tree.adb +++ b/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; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index e7fb9d4..23c6aa5 100644 --- a/gcc/ada/sem_ch3.adb +++ b/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); diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index d7bff86..454e72c 100644 --- a/gcc/ada/sem_ch9.adb +++ b/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)); diff --git a/gcc/ada/vms_conv.adb b/gcc/ada/vms_conv.adb index e352d80..459d3a1 100644 --- a/gcc/ada/vms_conv.adb +++ b/gcc/ada/vms_conv.adb @@ -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; diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb index f24cbac..a1d45bf 100644 --- a/gcc/ada/xr_tabls.adb +++ b/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; -- cgit v1.1