diff options
| author | Arnaud Charlet <charlet@act-europe.fr> | 2004-06-28 14:37:05 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@act-europe.fr> | 2004-06-28 14:37:05 +0000 |
| commit | 6c03a9d6fb39237d000c1e24e2f5d33afc71dddf (patch) | |
| tree | c84a063a47e404a2c3fd2bf0942d1e94a944cbfe | |
| parent | e0dff8d457450db04b160085f1be5ca2460bb6c1 (diff) | |
2004-06-28 Robert Dewar <dewar@gnat.com>
* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb,
mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-solaris.adb,
mlib-tgt-vms-alpha.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb,
a-strmap.adb, a-strmap.ads, clean.adb: Minor reformatting
* exp_util.adb (Is_Possibly_Unaligned_Slice): Completely rewritten, to
deal with problem of inefficient slices on machines with strict
alignment, when the slice is a component of a composite.
* checks.adb (Apply_Array_Size_Check): Do not special case 64-bit
machines, we need the check there as well.
2004-06-28 Ed Schonberg <schonberg@gnat.com>
* exp_ch5.adb (Expand_Assign_Array): Use correct condition to
determine safe copying direction for overlapping slice assignments
when component is controlled.
* sem_ch12.adb (Instantiate_Formal_Package): Implicit operations of a
formal derived type in the actual for a formal package are visible in
the enclosing instance.
2004-06-28 Ed Schonberg <schonberg@gnat.com>
PR ada/15600
* sem_util.adb (Trace_Components): Diagnose properly an illegal
circularity involving a private type whose completion includes a
self-referential component.
(Enter_Name): Use Is_Inherited_Operation to distinguish a source
renaming or an instantiation from an implicit derived operation.
2004-06-28 Pascal Obry <obry@gnat.com>
* mlib-tgt-mingw.adb: (Library_Exists_For): Remove "lib" prefix from
DLL.
(Library_File_Name_For): Idem.
2004-06-28 Matthew Gingell <gingell@gnat.com>
* g-traceb.ads: Add explanatory note on the format of addresses
expected by addr2line.
2004-06-28 Jerome Guitton <guitton@act-europe.fr>
* Makefile.in: Force debugging information on s-tasdeb.adb,
a-except.adb and s-assert.adb needed by the debugger.
2004-06-28 Vincent Celier <celier@gnat.com>
* make.adb (Collect_Arguments_And_Compile): Change Flag1 to
Need_To_Build_Lib.
(Gnatmake): Ditto.
* mlib-prj.adb (Check_Library): Replace Flag1 with Need_To_Build_Lib
* prj.adb: Minor reformatting
(Project_Empty): Change Flag1 to Need_To_Build_Lib. Remove Flag2.
* prj.ads: Comment updates
Minor reformatting
(Project_Data): Change Flag1 to Need_To_Build_Lib.
Remove Flag2: not used.
* prj-dect.adb (Parse_Declarative_Items): Accept "null" as a
declaration.
* gnat_ugn.texi: Put a "null;" declaration in one project file example
* gnat_rm.texi: Document Empty declarations "null;".
* makegpr.adb (Compile_Link_With_Gnatmake): Put the global archives in
front of the linker options.
(Link_Foreign): Put the global archives and the libraries in front of
the linker options.
2004-06-28 Javier Miranda <miranda@gnat.com>
* rtsfind.adb: (Get_Unit_Name): Fix typo in comment
(RTU_Loaded): Code cleanup
(Set_RTU_Loaded): New procedure to register as *loaded* explicitly
withed predefined units.
* rtsfind.ads (Set_RTU_Loaded): New procedure to register as *loaded*
explicitly withed predefined units.
Fix typo in comment
* sem_ch10.adb (Analyze_Compilation_Unit): Register as *loaded*
explicitly withed predefined units.
git-svn-id: https://gcc.gnu.org/svn/gcc/trunk@83789 138bc75d-0d04-0410-961f-82ee72b054a4
31 files changed, 564 insertions, 317 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 38108d94cf4..77132fbcd98 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,95 @@ +2004-06-28 Robert Dewar <dewar@gnat.com> + + * mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb, + mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb, + mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-solaris.adb, + mlib-tgt-vms-alpha.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, + a-strmap.adb, a-strmap.ads, clean.adb: Minor reformatting + + * exp_util.adb (Is_Possibly_Unaligned_Slice): Completely rewritten, to + deal with problem of inefficient slices on machines with strict + alignment, when the slice is a component of a composite. + + * checks.adb (Apply_Array_Size_Check): Do not special case 64-bit + machines, we need the check there as well. + +2004-06-28 Ed Schonberg <schonberg@gnat.com> + + * exp_ch5.adb (Expand_Assign_Array): Use correct condition to + determine safe copying direction for overlapping slice assignments + when component is controlled. + + * sem_ch12.adb (Instantiate_Formal_Package): Implicit operations of a + formal derived type in the actual for a formal package are visible in + the enclosing instance. + +2004-06-28 Ed Schonberg <schonberg@gnat.com> + + PR ada/15600 + * sem_util.adb (Trace_Components): Diagnose properly an illegal + circularity involving a private type whose completion includes a + self-referential component. + (Enter_Name): Use Is_Inherited_Operation to distinguish a source + renaming or an instantiation from an implicit derived operation. + +2004-06-28 Pascal Obry <obry@gnat.com> + + * mlib-tgt-mingw.adb: (Library_Exists_For): Remove "lib" prefix from + DLL. + (Library_File_Name_For): Idem. + +2004-06-28 Matthew Gingell <gingell@gnat.com> + + * g-traceb.ads: Add explanatory note on the format of addresses + expected by addr2line. + +2004-06-28 Jerome Guitton <guitton@act-europe.fr> + + * Makefile.in: Force debugging information on s-tasdeb.adb, + a-except.adb and s-assert.adb needed by the debugger. + +2004-06-28 Vincent Celier <celier@gnat.com> + + * make.adb (Collect_Arguments_And_Compile): Change Flag1 to + Need_To_Build_Lib. + (Gnatmake): Ditto. + + * mlib-prj.adb (Check_Library): Replace Flag1 with Need_To_Build_Lib + + * prj.adb: Minor reformatting + (Project_Empty): Change Flag1 to Need_To_Build_Lib. Remove Flag2. + + * prj.ads: Comment updates + Minor reformatting + (Project_Data): Change Flag1 to Need_To_Build_Lib. + Remove Flag2: not used. + + * prj-dect.adb (Parse_Declarative_Items): Accept "null" as a + declaration. + + * gnat_ugn.texi: Put a "null;" declaration in one project file example + + * gnat_rm.texi: Document Empty declarations "null;". + + * makegpr.adb (Compile_Link_With_Gnatmake): Put the global archives in + front of the linker options. + (Link_Foreign): Put the global archives and the libraries in front of + the linker options. + +2004-06-28 Javier Miranda <miranda@gnat.com> + + * rtsfind.adb: (Get_Unit_Name): Fix typo in comment + (RTU_Loaded): Code cleanup + (Set_RTU_Loaded): New procedure to register as *loaded* explicitly + withed predefined units. + + * rtsfind.ads (Set_RTU_Loaded): New procedure to register as *loaded* + explicitly withed predefined units. + Fix typo in comment + + * sem_ch10.adb (Analyze_Compilation_Unit): Register as *loaded* + explicitly withed predefined units. + 2004-06-25 Pascal Obry <obry@gnat.com> * makegpr.adb (Build_Library): Remove parameter Lib_Address and diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index 84d12a62ba9..f7bcfe0c5a6 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -1892,6 +1892,28 @@ endif s-traceb.o : s-traceb.adb $(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) \ $(NO_SIBLING_ADAFLAGS) $(ADA_INCLUDES) \ + $< $(OUTPUT_OPTION) + +# force debugging information on s-tasdeb.o so that it is always +# possible to set conditional breakpoints on tasks. + +s-tasdeb.o : s-tasdeb.adb s-tasdeb.ads + $(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) \ + $< $(OUTPUT_OPTION) + +# force debugging information on a-except.o so that it is always +# possible to set conditional breakpoints on exceptions. +# use -O1 otherwise gdb isn't able to get a full backtrace on mips targets. + +a-except.o : a-except.adb a-except.ads + $(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O1 -fno-inline \ + $(ADA_INCLUDES) $< $(OUTPUT_OPTION) + +# force debugging information on s-assert.o so that it is always +# possible to set breakpoint on assert failures. + +s-assert.o : s-assert.adb s-assert.ads a-except.ads + $(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O2 $(ADA_INCLUDES) \ $< $(OUTPUT_OPTION) adadecode.o : adadecode.c adadecode.h diff --git a/gcc/ada/a-strmap.adb b/gcc/ada/a-strmap.adb index ba02086a316..9c6edda677b 100644 --- a/gcc/ada/a-strmap.adb +++ b/gcc/ada/a-strmap.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2002 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- -- @@ -54,7 +54,7 @@ package body Ada.Strings.Maps is -- "=" -- --------- - function "=" (Left, Right : in Character_Set) return Boolean is + function "=" (Left, Right : Character_Set) return Boolean is begin return Character_Set_Internal (Left) = Character_Set_Internal (Right); end "="; @@ -63,7 +63,7 @@ package body Ada.Strings.Maps is -- "and" -- ----------- - function "and" (Left, Right : in Character_Set) return Character_Set is + function "and" (Left, Right : Character_Set) return Character_Set is begin return Character_Set (Character_Set_Internal (Left) and Character_Set_Internal (Right)); @@ -73,7 +73,7 @@ package body Ada.Strings.Maps is -- "not" -- ----------- - function "not" (Right : in Character_Set) return Character_Set is + function "not" (Right : Character_Set) return Character_Set is begin return Character_Set (not Character_Set_Internal (Right)); end "not"; @@ -82,7 +82,7 @@ package body Ada.Strings.Maps is -- "or" -- ---------- - function "or" (Left, Right : in Character_Set) return Character_Set is + function "or" (Left, Right : Character_Set) return Character_Set is begin return Character_Set (Character_Set_Internal (Left) or Character_Set_Internal (Right)); @@ -92,7 +92,7 @@ package body Ada.Strings.Maps is -- "xor" -- ----------- - function "xor" (Left, Right : in Character_Set) return Character_Set is + function "xor" (Left, Right : Character_Set) return Character_Set is begin return Character_Set (Character_Set_Internal (Left) xor Character_Set_Internal (Right)); @@ -104,8 +104,7 @@ package body Ada.Strings.Maps is function Is_In (Element : Character; - Set : Character_Set) - return Boolean + Set : Character_Set) return Boolean is begin return Set (Element); @@ -117,8 +116,7 @@ package body Ada.Strings.Maps is function Is_Subset (Elements : Character_Set; - Set : Character_Set) - return Boolean + Set : Character_Set) return Boolean is begin return (Elements and Set) = Elements; @@ -128,7 +126,7 @@ package body Ada.Strings.Maps is -- To_Domain -- --------------- - function To_Domain (Map : in Character_Mapping) return Character_Sequence + function To_Domain (Map : Character_Mapping) return Character_Sequence is Result : String (1 .. Map'Length); J : Natural; @@ -150,8 +148,7 @@ package body Ada.Strings.Maps is ---------------- function To_Mapping - (From, To : in Character_Sequence) - return Character_Mapping + (From, To : Character_Sequence) return Character_Mapping is Result : Character_Mapping; Inserted : Character_Set := Null_Set; @@ -183,11 +180,10 @@ package body Ada.Strings.Maps is -- To_Range -- -------------- - function To_Range (Map : in Character_Mapping) return Character_Sequence + function To_Range (Map : Character_Mapping) return Character_Sequence is Result : String (1 .. Map'Length); J : Natural; - begin J := 0; for C in Map'Range loop @@ -204,7 +200,7 @@ package body Ada.Strings.Maps is -- To_Ranges -- --------------- - function To_Ranges (Set : in Character_Set) return Character_Ranges is + function To_Ranges (Set : Character_Set) return Character_Ranges is Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1); Range_Num : Natural; C : Character; @@ -214,7 +210,7 @@ package body Ada.Strings.Maps is Range_Num := 0; loop - -- Skip gap between subsets. + -- Skip gap between subsets while not Set (C) loop exit when C = Character'Last; @@ -226,7 +222,7 @@ package body Ada.Strings.Maps is Range_Num := Range_Num + 1; Max_Ranges (Range_Num).Low := C; - -- Span a subset. + -- Span a subset loop exit when not Set (C) or else C = Character'Last; @@ -248,13 +244,9 @@ package body Ada.Strings.Maps is -- To_Sequence -- ----------------- - function To_Sequence - (Set : Character_Set) - return Character_Sequence - is + function To_Sequence (Set : Character_Set) return Character_Sequence is Result : String (1 .. Character'Pos (Character'Last) + 1); Count : Natural := 0; - begin for Char in Set'Range loop if Set (Char) then @@ -270,9 +262,8 @@ package body Ada.Strings.Maps is -- To_Set -- ------------ - function To_Set (Ranges : in Character_Ranges) return Character_Set is + function To_Set (Ranges : Character_Ranges) return Character_Set is Result : Character_Set; - begin for C in Result'Range loop Result (C) := False; @@ -287,9 +278,8 @@ package body Ada.Strings.Maps is return Result; end To_Set; - function To_Set (Span : in Character_Range) return Character_Set is + function To_Set (Span : Character_Range) return Character_Set is Result : Character_Set; - begin for C in Result'Range loop Result (C) := False; @@ -304,7 +294,6 @@ package body Ada.Strings.Maps is function To_Set (Sequence : Character_Sequence) return Character_Set is Result : Character_Set := Null_Set; - begin for J in Sequence'Range loop Result (Sequence (J)) := True; @@ -315,7 +304,6 @@ package body Ada.Strings.Maps is function To_Set (Singleton : Character) return Character_Set is Result : Character_Set := Null_Set; - begin Result (Singleton) := True; return Result; @@ -325,9 +313,10 @@ package body Ada.Strings.Maps is -- Value -- ----------- - function Value (Map : in Character_Mapping; Element : in Character) - return Character is - + function Value + (Map : Character_Mapping; + Element : Character) return Character + is begin return Map (Element); end Value; diff --git a/gcc/ada/a-strmap.ads b/gcc/ada/a-strmap.ads index 41cedea3b34..3e5adf27cf8 100644 --- a/gcc/ada/a-strmap.ads +++ b/gcc/ada/a-strmap.ads @@ -61,48 +61,44 @@ pragma Preelaborate (Maps); type Character_Ranges is array (Positive range <>) of Character_Range; - function To_Set (Ranges : in Character_Ranges) return Character_Set; + function To_Set (Ranges : Character_Ranges) return Character_Set; - function To_Set (Span : in Character_Range) return Character_Set; + function To_Set (Span : Character_Range) return Character_Set; - function To_Ranges (Set : in Character_Set) return Character_Ranges; + function To_Ranges (Set : Character_Set) return Character_Ranges; ---------------------------------- -- Operations on Character Sets -- ---------------------------------- - function "=" (Left, Right : in Character_Set) return Boolean; + function "=" (Left, Right : Character_Set) return Boolean; - function "not" (Right : in Character_Set) return Character_Set; - function "and" (Left, Right : in Character_Set) return Character_Set; - function "or" (Left, Right : in Character_Set) return Character_Set; - function "xor" (Left, Right : in Character_Set) return Character_Set; - function "-" (Left, Right : in Character_Set) return Character_Set; + function "not" (Right : Character_Set) return Character_Set; + function "and" (Left, Right : Character_Set) return Character_Set; + function "or" (Left, Right : Character_Set) return Character_Set; + function "xor" (Left, Right : Character_Set) return Character_Set; + function "-" (Left, Right : Character_Set) return Character_Set; function Is_In - (Element : in Character; - Set : in Character_Set) - return Boolean; + (Element : Character; + Set : Character_Set) return Boolean; function Is_Subset - (Elements : in Character_Set; - Set : in Character_Set) - return Boolean; + (Elements : Character_Set; + Set : Character_Set) return Boolean; function "<=" - (Left : in Character_Set; - Right : in Character_Set) - return Boolean + (Left : Character_Set; + Right : Character_Set) return Boolean renames Is_Subset; subtype Character_Sequence is String; -- Alternative representation for a set of character values - function To_Set (Sequence : in Character_Sequence) return Character_Set; + function To_Set (Sequence : Character_Sequence) return Character_Set; + function To_Set (Singleton : Character) return Character_Set; - function To_Set (Singleton : in Character) return Character_Set; - - function To_Sequence (Set : in Character_Set) return Character_Sequence; + function To_Sequence (Set : Character_Set) return Character_Sequence; ------------------------------------ -- Character Mapping Declarations -- @@ -112,9 +108,8 @@ pragma Preelaborate (Maps); -- Representation for a character to character mapping: function Value - (Map : in Character_Mapping; - Element : in Character) - return Character; + (Map : Character_Mapping; + Element : Character) return Character; Identity : constant Character_Mapping; @@ -123,19 +118,16 @@ pragma Preelaborate (Maps); ---------------------------- function To_Mapping - (From, To : in Character_Sequence) - return Character_Mapping; + (From, To : Character_Sequence) return Character_Mapping; function To_Domain - (Map : in Character_Mapping) - return Character_Sequence; + (Map : Character_Mapping) return Character_Sequence; function To_Range - (Map : in Character_Mapping) - return Character_Sequence; + (Map : Character_Mapping) return Character_Sequence; type Character_Mapping_Function is - access function (From : in Character) return Character; + access function (From : Character) return Character; private pragma Inline (Is_In); diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index b9c4004df6b..122a94c520f 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -831,13 +831,6 @@ package body Checks is if Size_Known_At_Compile_Time (Typ) then return; end if; - - -- No problem on 64-bit machines, we just don't bother with - -- the case where the size in bytes overflows 64-bits. - - if System_Address_Size = 64 then - return; - end if; end if; -- Following code is temporarily deleted, since GCC 3 is returning diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 4a3895044a3..0f06fd394b0 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -325,15 +325,14 @@ package body Clean is procedure Clean_Archive (Project : Project_Id) is Current_Dir : constant Dir_Name_Str := Get_Current_Dir; - Data : constant Project_Data := Projects.Table (Project); Archive_Name : constant String := - "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext; + "lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext; -- The name of the archive file for this project Archive_Dep_Name : constant String := - "lib" & Get_Name_String (Data.Name) & ".deps"; + "lib" & Get_Name_String (Data.Name) & ".deps"; -- The name of the archive dependency file for this project Obj_Dir : constant String := Get_Name_String (Data.Object_Directory); @@ -439,8 +438,7 @@ package body Clean is Extract_From_Q (Lib_File); Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File); - -- If we have an existing ALI file that is not read-only, - -- process it. + -- If we have existing ALI file that is not read-only, process it if Full_Lib_File /= No_File and then not Is_Readonly_Library (Full_Lib_File) @@ -484,8 +482,7 @@ package body Clean is end if; end if; - -- Now, delete all the existing files corresponding to this - -- ALI file. + -- Now delete all existing files corresponding to this ALI file declare Obj_Dir : constant String := @@ -515,9 +512,10 @@ package body Clean is for J in 1 .. Sources.Last loop declare Deb : constant String := - Debug_File_Name (Sources.Table (J)); + Debug_File_Name (Sources.Table (J)); Rep : constant String := - Repinfo_File_Name (Sources.Table (J)); + Repinfo_File_Name (Sources.Table (J)); + begin if Is_Regular_File (Obj_Dir & Dir_Separator & Deb) then Delete (Obj_Dir, Deb); @@ -557,8 +555,7 @@ package body Clean is procedure Clean_Project (Project : Project_Id) is Main_Source_File : File_Name_Type; - -- Name of the executable on the command line, without directory - -- information. + -- Name of executable on the command line without directory info Executable : Name_Id; -- Name of the executable file @@ -610,7 +607,8 @@ package body Clean is begin Change_Dir (Obj_Dir); - -- First, deal with Ada. + -- First, deal with Ada + -- Look through the units to find those that are either immediate -- sources or inherited sources of the project. @@ -765,8 +763,9 @@ package body Clean is end if; if Data.Other_Sources_Present then + -- There is non-Ada code: delete the object files and - -- the dependency files, if they exist. + -- the dependency files if they exist. Source_Id := Data.First_Other_Source; @@ -1093,8 +1092,8 @@ package body Clean is Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity); - -- Parse the project file. - -- If there is an error, Main_Project will still be No_Project. + -- Parse the project file. If there is an error, Main_Project + -- will still be No_Project. Prj.Pars.Parse (Project => Main_Project, @@ -1103,8 +1102,7 @@ package body Clean is Process_Languages => All_Languages); if Main_Project = No_Project then - Fail ("""" & Project_File_Name.all & - """ processing failed"); + Fail ("""" & Project_File_Name.all & """ processing failed"); end if; if Opt.Verbose_Mode then @@ -1311,7 +1309,8 @@ package body Clean is procedure Parse_Cmd_Line is Source_Index : Int := 0; Index : Positive := 1; - Last : constant Natural := Argument_Count; + Last : constant Natural := Argument_Count; + begin while Index <= Last loop declare diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 43fcf3b8bb1..8bbcb091826 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -826,8 +826,8 @@ package body Exp_Ch5 is -- the explicit bounds of right- and left-hand side. declare - Proc : constant Node_Id := - TSS (Base_Type (L_Type), TSS_Slice_Assign); + Proc : constant Node_Id := + TSS (Base_Type (L_Type), TSS_Slice_Assign); Actuals : List_Id; begin @@ -840,7 +840,10 @@ package body Exp_Ch5 is Duplicate_Subexpr (Left_Hi, Name_Req => True), Duplicate_Subexpr (Right_Lo, Name_Req => True), Duplicate_Subexpr (Right_Hi, Name_Req => True)); - Append_To (Actuals, Condition); + + Append_To (Actuals, + Make_Op_Not (Loc, + Right_Opnd => Condition)); Rewrite (N, Make_Procedure_Call_Statement (Loc, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index e90c491b554..9e1a7ec1c5f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -2384,34 +2384,6 @@ package body Exp_Util is --------------------------------- function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is - - function Has_Non_Trivial_Component_Clause (E : Entity_Id) return Boolean; - -- Check whether the component clause might place the component at an - -- alignment that will require the use of a copy when a slice is passed - -- as a parameter. The code is conservative because at this point the - -- expander does not know the alignment choice that the back-end will - -- make. For now we return true if the component is not the first one - -- in the enclosing record. This routine is a place holder for further - -- analysis of this kind. - - -------------------------------------- - -- Has_Non_Trivial_Component_Clause -- - -------------------------------------- - - function Has_Non_Trivial_Component_Clause (E : Entity_Id) return Boolean - is - Rep_Clause : constant Node_Id := Component_Clause (E); - begin - if No (Rep_Clause) then - return False; - else - return Intval (Position (Rep_Clause)) /= Uint_0 - or else Intval (First_Bit (Rep_Clause)) /= Uint_0; - end if; - end Has_Non_Trivial_Component_Clause; - - -- Start of processing for Is_Possibly_Unaligned_Slice - begin -- ??? GCC3 will eventually handle strings with arbitrary alignments, -- but for now the following check must be disabled. @@ -2420,6 +2392,8 @@ package body Exp_Util is -- return False; -- end if; + -- For renaming case, go to renamed object + if Is_Entity_Name (P) and then Is_Object (Entity (P)) and then Present (Renamed_Object (Entity (P))) @@ -2427,57 +2401,121 @@ package body Exp_Util is return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (P))); end if; - -- We only need to worry if the target has strict alignment, unless - -- it is a nested record component with a component clause, which - -- Gigi does not handle well. This patch should disappear with GCC 3.0 - -- and it is not clear why it is needed even when the representation - -- clause is a confirming one, but in its absence gigi complains that - -- the slice is not addressable.??? + -- The reference must be a slice - if not Target_Strict_Alignment then - if Nkind (P) /= N_Slice - or else Nkind (Prefix (P)) /= N_Selected_Component - or else Nkind (Prefix (Prefix (P))) /= N_Selected_Component - then - return False; - end if; + if Nkind (P) /= N_Slice then + return False; end if; - -- The reference must be a slice + -- Always assume the worst for a nested record component with a + -- component clause, which gigi/gcc does not appear to handle well. + -- It is not clear why this special test is needed at all ??? - if Nkind (P) /= N_Slice then + if Nkind (Prefix (P)) = N_Selected_Component + and then Nkind (Prefix (Prefix (P))) = N_Selected_Component + and then + Present (Component_Clause (Entity (Selector_Name (Prefix (P))))) + then + return True; + end if; + + -- We only need to worry if the target has strict alignment + + if not Target_Strict_Alignment then return False; end if; -- If it is a slice, then look at the array type being sliced declare - Pref : constant Node_Id := Prefix (P); - Typ : constant Entity_Id := Etype (Prefix (P)); + Sarr : constant Node_Id := Prefix (P); + -- Prefix of the slice, i.e. the array being sliced + + Styp : constant Entity_Id := Etype (Prefix (P)); + -- Type of the array being sliced + + Pref : Node_Id; + Ptyp : Entity_Id; begin - -- The worrisome case is one where we don't know the alignment - -- of the array, or we know it and it is greater than 1 (if the - -- alignment is one, then obviously it cannot be misaligned). + -- The problems arise if the array object that is being sliced + -- is a component of a record or array, and we cannot guarantee + -- the alignment of the array within its containing object. - if Known_Alignment (Typ) and then Alignment (Typ) = 1 then - return False; - end if; + -- To investigate this, we look at successive prefixes to see + -- if we have a worrisome indexed or selected component. - -- The only way we can be unaligned is if the array being sliced - -- is a component of a record, and either the record is packed, - -- or the component has a component clause, or the record has - -- a specified alignment (that might be too small). + Pref := Sarr; + loop + -- Case of array is part of an indexed component reference - return - Nkind (Pref) = N_Selected_Component - and then - (Is_Packed (Etype (Prefix (Pref))) - or else - Known_Alignment (Etype (Prefix (Pref))) - or else - Has_Non_Trivial_Component_Clause - (Entity (Selector_Name (Pref)))); + if Nkind (Pref) = N_Indexed_Component then + Ptyp := Etype (Prefix (Pref)); + + -- The only problematic case is when the array is packed, + -- in which case we really know nothing about the alignment + -- of individual components. + + if Is_Bit_Packed_Array (Ptyp) then + return True; + end if; + + -- Case of array is part of a selected component reference + + elsif Nkind (Pref) = N_Selected_Component then + Ptyp := Etype (Prefix (Pref)); + + -- We are definitely in trouble if the record in question + -- has an alignment, and either we know this alignment is + -- inconsistent with the alignment of the slice, or we + -- don't know what the alignment of the slice should be. + + if Known_Alignment (Ptyp) + and then (Unknown_Alignment (Styp) + or else Alignment (Styp) > Alignment (Ptyp)) + then + return True; + end if; + + -- We are in potential trouble if the record type is packed. + -- We could special case when we know that the array is the + -- first component, but that's not such a simple case ??? + + if Is_Packed (Ptyp) then + return True; + end if; + + -- We are in trouble if there is a component clause, and + -- either we do not know the alignment of the slice, or + -- the alignment of the slice is inconsistent with the + -- bit position specified by the component clause. + + declare + Field : constant Entity_Id := Entity (Selector_Name (Pref)); + begin + if Present (Component_Clause (Field)) + and then + (Unknown_Alignment (Styp) + or else + (Component_Bit_Offset (Field) mod + (System_Storage_Unit * Alignment (Styp))) /= 0) + then + return True; + end if; + end; + + -- For cases other than selected or indexed components we + -- know we are OK, since no issues arise over alignment. + + else + return False; + end if; + + -- We processed an indexed component or selected component + -- reference that looked safe, so keep checking prefixes. + + Pref := Prefix (Pref); + end loop; end; end Is_Possibly_Unaligned_Slice; diff --git a/gcc/ada/g-traceb.ads b/gcc/ada/g-traceb.ads index c7ad39481f5..d26ab468286 100644 --- a/gcc/ada/g-traceb.ads +++ b/gcc/ada/g-traceb.ads @@ -54,7 +54,8 @@ -- Compile without -g -- Run the program, and call Call_Chain -- Recompile with -g --- Use addr2line to interpret the absolute call locations +-- Use addr2line to interpret the absolute call locations (note that +-- addr2line expects addresses in hexadecimal format). -- This capability is currently supported on the following targets: diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index c3753d19cd7..575e85ef602 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -13309,6 +13309,7 @@ See the chapter on project files in the GNAT Users guide for examples of use. * Reserved Words:: * Lexical Elements:: * Declarations:: +* Empty declarations:: * Typed string declarations:: * Variables:: * Expressions:: @@ -13379,9 +13380,21 @@ simple_declarative_item ::= variable_declaration | typed_variable_declaration | attribute_declaration | - case_construction + case_construction | + empty_declaration @end smallexample +@node Empty declarations +@section Empty declarations + +@smallexample +empty_declaration ::= + @b{null} ; +@end smallexample + +An empty declaration is allowed anywhere a declaration is allowed. +It has no effect. + @node Typed string declarations @section Typed string declarations @@ -13683,7 +13696,7 @@ case_construction ::= case_item ::= @b{when} discrete_choice_list => - @{case_construction | attribute_declaration@} + @{case_construction | attribute_declaration | empty_declaration@} discrete_choice_list ::= string_literal @{| string_literal@} | diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index ff9358d2d79..4567533b6ae 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -10809,6 +10809,8 @@ project Build is for ^Default_Switches^Default_Switches^ ("Ada") use ("^-g^-g^"); for Executable ("proc") use "proc1"; + when others => + null; end case; end Builder; diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 0f3fc50d83d..eb24af280ce 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -2231,7 +2231,9 @@ package body Make is The_Data := Projects.Table (Prj); end loop; - if The_Data.Library and then not The_Data.Flag1 then + if The_Data.Library + and then not The_Data.Need_To_Build_Lib + then -- Add to the Q all sources of the project that -- have not been marked @@ -2242,7 +2244,7 @@ package body Make is -- Now mark the project as processed - Projects.Table (Prj).Flag1 := True; + Projects.Table (Prj).Need_To_Build_Lib := True; end if; end; end if; @@ -4337,10 +4339,10 @@ package body Make is if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then for Proj in Projects.First .. Projects.Last loop if Projects.Table (Proj).Library then - Projects.Table (Proj).Flag1 := + Projects.Table (Proj).Need_To_Build_Lib := not MLib.Tgt.Library_Exists_For (Proj); - if Projects.Table (Proj).Flag1 then + if Projects.Table (Proj).Need_To_Build_Lib then if Verbose_Mode then Write_Str ("Library file does not exist for project """); @@ -4722,12 +4724,12 @@ package body Make is end if; if Projects.Table (Proj1).Library - and then not Projects.Table (Proj1).Flag1 + and then not Projects.Table (Proj1).Need_To_Build_Lib then MLib.Prj.Check_Library (Proj1); end if; - if Projects.Table (Proj1).Flag1 then + if Projects.Table (Proj1).Need_To_Build_Lib then Library_Projs.Increment_Last; Current := Library_Projs.Last; Depth := Projects.Table (Proj1).Depth; @@ -4744,7 +4746,7 @@ package body Make is end loop; Library_Projs.Table (Current) := Proj1; - Projects.Table (Proj1).Flag1 := False; + Projects.Table (Proj1).Need_To_Build_Lib := False; end if; end loop; end; diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index d818ff25423..ea504884910 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -2395,16 +2395,10 @@ package body Makegpr is if not Compile_Only then - -- If there are linking options from the command line, - -- transmit them to gnatmake. + -- Linking options if Linker_Options.Last /= 0 then Add_Argument (Dash_largs, True); - - for Arg in 1 .. Linker_Options.Last loop - Add_Argument (Linker_Options.Table (Arg), True); - end loop; - else Add_Argument (Dash_largs, Verbose_Mode); end if; @@ -2412,6 +2406,13 @@ package body Makegpr is -- Add the archives Add_Archives (For_Gnatmake => True); + + -- If there are linking options from the command line, + -- transmit them to gnatmake. + + for Arg in 1 .. Linker_Options.Last loop + Add_Argument (Linker_Options.Table (Arg), True); + end loop; end if; -- And invoke gnatmake @@ -3318,6 +3319,10 @@ package body Makegpr is Get_Name_String (Source.Object_Name), True); + -- Add all the archives, in a correct order + + Add_Archives (For_Gnatmake => False); + -- Add the switches specified in package Linker of -- the main project. @@ -3345,10 +3350,6 @@ package body Makegpr is Add_Argument (Linker_Options.Table (Arg), True); end loop; - -- Add all the archives, in a correct order - - Add_Archives (For_Gnatmake => False); - -- If there are shared libraries and the run path -- option is supported, add the run path switch. diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 8cce3e8d8ce..b2079be7a9c 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -1556,7 +1556,7 @@ package body MLib.Prj is Data : constant Project_Data := Projects.Table (For_Project); begin - if Data.Library and not Data.Flag1 then + if Data.Library and not Data.Need_To_Build_Lib then declare Current : constant Dir_Name_Str := Get_Current_Dir; Lib_Name : constant Name_Id := Library_File_Name_For (For_Project); @@ -1596,17 +1596,17 @@ package body MLib.Prj is Obj_TS := File_Stamp (Name_Find); - -- If library file time stamp is earlier, set Flag1 and - -- return. String comparaison is used, otherwise time stamps - -- may be too close and the comparaison would return True, - -- which would trigger an unnecessary rebuild of the - -- library. + -- If library file time stamp is earlier, set + -- Need_To_Build_Lib and return. String comparaison is used, + -- otherwise time stamps may be too close and the + -- comparaison would return True, which would trigger + -- an unnecessary rebuild of the library. if String (Lib_TS) < String (Obj_TS) then -- Library must be rebuilt - Projects.Table (For_Project).Flag1 := True; + Projects.Table (For_Project).Need_To_Build_Lib := True; exit; end if; end if; diff --git a/gcc/ada/mlib-tgt-aix.adb b/gcc/ada/mlib-tgt-aix.adb index 033ca6a90ff..fc5a954da56 100644 --- a/gcc/ada/mlib-tgt-aix.adb +++ b/gcc/ada/mlib-tgt-aix.adb @@ -134,8 +134,8 @@ package body MLib.Tgt is pragma Unreferenced (Lib_Version); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - MLib.Fil.Ext_To (Lib_Filename, DLL_Ext); + Lib_Dir & Directory_Separator & "lib" & + MLib.Fil.Ext_To (Lib_Filename, DLL_Ext); -- The file name of the library Init_Fini : Argument_List_Access := Empty_Argument_List; diff --git a/gcc/ada/mlib-tgt-hpux.adb b/gcc/ada/mlib-tgt-hpux.adb index f295b3810b9..4198f22317c 100644 --- a/gcc/ada/mlib-tgt-hpux.adb +++ b/gcc/ada/mlib-tgt-hpux.adb @@ -113,8 +113,8 @@ package body MLib.Tgt is pragma Unreferenced (Symbol_Data); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - MLib.Fil.Ext_To (Lib_Filename, DLL_Ext); + Lib_Dir & Directory_Separator & "lib" & + MLib.Fil.Ext_To (Lib_Filename, DLL_Ext); Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -135,6 +135,7 @@ package body MLib.Tgt is end if; -- If specified, add automatic elaboration/finalization + if Auto_Init then Init_Fini := Init_Fini_List; Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init"); diff --git a/gcc/ada/mlib-tgt-irix.adb b/gcc/ada/mlib-tgt-irix.adb index 2f09a14d38b..6c8a2e0c2a6 100644 --- a/gcc/ada/mlib-tgt-irix.adb +++ b/gcc/ada/mlib-tgt-irix.adb @@ -114,8 +114,8 @@ package body MLib.Tgt is pragma Unreferenced (Symbol_Data); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - MLib.Fil.Ext_To (Lib_Filename, DLL_Ext); + Lib_Dir & Directory_Separator & "lib" & + MLib.Fil.Ext_To (Lib_Filename, DLL_Ext); Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -129,6 +129,7 @@ package body MLib.Tgt is end if; -- If specified, add automatic elaboration/finalization + if Auto_Init then Init_Fini := Init_Fini_List; Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init"); diff --git a/gcc/ada/mlib-tgt-linux.adb b/gcc/ada/mlib-tgt-linux.adb index 7901f637c3e..a4a0ce8617a 100644 --- a/gcc/ada/mlib-tgt-linux.adb +++ b/gcc/ada/mlib-tgt-linux.adb @@ -117,8 +117,8 @@ package body MLib.Tgt is pragma Unreferenced (Symbol_Data); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - Fil.Ext_To (Lib_Filename, DLL_Ext); + Lib_Dir & Directory_Separator & "lib" & + Fil.Ext_To (Lib_Filename, DLL_Ext); Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -132,6 +132,7 @@ package body MLib.Tgt is end if; -- If specified, add automatic elaboration/finalization + if Auto_Init then Init_Fini := Init_Fini_List; Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init"); diff --git a/gcc/ada/mlib-tgt-mingw.adb b/gcc/ada/mlib-tgt-mingw.adb index 79aeab59066..77295cf5b17 100644 --- a/gcc/ada/mlib-tgt-mingw.adb +++ b/gcc/ada/mlib-tgt-mingw.adb @@ -107,8 +107,8 @@ package body MLib.Tgt is pragma Unreferenced (Lib_Version); Lib_File : constant String := - Lib_Dir & Directory_Separator & - Files.Ext_To (Lib_Filename, DLL_Ext); + Lib_Dir & Directory_Separator & + Files.Ext_To (Lib_Filename, DLL_Ext); -- Start of processing for Build_Dynamic_Library @@ -207,7 +207,7 @@ package body MLib.Tgt is else return Is_Regular_File - (Lib_Dir & Directory_Separator & "lib" & + (Lib_Dir & Directory_Separator & MLib.Fil.Ext_To (Lib_Name, DLL_Ext)); end if; end; @@ -231,13 +231,13 @@ package body MLib.Tgt is Get_Name_String (Projects.Table (Project).Library_Name); begin - Name_Len := 3; - Name_Buffer (1 .. Name_Len) := "lib"; - if Projects.Table (Project).Library_Kind = Static then + Name_Len := 3; + Name_Buffer (1 .. Name_Len) := "lib"; Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext)); else + Name_Len := 0; Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext)); end if; diff --git a/gcc/ada/mlib-tgt-solaris.adb b/gcc/ada/mlib-tgt-solaris.adb index d40928500c8..a307e85ae88 100644 --- a/gcc/ada/mlib-tgt-solaris.adb +++ b/gcc/ada/mlib-tgt-solaris.adb @@ -111,8 +111,8 @@ package body MLib.Tgt is pragma Unreferenced (Symbol_Data); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - Fil.Ext_To (Lib_Filename, DLL_Ext); + Lib_Dir & Directory_Separator & "lib" & + Fil.Ext_To (Lib_Filename, DLL_Ext); Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; @@ -126,6 +126,7 @@ package body MLib.Tgt is end if; -- If specified, add automatic elaboration/finalization + if Auto_Init then Init_Fini := Init_Fini_List; Init_Fini (1) := diff --git a/gcc/ada/mlib-tgt-tru64.adb b/gcc/ada/mlib-tgt-tru64.adb index 13417e8d2d4..e40fe50e8d0 100644 --- a/gcc/ada/mlib-tgt-tru64.adb +++ b/gcc/ada/mlib-tgt-tru64.adb @@ -119,8 +119,8 @@ package body MLib.Tgt is pragma Unreferenced (Symbol_Data); Lib_File : constant String := - Lib_Dir & Directory_Separator & "lib" & - Fil.Ext_To (Lib_Filename, DLL_Ext); + Lib_Dir & Directory_Separator & "lib" & + Fil.Ext_To (Lib_Filename, DLL_Ext); Version_Arg : String_Access; Symbolic_Link_Needed : Boolean := False; diff --git a/gcc/ada/mlib-tgt-vms-alpha.adb b/gcc/ada/mlib-tgt-vms-alpha.adb index 285f2bd2f55..6f1f069eb40 100644 --- a/gcc/ada/mlib-tgt-vms-alpha.adb +++ b/gcc/ada/mlib-tgt-vms-alpha.adb @@ -140,7 +140,7 @@ package body MLib.Tgt is Lib_File : constant String := Lib_Dir & Directory_Separator & "lib" & - Fil.Ext_To (Lib_Filename, DLL_Ext); + Fil.Ext_To (Lib_Filename, DLL_Ext); Opts : Argument_List := Options; Last_Opt : Natural := Opts'Last; @@ -151,8 +151,8 @@ package body MLib.Tgt is function Is_Interface (Obj_File : String) return Boolean; -- For a Stand-Alone Library, returns True if Obj_File is the object - -- file name of an interface of the SAL. - -- For other libraries, always return True. + -- file name of an interface of the SAL. For other libraries, always + -- return True. function Option_File_Name return String; -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt" diff --git a/gcc/ada/mlib-tgt-vms-ia64.adb b/gcc/ada/mlib-tgt-vms-ia64.adb index e279a51fb17..639ebca3f84 100644 --- a/gcc/ada/mlib-tgt-vms-ia64.adb +++ b/gcc/ada/mlib-tgt-vms-ia64.adb @@ -140,7 +140,7 @@ package body MLib.Tgt is Lib_File : constant String := Lib_Dir & Directory_Separator & "lib" & - Fil.Ext_To (Lib_Filename, DLL_Ext); + Fil.Ext_To (Lib_Filename, DLL_Ext); Opts : Argument_List := Options; Last_Opt : Natural := Opts'Last; @@ -151,8 +151,8 @@ package body MLib.Tgt is function Is_Interface (Obj_File : String) return Boolean; -- For a Stand-Alone Library, returns True if Obj_File is the object - -- file name of an interface of the SAL. - -- For other libraries, always return True. + -- file name of an interface of the SAL. For other libraries, always + -- return True. function Option_File_Name return String; -- Returns Symbol_File, if not empty. Otherwise, returns "symvec.opt" diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index 35cb8c0c135..e87146279fd 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -747,6 +747,10 @@ package body Prj.Dect is Set_End_Of_Line (Current_Declaration); Set_Previous_Line_Node (Current_Declaration); + when Tok_Null => + + Scan; -- past "null" + when Tok_Package => -- Package declaration diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 747e7f8248a..8514f2dc4f1 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -78,8 +78,8 @@ package body Prj is First_Referred_By => No_Project, Name => No_Name, Path_Name => No_Name, - Virtual => False, Display_Path_Name => No_Name, + Virtual => False, Location => No_Location, Mains => Nil_String, Directory => No_Name, @@ -127,8 +127,7 @@ package body Prj is Language_Independent_Checked => False, Checked => False, Seen => False, - Flag1 => False, - Flag2 => False, + Need_To_Build_Lib => False, Depth => 0, Unkept_Comments => False); diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index d742bbf28fc..327e500f76e 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -40,8 +40,8 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; package Prj is Empty_Name : Name_Id; - -- Name_Id for an empty name (no characters). - -- Initialized by procedure Initialize. + -- Name_Id for an empty name (no characters). Initialized by the call + -- to procedure Initialize. All_Packages : constant String_List_Access := null; -- Default value of parameter Packages of procedures Parse, in Prj.Pars and @@ -52,9 +52,8 @@ package Prj is -- normally forbidden for project names, there cannot be any name clash. Project_File_Extension : String := ".gpr"; - -- The standard project file name extension. - -- It is not a constant, because Canonical_Case_File_Name is called - -- on this variable in the body of Prj. + -- The standard project file name extension. It is not a constant, because + -- Canonical_Case_File_Name is called on this variable in the body of Prj. Default_Ada_Spec_Suffix : Name_Id; -- The Name_Id for the standard GNAT suffix for Ada spec source file @@ -72,15 +71,24 @@ package Prj is type Programming_Language is (Lang_Ada, Lang_C, Lang_C_Plus_Plus); - -- The list of language supported + -- The set of languages supported subtype Other_Programming_Language is - Programming_Language range Lang_C .. Programming_Language'Last; + Programming_Language range Lang_C .. Programming_Language'Last; + -- The set of non-Ada languages supported + type Languages_In_Project is array (Programming_Language) of Boolean; + -- Set of supported languages used in a project + No_Languages : constant Languages_In_Project := (others => False); + -- No supported languages are used type Impl_Suffix_Array is array (Programming_Language) of Name_Id; + -- Suffixes for the non spec sources of the different supported languages + -- in a project. + No_Impl_Suffixes : constant Impl_Suffix_Array := (others => No_Name); + -- A default value for the non spec source suffixes Lang_Ada_Name : aliased String := "ada"; Lang_C_Name : aliased String := "c"; @@ -93,7 +101,8 @@ package Prj is -- -x when using a GCC compiler. Lang_Name_Ids : array (Programming_Language) of Name_Id; - -- Initialized by Prj.Initialize + -- Same as Lang_Names, but using Name_Id, instead of String_Access. + -- Initialized by Prj.Initialize. Lang_Ada_Display_Name : aliased String := "Ada"; Lang_C_Display_Name : aliased String := "C"; @@ -115,8 +124,9 @@ package Prj is Lang_C_Plus_Plus => C_Plus_Plus_Impl_Suffix'Access); -- Default extension of the sources of the different languages. - Lang_Suffix_Ids : array (Programming_Language) of Name_Id; - -- Initialized by Prj.Initialize + Lang_Suffix_Ids : array (Programming_Language) of Name_Id; + -- Same as Lang_Suffixes, but using Name_Id, instead of String_Access. + -- Initialized by Prj.Initialize. Gnatmake_String : aliased String := "gnatmake"; Gcc_String : aliased String := "gcc"; @@ -137,6 +147,10 @@ package Prj is (Lang_Ada => Ada_Args_Strings 'Access, Lang_C => C_Args_String 'Access, Lang_C_Plus_Plus => C_Plus_Plus_Args_String'Access); + -- For each supported language, the string between "-c" and "args" to + -- be used in the gprmake switch for the start of the compiling switch + -- section for each supported language. For example, "-ccargs" indicates + -- the start of the C compiler switch section. type Other_Source_Id is new Nat; No_Other_Source : constant Other_Source_Id := 0; @@ -154,6 +168,7 @@ package Prj is Naming_Exception : Boolean := False; -- True if a naming exception Next : Other_Source_Id := No_Other_Source; end record; + -- Data for a source in a language other than Ada package Other_Sources is new Table.Table (Table_Component_Type => Other_Source, @@ -171,9 +186,13 @@ package Prj is -- High is extremely verbose. type Lib_Kind is (Static, Dynamic, Relocatable); - type Policy is (Autonomous, Compliant, Controlled, Restricted); - -- See explaination about this type in package Symbols + -- Type to specify the symbol policy, when symbol control is supported. + -- See full explanation about this type in package Symbols. + -- Autonomous: Create a symbol file without considering any reference + -- Compliant: Try to be as compatible as possible with an existing ref + -- Controlled: Fail if symbols are not the same as those in the reference + -- Restricted: Restrict the symbols to those in the symbol file type Symbol_Record is record Symbol_File : Name_Id := No_Name; @@ -186,8 +205,10 @@ package Prj is (Symbol_File => No_Name, Reference => No_Name, Symbol_Policy => Autonomous); + -- The default value of the symbol data function Empty_String return Name_Id; + -- Return the Name_Id for an empty string "" type Project_Id is new Nat; No_Project : constant Project_Id := 0; @@ -237,8 +258,8 @@ package Prj is Index : Int := 0; end case; end record; - -- Values for variables and array elements. - -- Default is True if the current value is the default one for the variable + -- Values for variables and array elements. Default is True if the + -- current value is the default one for the variable Nil_Variable_Value : constant Variable_Value := (Project => No_Project, @@ -314,13 +335,15 @@ package Prj is Arrays : Array_Id := No_Array; Packages : Package_Id := No_Package; end record; + -- Contains the declarations (variables, single and array attributes, + -- packages) for a project or a package in a project. No_Declarations : constant Declarations := (Variables => No_Variable, Attributes => No_Variable, Arrays => No_Array, Packages => No_Package); - -- Declarations. Used in project structures and packages (what for???) + -- Default value of Declarations: indicates that there is no declarations. type Package_Element is record Name : Name_Id := No_Name; @@ -387,36 +410,32 @@ package Prj is -- Current_Body_Suffix is defined. Separate_Suffix : Name_Id := No_Name; - -- The string to append to the unit name for the - -- source file name of an Ada subunit. + -- String to append to unit name for source file name of an Ada subunit. Sep_Suffix_Loc : Source_Ptr := No_Location; - -- The position in the project file source where - -- Separate_Suffix is defined. + -- Position in the project file source where Separate_Suffix is defined. Specs : Array_Element_Id := No_Array_Element; - -- An associative array mapping individual specs - -- to source file names. Specific to Ada. + -- An associative array mapping individual specs to source file names. + -- This is specific to Ada. Bodies : Array_Element_Id := No_Array_Element; - -- An associative array mapping individual bodies - -- to source file names. Specific to Ada. + -- An associative array mapping individual bodies to source file names. + -- This is specific to Ada. Specification_Exceptions : Array_Element_Id := No_Array_Element; - -- An associative array listing spec file names that don't have the - -- spec suffix. Not used by Ada. Indexed by the programming language - -- name. + -- An associative array listing spec file names that do not have the + -- spec suffix. Not used by Ada. Indexed by programming language name. Implementation_Exceptions : Array_Element_Id := No_Array_Element; - -- An associative array listing body file names that don't have the - -- body suffix. Not used by Ada. Indexed by the programming language - -- name. + -- An associative array listing body file names that do not have the + -- body suffix. Not used by Ada. Indexed by programming language name. end record; function Standard_Naming_Data return Naming_Data; pragma Inline (Standard_Naming_Data); - -- The standard GNAT naming scheme. + -- The standard GNAT naming scheme function Same_Naming_Scheme (Left, Right : Naming_Data) @@ -426,14 +445,14 @@ package Prj is type Project_List is new Nat; Empty_Project_List : constant Project_List := 0; - -- A list of project files. + -- A list of project files type Project_Element is record Project : Project_Id := No_Project; Next : Project_List := Empty_Project_List; end record; - -- Element in a list of project file. - -- Next is the id of the next project file in the list. + -- Element in a list of project files. Next is the id of the next + -- project file in the list. package Project_Lists is new Table.Table (Table_Component_Type => Project_Element, @@ -442,7 +461,7 @@ package Prj is Table_Initial => 100, Table_Increment => 100, Table_Name => "Prj.Project_Lists"); - -- The table that contains the lists of project files. + -- The table that contains the lists of project files -- The following record describes a project file representation @@ -459,30 +478,27 @@ package Prj is -- Set by Prj.Proc.Process. Name : Name_Id := No_Name; - -- The name of the project. - -- Set by Prj.Proc.Process. + -- The name of the project. Set by Prj.Proc.Process. Path_Name : Name_Id := No_Name; - -- The path name of the project file. - -- Set by Prj.Proc.Process. + -- The path name of the project file. Set by Prj.Proc.Process. + + Display_Path_Name : Name_Id := No_Name; + -- The path name used for display purposes. May be different from + -- Path_Name for platforms where the file names are case-insensitive. Virtual : Boolean := False; -- True for virtual extending projects - Display_Path_Name : Name_Id := No_Name; - Location : Source_Ptr := No_Location; - -- The location in the project file source of the - -- reserved word project. - -- Set by Prj.Proc.Process. + -- The location in the project file source of the reserved word + -- project. Set by Prj.Proc.Process. Mains : String_List_Id := Nil_String; - -- The list of mains as specified by attribute Main. - -- Set by Prj.Nmsc.Ada_Check. + -- List of mains specified by attribute Main. Set by Prj.Nmsc.Ada_Check. Directory : Name_Id := No_Name; - -- The directory where the project file resides. - -- Set by Prj.Proc.Process. + -- Directory where the project file resides. Set by Prj.Proc.Process. Display_Directory : Name_Id := No_Name; @@ -499,6 +515,9 @@ package Prj is -- Set by Prj.Nmsc.Language_Independent_Check. Display_Library_Dir : Name_Id := No_Name; + -- The name of the library directory, for display purposes. + -- May be different from Library_Dir for platforms where the file names + -- are case-insensitive. Library_Src_Dir : Name_Id := No_Name; -- If a library project, directory where the sources and the ALI files @@ -508,6 +527,9 @@ package Prj is -- Set by Prj.Nmsc.Language_Independent_Check. Display_Library_Src_Dir : Name_Id := No_Name; + -- The name of the library source directory, for display purposes. + -- May be different from Library_Src_Dir for platforms where the file + -- names are case-insensitive. Library_Name : Name_Id := No_Name; -- If a library project, name of the library @@ -527,10 +549,9 @@ package Prj is Lib_Interface_ALIs : String_List_Id := Nil_String; -- For Standalone Library Project Files, indicate the list - -- of Interface ALI files. - -- Set by Prj.Nmsc.Ada_Check. + -- of Interface ALI files. Set by Prj.Nmsc.Ada_Check. - Lib_Auto_Init : Boolean := False; + Lib_Auto_Init : Boolean := False; -- For non static Standalone Library Project Files, indicate if -- the library initialisation should be automatic. @@ -539,16 +560,17 @@ package Prj is Ada_Sources_Present : Boolean := True; -- A flag that indicates if there are Ada sources in this project file. - -- There are no sources if 1) Source_Dirs is specified as an - -- empty list, 2) Source_Files is specified as an empty list, or - -- 3) Ada is not in the list of the specified Languages. + -- There are no sources if any of the following is true: + -- 1) Source_Dirs is specified as an empty list + -- 2) Source_Files is specified as an empty list + -- 3) Ada is not in the list of the specified Languages - Other_Sources_Present : Boolean := True; + Other_Sources_Present : Boolean := True; -- A flag that indicates that there are non-Ada sources in this project Sources : String_List_Id := Nil_String; - -- The list of all the source file names. - -- Set by Prj.Nmsc.Check_Ada_Naming_Scheme. + -- The list of all the source file names. Set by + -- Prj.Nmsc.Check_Ada_Naming_Scheme. First_Other_Source : Other_Source_Id := No_Other_Source; Last_Other_Source : Other_Source_Id := No_Other_Source; @@ -563,8 +585,7 @@ package Prj is -- -I switches. Include_Data_Set : Boolean := False; - -- Set to True when Imported_Directories_Switches or Include_Path are - -- set. + -- Set True when Imported_Directories_Switches or Include_Path are set Source_Dirs : String_List_Id := Nil_String; -- The list of all the source directories. @@ -580,48 +601,48 @@ package Prj is -- Set by Prj.Nmsc.Language_Independent_Check. Display_Object_Dir : Name_Id := No_Name; + -- The name of the object directory, for display purposes. + -- May be different from Object_Directory for platforms where the file + -- names are case-insensitive. - Exec_Directory : Name_Id := No_Name; - -- The exec directory of this project file. - -- Default is equal to Object_Directory. - -- Set by Prj.Nmsc.Language_Independent_Check. + Exec_Directory : Name_Id := No_Name; + -- The exec directory of this project file. Default is equal to + -- Object_Directory. Set by Prj.Nmsc.Language_Independent_Check. Display_Exec_Dir : Name_Id := No_Name; + -- The name of the exec directory, for display purposes. + -- May be different from Exec_Directory for platforms where the file + -- names are case-insensitive. Extends : Project_Id := No_Project; -- The reference of the project file, if any, that this - -- project file extends. - -- Set by Prj.Proc.Process. + -- project file extends. Set by Prj.Proc.Process. Extended_By : Project_Id := No_Project; -- The reference of the project file, if any, that - -- extends this project file. - -- Set by Prj.Proc.Process. + -- extends this project file. Set by Prj.Proc.Process. Naming : Naming_Data := Standard_Naming_Data; -- The naming scheme of this project file. -- Set by Prj.Nmsc.Check_Naming_Scheme. Decl : Declarations := No_Declarations; - -- The declarations (variables, attributes and packages) - -- of this project file. - -- Set by Prj.Proc.Process. + -- The declarations (variables, attributes and packages) of this + -- project file. Set by Prj.Proc.Process. Imported_Projects : Project_List := Empty_Project_List; -- The list of all directly imported projects, if any. -- Set by Prj.Proc.Process. - Ada_Include_Path : String_Access := null; + Ada_Include_Path : String_Access := null; -- The cached value of ADA_INCLUDE_PATH for this project file. -- Do not use this field directly outside of the compiler, use - -- Prj.Env.Ada_Include_Path instead. - -- Set by Prj.Env.Ada_Include_Path. + -- Prj.Env.Ada_Include_Path instead. Set by Prj.Env.Ada_Include_Path. - Ada_Objects_Path : String_Access := null; + Ada_Objects_Path : String_Access := null; -- The cached value of ADA_OBJECTS_PATH for this project file. -- Do not use this field directly outside of the compiler, use - -- Prj.Env.Ada_Objects_Path instead. - -- Set by Prj.Env.Ada_Objects_Path + -- Prj.Env.Ada_Objects_Path instead. Set by Prj.Env.Ada_Objects_Path Include_Path_File : Name_Id := No_Name; -- The cached value of the source path temp file for this project file. @@ -629,13 +650,11 @@ package Prj is Objects_Path_File_With_Libs : Name_Id := No_Name; -- The cached value of the object path temp file (including library - -- dirs) for this project file. - -- Set by gnatmake (Prj.Env.Set_Ada_Paths). + -- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths). Objects_Path_File_Without_Libs : Name_Id := No_Name; -- The cached value of the object path temp file (excluding library - -- dirs) for this project file. - -- Set by gnatmake (Prj.Env.Set_Ada_Paths). + -- dirs) for this project file. Set by gnatmake (Prj.Env.Set_Ada_Paths). Config_File_Name : Name_Id := No_Name; -- The name of the configuration pragmas file, if any. @@ -657,17 +676,15 @@ package Prj is Checked : Boolean := False; -- A flag to avoid checking repetitively the naming scheme of - -- this project file. - -- Set by Prj.Nmsc.Check_Ada_Naming_Scheme. - - Seen : Boolean := False; - Flag1 : Boolean := False; - Flag2 : Boolean := False; - -- Various flags that are used in an ad hoc manner - -- That's really not a good enough comment ??? we need to know what - -- these flags are used for, and give them proper names. If Flag1 - -- and Flag2 have multiple uses, then either we use multiple fields - -- or a renaming scheme. + -- this project file. Set by Prj.Nmsc.Check_Ada_Naming_Scheme. + + Seen : Boolean := False; + -- A flag to mark a project as "visited" to avoid processing the same + -- project several time. + + Need_To_Build_Lib : Boolean := False; + -- Indicates that the library of a Library Project needs to be built or + -- rebuilt. Depth : Natural := 0; -- The maximum depth of a project in the project graph. @@ -680,7 +697,7 @@ package Prj is end record; function Empty_Project return Project_Data; - -- Return the representation of an empty project. + -- Return the representation of an empty project package Projects is new Table.Table ( Table_Component_Type => Project_Data, @@ -689,12 +706,12 @@ package Prj is Table_Initial => 100, Table_Increment => 100, Table_Name => "Prj.Projects"); - -- The set of all project files. + -- The set of all project files type Put_Line_Access is access procedure (Line : String; Project : Project_Id); - -- Use to customize error reporting in Prj.Proc and Prj.Nmsc. + -- Use to customize error reporting in Prj.Proc and Prj.Nmsc procedure Expect (The_Token : Token_Type; Token_Image : String); -- Check that the current token is The_Token. If it is not, then @@ -709,7 +726,7 @@ package Prj is -- project file tree. Initialize must be called before the call to Reset. procedure Register_Default_Naming_Scheme - (Language : Name_Id; + (Language : Name_Id; Default_Spec_Suffix : Name_Id; Default_Body_Suffix : Name_Id); -- Register the default suffixs for a given language. These extensions @@ -736,6 +753,7 @@ package Prj is private Initial_Buffer_Size : constant := 100; + -- Initial size for extensible buffer used below Buffer : String_Access := new String (1 .. Initial_Buffer_Size); -- An extensible character buffer to store names. Used in Prj.Part and diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index b36ee59bed4..36e5bad65a0 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -70,6 +70,11 @@ package body Rtsfind is -- a unit is loaded to contain the defining entity for the unit, the -- unit name, and the unit number. + -- Note that a unit can be loaded either by a call to find an entity + -- within the unit (e.g. RTE), or by an explicit with of the unit. In + -- the latter case it is critical to make a call to Set_RTU_Loaded to + -- ensure that the entry in this table reflects the load. + type RT_Unit_Table_Record is record Entity : Entity_Id; Uname : Unit_Name_Type; @@ -139,7 +144,7 @@ package body Rtsfind is function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type; -- Retrieves the Unit Name given a unit id represented by its - -- enumaration value in RTU_Id. + -- enumeration value in RTU_Id. procedure Load_RTU (U_Id : RTU_Id; @@ -958,7 +963,7 @@ package body Rtsfind is -- a WITH if the current unit is part of the extended main code -- unit, and if we have not already added the with. The WITH is -- added to the appropriate unit (the current one). We do not need - -- to generate a WITH for an + -- to generate a WITH for an ???? <<Found>> if (not U.Withed) @@ -1052,12 +1057,50 @@ package body Rtsfind is function RTU_Loaded (U : RTU_Id) return Boolean is begin - return True or else Present (RT_Unit_Table (U).Entity); - -- Temporary kludge until we get proper interaction to ensure that - -- an explicit WITH of a unit is properly registered in rtsfind ??? + return Present (RT_Unit_Table (U).Entity); end RTU_Loaded; -------------------- + -- Set_RTU_Loaded -- + -------------------- + + procedure Set_RTU_Loaded (N : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); + Unum : constant Unit_Number_Type := Get_Source_Unit (Loc); + Uname : constant Unit_Name_Type := Unit_Name (Unum); + E : constant Entity_Id := + Defining_Entity (Unit (Cunit (Unum))); + begin + pragma Assert (Is_Predefined_File_Name (Unit_File_Name (Unum))); + + -- Loop through entries in RTU table looking for matching entry + + for U_Id in RTU_Id'Range loop + + -- Here we have a match + + if Get_Unit_Name (U_Id) = Uname then + declare + U : RT_Unit_Table_Record renames RT_Unit_Table (U_Id); + -- The RT_Unit_Table entry that may need updating + + begin + -- If entry is not set, set it now + + if not Present (U.Entity) then + U.Entity := E; + U.Uname := Get_Unit_Name (U_Id); + U.Unum := Unum; + U.Withed := False; + end if; + + return; + end; + end if; + end loop; + end Set_RTU_Loaded; + + -------------------- -- Text_IO_Kludge -- -------------------- diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 0ec821cceba..ce97924386a 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -2695,7 +2695,7 @@ package Rtsfind is -- -- If RTE returns, the returned value is the required entity -- - -- If the entity is not available, then an error message is given The + -- If the entity is not available, then an error message is given. The -- form of the message depends on whether we are in configurable run time -- mode or not. In configurable run time mode, a missing entity is not -- that surprising and merely says that the particular construct is not @@ -2732,6 +2732,9 @@ package Rtsfind is -- If the unit has not been loaded, returns False. Note that this does -- not mean that an attempt to load it subsequently would fail. + procedure Set_RTU_Loaded (N : Node_Id); + -- Register the predefined unit N as already loaded. + procedure Text_IO_Kludge (Nam : Node_Id); -- In Ada 83, and hence for compatibility in Ada 9X, package Text_IO has -- generic subpackages (e.g. Integer_IO). They really should be child diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index b8f30017ce4..0dca2b5bbaf 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -43,6 +43,7 @@ with Nmake; use Nmake; with Opt; use Opt; with Output; use Output; with Restrict; use Restrict; +with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Ch6; use Sem_Ch6; with Sem_Ch7; use Sem_Ch7; @@ -496,6 +497,16 @@ package body Sem_Ch10 is Set_Acts_As_Spec (N); end if; + -- Register predefined units in Rtsfind + + declare + Unum : constant Unit_Number_Type := Get_Source_Unit (Sloc (N)); + begin + if Is_Predefined_File_Name (Unit_File_Name (Unum)) then + Set_RTU_Loaded (Unit_Node); + end if; + end; + -- Treat compilation unit pragmas that appear after the library unit if Present (Pragmas_After (Aux_Decls_Node (N))) then diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 6f1083acda8..9449c607f5b 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6568,9 +6568,11 @@ package body Sem_Ch12 is Next_Non_Pragma (Formal_Node); else - -- No further formals to match. + -- No further formals to match, but the generic + -- part may contain inherited operation that are + -- not hidden in the enclosing instance. - exit; + Next_Entity (Actual_Ent); end if; end loop; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d7e5f3b3ee8..c1ef371672d 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1676,10 +1676,8 @@ package body Sem_Util is -- hides the implicit one, which is removed from all visibility, -- i.e. the entity list of its scope, and homonym chain of its name. - elsif (Is_Overloadable (E) and then Present (Alias (E))) + elsif (Is_Overloadable (E) and then Is_Inherited_Operation (E)) or else Is_Internal (E) - or else (Ekind (E) = E_Enumeration_Literal - and then Is_Derived_Type (Etype (E))) then declare Prev : Entity_Id; @@ -5363,7 +5361,25 @@ package body Sem_Util is if Is_Private_Type (Btype) and then not Is_Generic_Type (Btype) then - return Btype; + if Present (Full_View (Btype)) + and then Is_Record_Type (Full_View (Btype)) + and then not Is_Frozen (Btype) + then + -- To indicate that the ancestor depends on a private type, + -- the current Btype is sufficient. However, to check for + -- circular definition we must recurse on the full view. + + Candidate := Trace_Components (Full_View (Btype), True); + + if Candidate = Any_Type then + return Any_Type; + else + return Btype; + end if; + + else + return Btype; + end if; elsif Is_Array_Type (Btype) then return Trace_Components (Component_Type (Btype), True); |