diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2004-03-22 15:06:28 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2004-03-22 15:06:28 +0100 |
commit | 24105bab8c2cf186720770b33176f0880136fa68 (patch) | |
tree | 046250c44426ffdf888413277208b576e9375d91 /gcc/ada | |
parent | ead61c1d430c015cba9f73466aba2c719791d7bc (diff) | |
download | gcc-24105bab8c2cf186720770b33176f0880136fa68.zip gcc-24105bab8c2cf186720770b33176f0880136fa68.tar.gz gcc-24105bab8c2cf186720770b33176f0880136fa68.tar.bz2 |
[multiple changes]
2004-03-22 Cyrille Comar <comar@act-europe.fr>
* ali.ads: Fix Comment about Dynamic_Elab.
* gnatls.adb (Output_Unit): Add output of many flags (Dynamic_Elab,
Has_RACW, Is_Generic, etc.)
(Output_Object, Gnatls): Take into account ALI files not attached to
an object.
2004-03-22 Vincent Celier <celier@gnat.com>
* gprep.adb: Change all String_Access to Name_Id
(Is_ASCII_Letter): new function
(Double_File_Name_Buffer): New procedure
(Preprocess_Infile_Name): New procedure
(Process_Files): New procedure
(Gnatprep): Check if output and input are existing directories.
Call Process_Files to do the real job.
2004-03-22 Robert Dewar <dewar@gnat.com>
* prj-env.adb, prj-nmsc.ads, prj-proc.ads,
s-stache.ads, s-stache.adb: Comment updates. Minor reformatting.
2004-03-22 Sergey Rybin <rybin@act-europe.fr>
* scn.adb (Contains): Add check for EOF, is needed for a degenerated
case when the source contains only comments.
2004-03-22 Ed Schonberg <schonberg@gnat.com>
* sem_ch10.adb (Analyze_Compilation_Unit): When generating a
declaration for a child subprogram body that acts as a spec, indicate
that the entity in the declaration needs debugging information.
* sem_ch3.adb (Complete_Private_Subtype): Do not build an underlying
full view if the subtype is created for a constrained record component;
gigi has enough information to construct the record, and there is no
place in the tree for the declaration.
* sem_ch6.adb (Build_Body_To_Inline): Use an internal name without
serial number for the dummy body that is built for analysis, to avoid
inconsistencies in the generation of internal names when compiling
with -gnatN.
2004-03-22 Thomas Quinot <quinot@act-europe.fr>
* sem_util.adb (Is_Object_Reference): A view conversion denotes an
object.
2004-03-22 GNAT Script <nobody@gnat.com>
* Make-lang.in: Makefile automatically updated
From-SVN: r79826
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 54 | ||||
-rw-r--r-- | gcc/ada/Make-lang.in | 6 | ||||
-rw-r--r-- | gcc/ada/ali.ads | 2 | ||||
-rw-r--r-- | gcc/ada/gnatls.adb | 96 | ||||
-rw-r--r-- | gcc/ada/gprep.adb | 485 | ||||
-rw-r--r-- | gcc/ada/prj-env.adb | 51 | ||||
-rw-r--r-- | gcc/ada/prj-env.ads | 3 | ||||
-rw-r--r-- | gcc/ada/prj-nmsc.ads | 6 | ||||
-rw-r--r-- | gcc/ada/prj-proc.ads | 2 | ||||
-rw-r--r-- | gcc/ada/s-stache.adb | 3 | ||||
-rw-r--r-- | gcc/ada/s-stache.ads | 10 | ||||
-rw-r--r-- | gcc/ada/scn.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch10.adb | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch3.adb | 7 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 7 |
16 files changed, 631 insertions, 123 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ee6e709..986d554 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,57 @@ +2004-03-22 Cyrille Comar <comar@act-europe.fr> + + * ali.ads: Fix Comment about Dynamic_Elab. + + * gnatls.adb (Output_Unit): Add output of many flags (Dynamic_Elab, + Has_RACW, Is_Generic, etc.) + (Output_Object, Gnatls): Take into account ALI files not attached to + an object. + +2004-03-22 Vincent Celier <celier@gnat.com> + + * gprep.adb: Change all String_Access to Name_Id + (Is_ASCII_Letter): new function + (Double_File_Name_Buffer): New procedure + (Preprocess_Infile_Name): New procedure + (Process_Files): New procedure + (Gnatprep): Check if output and input are existing directories. + Call Process_Files to do the real job. + +2004-03-22 Robert Dewar <dewar@gnat.com> + + * prj-env.adb, prj-nmsc.ads, prj-proc.ads, + s-stache.ads, s-stache.adb: Comment updates. Minor reformatting. + +2004-03-22 Sergey Rybin <rybin@act-europe.fr> + + * scn.adb (Contains): Add check for EOF, is needed for a degenerated + case when the source contains only comments. + +2004-03-22 Ed Schonberg <schonberg@gnat.com> + + * sem_ch10.adb (Analyze_Compilation_Unit): When generating a + declaration for a child subprogram body that acts as a spec, indicate + that the entity in the declaration needs debugging information. + + * sem_ch3.adb (Complete_Private_Subtype): Do not build an underlying + full view if the subtype is created for a constrained record component; + gigi has enough information to construct the record, and there is no + place in the tree for the declaration. + + * sem_ch6.adb (Build_Body_To_Inline): Use an internal name without + serial number for the dummy body that is built for analysis, to avoid + inconsistencies in the generation of internal names when compiling + with -gnatN. + +2004-03-22 Thomas Quinot <quinot@act-europe.fr> + + * sem_util.adb (Is_Object_Reference): A view conversion denotes an + object. + +2004-03-22 GNAT Script <nobody@gnat.com> + + * Make-lang.in: Makefile automatically updated + 2004-03-21 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> * decl.c (gnat_to_gnu_entity): Use SUBSTITUTE_PLACEHOLDER_IN_EXPR. diff --git a/gcc/ada/Make-lang.in b/gcc/ada/Make-lang.in index 3c0f95b..886cf79 100644 --- a/gcc/ada/Make-lang.in +++ b/gcc/ada/Make-lang.in @@ -2793,10 +2793,8 @@ ada/s-sopco5.o : ada/system.ads ada/s-secsta.ads ada/s-stoele.ads \ ada/s-stoele.adb ada/s-strops.ads ada/s-sopco3.ads ada/s-sopco4.ads \ ada/s-sopco5.ads ada/s-sopco5.adb ada/unchconv.ads -ada/s-stache.o : ada/ada.ads ada/a-except.ads ada/system.ads \ - ada/s-crtl.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \ - ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \ - ada/s-traent.ads ada/unchconv.ads +ada/s-stache.o : ada/system.ads ada/s-stache.ads ada/s-stache.adb \ + ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads ada/s-stalib.o : ada/ada.ads ada/a-except.ads ada/system.ads \ ada/s-memory.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \ diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index d04346d..9c7d35a 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -253,7 +253,7 @@ package ALI is Dynamic_Elab : Boolean; -- Set to True if the unit was compiled with dynamic elaboration - -- checks (i.e. either -gnatE or pragma Elaboration_Checks (Static) + -- checks (i.e. either -gnatE or pragma Elaboration_Checks (RM) -- was used to compile the unit). Elaborate_Body : Boolean; diff --git a/gcc/ada/gnatls.adb b/gcc/ada/gnatls.adb index 3d08549..c667251 100644 --- a/gcc/ada/gnatls.adb +++ b/gcc/ada/gnatls.adb @@ -45,6 +45,8 @@ procedure Gnatls is Max_Column : constant := 80; + No_Obj : aliased String := "<no_obj>"; + type File_Status is ( OK, -- matching timestamp Checksum_OK, -- only matching checksum @@ -271,8 +273,13 @@ procedure Gnatls is end if; if Print_Object then - Get_Name_String (ALIs.Table (Id).Ofile_Full_Name); - Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1); + if ALIs.Table (Id).No_Object then + Max_Obj_Length := + Integer'Max (Max_Obj_Length, No_Obj'Length); + else + Get_Name_String (ALIs.Table (Id).Ofile_Full_Name); + Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1); + end if; end if; end if; end loop; @@ -363,8 +370,13 @@ procedure Gnatls is begin if Print_Object then - Get_Name_String (O); - Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len)); + if O /= No_File then + Get_Name_String (O); + Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len)); + else + Object_Name := No_Obj'Unchecked_Access; + end if; + Write_Str (Object_Name.all); if Print_Source or else Print_Unit then @@ -501,14 +513,21 @@ procedure Gnatls is end if; if Verbose_Mode then - if U.Preelab or - U.No_Elab or - U.Pure or - U.Elaborate_Body or - U.Remote_Types or - U.Shared_Passive or - U.RCI or - U.Predefined + if U.Preelab or + U.No_Elab or + U.Pure or + U.Dynamic_Elab or + U.Has_RACW or + U.Remote_Types or + U.Shared_Passive or + U.RCI or + U.Predefined or + U.Internal or + U.Is_Generic or + U.Init_Scalars or + U.Interface or + U.Body_Needed_For_SAL or + U.Elaborate_Body then Write_Eol; Write_Str (" Flags =>"); @@ -524,6 +543,50 @@ procedure Gnatls is Write_Str (" Pure"); end if; + if U.Dynamic_Elab then + Write_Str (" Dynamic_Elab"); + end if; + + if U.Has_RACW then + Write_Str (" Has_RACW"); + end if; + + if U.Remote_Types then + Write_Str (" Remote_Types"); + end if; + + if U.Shared_Passive then + Write_Str (" Shared_Passive"); + end if; + + if U.RCI then + Write_Str (" RCI"); + end if; + + if U.Predefined then + Write_Str (" Predefined"); + end if; + + if U.Internal then + Write_Str (" Internal"); + end if; + + if U.Is_Generic then + Write_Str (" Is_Generic"); + end if; + + if U.Init_Scalars then + Write_Str (" Init_Scalars"); + end if; + + if U.Interface then + Write_Str (" Interface"); + end if; + + if U.Body_Needed_For_SAL then + Write_Str (" Body_Needed_For_SAL"); + end if; + if U.Elaborate_Body then Write_Str (" Elaborate Body"); end if; @@ -540,9 +603,6 @@ procedure Gnatls is Write_Str (" Predefined"); end if; - if U.RCI then - Write_Str (" Remote_Call_Interface"); - end if; end if; end if; @@ -966,7 +1026,11 @@ begin Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname); if Also_Predef or else not Is_Internal_Unit then - Output_Object (ALIs.Table (Id).Ofile_Full_Name); + if ALIs.Table (Id).No_Object then + Output_Object (No_File); + else + Output_Object (ALIs.Table (Id).Ofile_Full_Name); + end if; -- In verbose mode print all main units in the ALI file, otherwise -- just print the first one to ease columnwise printout diff --git a/gcc/ada/gprep.adb b/gcc/ada/gprep.adb index 015f964..fdd1f8b 100644 --- a/gcc/ada/gprep.adb +++ b/gcc/ada/gprep.adb @@ -39,9 +39,12 @@ with Snames; with Stringt; use Stringt; with Types; use Types; -with Ada.Text_IO; use Ada.Text_IO; +with Ada.Text_IO; use Ada.Text_IO; +with GNAT.Case_Util; use GNAT.Case_Util; with GNAT.Command_Line; -with GNAT.OS_Lib; use GNAT.OS_Lib; +with GNAT.Directory_Operations; use GNAT.Directory_Operations; +with GNAT.OS_Lib; use GNAT.OS_Lib; + package body GPrep is @@ -52,9 +55,15 @@ package body GPrep is -- Argument Line Data -- ------------------------ - Infile_Name : String_Access; - Outfile_Name : String_Access; - Deffile_Name : String_Access; + Infile_Name : Name_Id := No_Name; + Outfile_Name : Name_Id := No_Name; + Deffile_Name : Name_Id := No_Name; + + Output_Directory : Name_Id := No_Name; + -- Used when the specified output is an existing directory + + Input_Directory : Name_Id := No_Name; + -- Used when the specified input and output are existing directories Source_Ref_Pragma : Boolean := False; -- Record command line options (set if -r switch set) @@ -62,6 +71,11 @@ package body GPrep is Text_Outfile : aliased Ada.Text_IO.File_Type; Outfile : constant File_Access := Text_Outfile'Access; + File_Name_Buffer_Initial_Size : constant := 50; + File_Name_Buffer : String_Access := + new String (1 .. File_Name_Buffer_Initial_Size); + -- A buffer to build output file names from input file names. + ----------------- -- Subprograms -- ----------------- @@ -81,8 +95,22 @@ package body GPrep is Errutil.Style); -- The scanner for the preprocessor + function Is_ASCII_Letter (C : Character) return Boolean; + -- True if C is in 'a' .. 'z' or in 'A' .. 'Z' + + procedure Double_File_Name_Buffer; + -- Double the size of the file name buffer. + + procedure Preprocess_Infile_Name; + -- When the specified output is a directory, preprocess the infile name + -- for symbol substitution, to get the output file name. + + procedure Process_Files; + -- Process the single input file or all the files in the directory tree + -- rooted at the input directory. + procedure Process_Command_Line_Symbol_Definition (S : String); - -- Process a -D switch on ther command line + -- Process a -D switch on the command line procedure Put_Char_To_Outfile (C : Character); -- Output one character to the output file. @@ -112,13 +140,24 @@ package body GPrep is end if; end Display_Copyright; + ----------------------------- + -- Double_File_Name_Buffer -- + ----------------------------- + + procedure Double_File_Name_Buffer is + New_Buffer : constant String_Access := + new String (1 .. 2 * File_Name_Buffer'Length); + begin + New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all; + Free (File_Name_Buffer); + File_Name_Buffer := New_Buffer; + end Double_File_Name_Buffer; + -------------- -- Gnatprep -- -------------- procedure Gnatprep is - Infile : Source_File_Index; - begin -- Do some initializations (order is important here!) @@ -156,12 +195,13 @@ package body GPrep is -- Test we had all the arguments needed - if Infile_Name = null then + if Infile_Name = No_Name then -- No input file specified, just output the usage and exit Usage; return; - elsif Outfile_Name = null then + + elsif Outfile_Name = No_Name then -- No output file specified, just output the usage and exit Usage; @@ -178,13 +218,13 @@ package body GPrep is -- If we have a definition file, parse it - if Deffile_Name /= null then + if Deffile_Name /= No_Name then declare Deffile : Source_File_Index; begin Errutil.Initialize; - Deffile := Sinput.C.Load_File (Deffile_Name.all); + Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name)); -- Set Main_Source_File to the definition file for the benefit of -- Errutil.Finalize. @@ -193,7 +233,7 @@ package body GPrep is if Deffile = No_Source_File then Fail ("unable to find definition file """, - Deffile_Name.all, + Get_Name_String (Deffile_Name), """"); end if; @@ -208,7 +248,8 @@ package body GPrep is if Total_Errors_Detected > 0 then Errutil.Finalize (Source_Type => "definition"); - Fail ("errors in definition file """, Deffile_Name.all, """"); + Fail ("errors in definition file """, + Get_Name_String (Deffile_Name), """"); end if; -- If -s switch was specified, print a sorted list of symbol names and @@ -218,68 +259,37 @@ package body GPrep is Prep.List_Symbols (Foreword => ""); end if; - -- Load the input file - - Infile := Sinput.C.Load_File (Infile_Name.all); - - if Infile = No_Source_File then - Fail ("unable to find input file """, Infile_Name.all, """"); - end if; - - -- Set Main_Source_File to the input file for the benefit of - -- Errutil.Finalize. - - Sinput.Main_Source_File := Infile; - - Scanner.Initialize_Scanner (No_Unit, Infile); - - -- If an output file were specified, create it; fails if this did not - -- work. - - if Outfile_Name /= null then - begin - Create (Text_Outfile, Out_File, Outfile_Name.all); - - exception - when others => - Fail - ("unable to create output file """, Outfile_Name.all, """"); - end; - end if; - - -- Output the SFN pragma if asked to + Output_Directory := No_Name; + Input_Directory := No_Name; - if Source_Ref_Pragma then - Put_Line (Outfile.all, "pragma Source_Reference (1, """ & - Get_Name_String (Sinput.File_Name (Infile)) & - """);"); - end if; - - -- Preprocess the input file + -- Check if the specified output is an existing directory - Prep.Preprocess; + if Is_Directory (Get_Name_String (Outfile_Name)) then + Output_Directory := Outfile_Name; - -- In verbose mode, if there is no error, report it + -- As the output is an existing directory, check if the input too + -- is a directory. - if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then - Errutil.Finalize (Source_Type => "input"); + if Is_Directory (Get_Name_String (Infile_Name)) then + Input_Directory := Infile_Name; + end if; end if; - -- If we had some errors, delete the output file, and report the errors, + -- And process the single input or the files in the directory tree + -- rooted at the input directory. - if Err_Vars.Total_Errors_Detected > 0 then - if Outfile /= Standard_Output then - Delete (Text_Outfile); - end if; + Process_Files; - Errutil.Finalize (Source_Type => "input"); + end Gnatprep; - -- otherwise, close the output file, and we are done. + --------------------- + -- Is_ASCII_Letter -- + --------------------- - elsif Outfile /= Standard_Output then - Close (Text_Outfile); - end if; - end Gnatprep; + function Is_ASCII_Letter (C : Character) return Boolean is + begin + return C in 'A' .. 'Z' or else C in 'a' .. 'z'; + end Is_ASCII_Letter; ------------------------ -- New_EOL_To_Outfile -- @@ -299,6 +309,112 @@ package body GPrep is null; end Post_Scan; + ---------------------------- + -- Preprocess_Infile_Name -- + ---------------------------- + + procedure Preprocess_Infile_Name is + Len : Natural; + First : Positive := 1; + Last : Natural; + Symbol : Name_Id; + Data : Symbol_Data; + + begin + -- Initialize the buffer with the name of the input file + + Get_Name_String (Infile_Name); + Len := Name_Len; + + while File_Name_Buffer'Length < Len loop + Double_File_Name_Buffer; + end loop; + + File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len); + + -- Look for possible symbols in the file name + + while First < Len loop + + -- A symbol starts with a dollar sign followed by a letter + + if File_Name_Buffer (First) = '$' and then + Is_ASCII_Letter (File_Name_Buffer (First + 1)) + then + Last := First + 1; + + -- Find the last letter of the symbol + + while Last < Len and then + Is_ASCII_Letter (File_Name_Buffer (Last + 1)) + loop + Last := Last + 1; + end loop; + + -- Get the symbol name id + + Name_Len := Last - First; + Name_Buffer (1 .. Name_Len) := + File_Name_Buffer (First + 1 .. Last); + To_Lower (Name_Buffer (1 .. Name_Len)); + Symbol := Name_Find; + + -- And look for this symbol name in the symbol table + + for Index in 1 .. Symbol_Table.Last (Mapping) loop + Data := Mapping.Table (Index); + + if Data.Symbol = Symbol then + + -- We found the symbol. If its value is not a string, + -- replace the symbol in the file name with the value of + -- the symbol. + + if not Data.Is_A_String then + String_To_Name_Buffer (Data.Value); + + declare + Sym_Len : constant Positive := Last - First + 1; + Offset : constant Integer := Name_Len - Sym_Len; + New_Len : constant Natural := Len + Offset; + + begin + while New_Len > File_Name_Buffer'Length loop + Double_File_Name_Buffer; + end loop; + + File_Name_Buffer (Last + 1 + Offset .. New_Len) := + File_Name_Buffer (Last + 1 .. Len); + Len := New_Len; + Last := Last + Offset; + File_Name_Buffer (First .. Last) := + Name_Buffer (1 .. Name_Len); + end; + end if; + + exit; + end if; + end loop; + + -- Skip over the symbol name or its value: we are not checking + -- for another symbol name in the value. + + First := Last + 1; + + else + First := First + 1; + end if; + end loop; + + -- We now have the output file name in the buffer. Get the output + -- path and put it in Outfile_Name. + + Get_Name_String (Output_Directory); + Add_Char_To_Name_Buffer (Directory_Separator); + Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len)); + Outfile_Name := Name_Find; + end Preprocess_Infile_Name; + -------------------------------------------- -- Process_Command_Line_Symbol_Definition -- -------------------------------------------- @@ -326,6 +442,228 @@ package body GPrep is Mapping.Table (Symbol) := Data; end Process_Command_Line_Symbol_Definition; + ------------------- + -- Process_Files -- + ------------------- + + procedure Process_Files is + + procedure Process_One_File; + -- Process input file Infile_Name and put the result in file + -- Outfile_Name. + + procedure Recursive_Process (In_Dir : String; Out_Dir : String); + -- Process recursively files in In_Dir. Results go to Out_Dir. + + ---------------------- + -- Process_One_File -- + ---------------------- + + procedure Process_One_File is + Infile : Source_File_Index; + + begin + -- Create the output file; fails if this does not work. + + begin + Create (Text_Outfile, Out_File, Get_Name_String (Outfile_Name)); + + exception + when others => + Fail + ("unable to create output file """, + Get_Name_String (Outfile_Name), """"); + end; + + -- Load the input file + + Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name)); + + if Infile = No_Source_File then + Fail ("unable to find input file """, + Get_Name_String (Infile_Name), """"); + end if; + + -- Set Main_Source_File to the input file for the benefit of + -- Errutil.Finalize. + + Sinput.Main_Source_File := Infile; + + Scanner.Initialize_Scanner (No_Unit, Infile); + + -- Output the SFN pragma if asked to + + if Source_Ref_Pragma then + Put_Line (Outfile.all, "pragma Source_Reference (1, """ & + Get_Name_String (Sinput.File_Name (Infile)) & + """);"); + end if; + + -- Preprocess the input file + + Prep.Preprocess; + + -- In verbose mode, if there is no error, report it + + if Opt.Verbose_Mode and then Err_Vars.Total_Errors_Detected = 0 then + Errutil.Finalize (Source_Type => "input"); + end if; + + -- If we had some errors, delete the output file, and report + -- the errors. + + if Err_Vars.Total_Errors_Detected > 0 then + if Outfile /= Standard_Output then + Delete (Text_Outfile); + end if; + + Errutil.Finalize (Source_Type => "input"); + + OS_Exit (0); + + -- otherwise, close the output file, and we are done. + + elsif Outfile /= Standard_Output then + Close (Text_Outfile); + end if; + end Process_One_File; + + ----------------------- + -- Recursive_Process -- + ----------------------- + + procedure Recursive_Process (In_Dir : String; Out_Dir : String) is + Dir_In : Dir_Type; + Name : String (1 .. 255); + Last : Natural; + In_Dir_Name : Name_Id; + Out_Dir_Name : Name_Id; + + procedure Set_Directory_Names; + -- Establish or reestablish the current input and output directories + + ------------------------- + -- Set_Directory_Names -- + ------------------------- + + procedure Set_Directory_Names is + begin + Input_Directory := In_Dir_Name; + Output_Directory := Out_Dir_Name; + end Set_Directory_Names; + + begin + -- Open the current input directory + + begin + Open (Dir_In, In_Dir); + + exception + when Directory_Error => + Fail ("could not read directory " & In_Dir); + end; + + -- Set the new input and output directory names + + Name_Len := In_Dir'Length; + Name_Buffer (1 .. Name_Len) := In_Dir; + In_Dir_Name := Name_Find; + Name_Len := Out_Dir'Length; + Name_Buffer (1 .. Name_Len) := Out_Dir; + Out_Dir_Name := Name_Find; + + Set_Directory_Names; + + -- Traverse the input directory + loop + Read (Dir_In, Name, Last); + exit when Last = 0; + + if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then + declare + Input : constant String := + In_Dir & Directory_Separator & Name (1 .. Last); + Output : constant String := + Out_Dir & Directory_Separator & Name (1 .. Last); + + begin + -- If input is an ordinary file, process it + + if Is_Regular_File (Input) then + -- First get the output file name + + Name_Len := Last; + Name_Buffer (1 .. Name_Len) := Name (1 .. Last); + Infile_Name := Name_Find; + Preprocess_Infile_Name; + + -- Set the input file name and process the file + + Name_Len := Input'Length; + Name_Buffer (1 .. Name_Len) := Input; + Infile_Name := Name_Find; + Process_One_File; + + elsif Is_Directory (Input) then + -- Input is a directory. If the corresponding output + -- directory does not already exist, create it. + + if not Is_Directory (Output) then + begin + Make_Dir (Dir_Name => Output); + + exception + when Directory_Error => + Fail ("could not create directory """, + Output, """"); + end; + end if; + + -- And process this new input directory + + Recursive_Process (Input, Output); + + -- Reestablish the input and output directory names + -- that have been modified by the recursive call. + + Set_Directory_Names; + end if; + end; + end if; + end loop; + end Recursive_Process; + + begin + if Output_Directory = No_Name then + -- If the output is not a directory, fail if the input is + -- an existing directory, to avoid possible problems. + + if Is_Directory (Get_Name_String (Infile_Name)) then + Fail ("input file """ & Get_Name_String (Infile_Name) & + """ is a directory"); + end if; + + -- Just process the single input file + + Process_One_File; + + elsif Input_Directory = No_Name then + -- Get the output file name from the input file name, and process + -- the single input file. + + Preprocess_Infile_Name; + Process_One_File; + + else + -- Recursively process files in the directory tree rooted at the + -- input directory. + + Recursive_Process + (In_Dir => Get_Name_String (Input_Directory), + Out_Dir => Get_Name_String (Output_Directory)); + end if; + end Process_Files; + ------------------------- -- Put_Char_To_Outfile -- ------------------------- @@ -397,12 +735,15 @@ package body GPrep is begin exit when S'Length = 0; - if Infile_Name = null then - Infile_Name := new String'(S); - elsif Outfile_Name = null then - Outfile_Name := new String'(S); - elsif Deffile_Name = null then - Deffile_Name := new String'(S); + Name_Len := S'Length; + Name_Buffer (1 .. Name_Len) := S; + + if Infile_Name = No_Name then + Infile_Name := Name_Find; + elsif Outfile_Name = No_Name then + Outfile_Name := Name_Find; + elsif Deffile_Name = No_Name then + Deffile_Name := Name_Find; else Fail ("too many arguments specifed"); end if; diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index f974e0f..5fd8290 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -335,6 +335,7 @@ package body Prj.Env is -- Check if the directory is already in the table for Index in 1 .. Object_Paths.Last loop + -- If it is, remove it, and add it as the last one if Object_Paths.Table (Index) = Object_Dir then @@ -361,7 +362,6 @@ package body Prj.Env is procedure Add_To_Path (Source_Dirs : String_List_Id) is Current : String_List_Id := Source_Dirs; Source_Dir : String_Element; - begin while Current /= Nil_String loop Source_Dir := String_Elements.Table (Current); @@ -384,8 +384,10 @@ package body Prj.Env is function Is_Present (Path : String; Dir : String) return Boolean is Last : constant Integer := Path'Last - Dir'Length + 1; + begin for J in Path'First .. Last loop + -- Note: the order of the conditions below is important, since -- it ensures a minimal number of string comparisons. @@ -403,8 +405,11 @@ package body Prj.Env is return False; end Is_Present; + -- Start of processing for Add_To_Path + begin if Is_Present (Ada_Path_Buffer (1 .. Ada_Path_Length), Dir) then + -- Dir is already in the path, nothing to do return; @@ -413,6 +418,7 @@ package body Prj.Env is Min_Len := Ada_Path_Length + Dir'Length; if Ada_Path_Length > 0 then + -- Add 1 for the Path_Separator character Min_Len := Min_Len + 1; @@ -535,7 +541,7 @@ package body Prj.Env is end; end if; - -- Returned the value stored + -- Returned the stored value return Namet.Get_Name_String (Data.File_Names (Body_Part).Path); end Body_Path_Name_Of; @@ -566,6 +572,7 @@ package body Prj.Env is -- For call to Close procedure Check (Project : Project_Id); + -- ??? requires a comment procedure Check_Temp_File; -- Check that a temporary file has been opened. @@ -576,11 +583,11 @@ package body Prj.Env is (Unit_Name : Name_Id; File_Name : Name_Id; Unit_Kind : Spec_Or_Body); - -- Put an SFN pragma in the temporary file. + -- Put an SFN pragma in the temporary file procedure Put (File : File_Descriptor; S : String); - procedure Put_Line (File : File_Descriptor; S : String); + -- Output procedures, analogous to normal Text_IO procs of same name ----------- -- Check -- @@ -1045,7 +1052,6 @@ package body Prj.Env is if not Status then Prj.Com.Fail ("disk full"); end if; - end Create_Mapping_File; -------------------------- @@ -1163,7 +1169,8 @@ package body Prj.Env is -- this loop will be run only once. loop - -- For every unit + -- Loop through units + -- Should have comment explaining reverse ??? for Current in reverse Units.First .. Units.Last loop Unit := Units.Table (Current); @@ -1175,7 +1182,7 @@ package body Prj.Env is then declare Current_Name : constant Name_Id := - Unit.File_Names (Body_Part).Name; + Unit.File_Names (Body_Part).Name; begin -- Case of a body present @@ -1238,7 +1245,7 @@ package body Prj.Env is then declare Current_Name : constant Name_Id := - Unit.File_Names (Specification).Name; + Unit.File_Names (Specification).Name; begin -- Case of spec present @@ -1251,8 +1258,7 @@ package body Prj.Env is Write_Eol; end if; - -- If name same as the original name, return original - -- name. + -- If name same as original name, return original name if Unit.Name = The_Original_Name or else Current_Name = The_Original_Name @@ -1265,7 +1271,6 @@ package body Prj.Env is if Full_Path then return Get_Name_String (Unit.File_Names (Specification).Path); - else return Get_Name_String (Current_Name); end if; @@ -1281,7 +1286,6 @@ package body Prj.Env is if Full_Path then return Get_Name_String (Unit.File_Names (Specification).Path); - else return Extended_Spec_Name; end if; @@ -1509,6 +1513,8 @@ package body Prj.Env is Path : out Name_Id) is begin + -- Body below could use some comments ??? + if Current_Verbosity > Default then Write_Str ("Getting Reference_Of ("""); Write_Str (Source_File_Name); @@ -1566,7 +1572,6 @@ package body Prj.Env is return; end if; - end loop; end; @@ -1583,10 +1588,11 @@ package body Prj.Env is -- Initialize -- ---------------- + -- This is a place holder for possible required initialization in + -- the future. In the current version no initialization is required. + procedure Initialize is begin - -- There is nothing to do anymore - null; end Initialize; @@ -1594,11 +1600,13 @@ package body Prj.Env is -- Path_Name_Of_Library_Unit_Body -- ------------------------------------ + -- Could use some comments in the body here ??? + function Path_Name_Of_Library_Unit_Body (Name : String; Project : Project_Id) return String is - Data : constant Project_Data := Projects.Table (Project); + Data : constant Project_Data := Projects.Table (Project); Original_Name : String := Name; Extended_Spec_Name : String := @@ -1699,7 +1707,6 @@ package body Prj.Env is return Spec_Path_Name_Of (Current); elsif Current_Name = Extended_Spec_Name then - if Current_Verbosity = High then Write_Line (" OK"); end if; @@ -1723,6 +1730,8 @@ package body Prj.Env is -- Print_Sources -- ------------------- + -- Could use some comments in this body ??? + procedure Print_Sources is Unit : Unit_Data; @@ -1769,7 +1778,6 @@ package body Prj.Env is (Namet.Get_Name_String (Unit.File_Names (Body_Part).Name)); end if; - end loop; Write_Line ("end of List of Sources."); @@ -2070,8 +2078,8 @@ package body Prj.Env is -- Set the env vars, if they need to be changed, and set the -- corresponding flags. - if - Current_Source_Path_File /= Projects.Table (Project).Include_Path_File + if Current_Source_Path_File /= + Projects.Table (Project).Include_Path_File then Current_Source_Path_File := Projects.Table (Project).Include_Path_File; @@ -2192,6 +2200,9 @@ package body Prj.Env is return Result; end Ultimate_Extension_Of; +-- Package initialization +-- What is relationshiop to procedure Initialize + begin Path_Files.Set_Last (0); end Prj.Env; diff --git a/gcc/ada/prj-env.ads b/gcc/ada/prj-env.ads index 8730ccb..e5e6bf9 100644 --- a/gcc/ada/prj-env.ads +++ b/gcc/ada/prj-env.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- 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- -- @@ -33,6 +33,7 @@ package Prj.Env is procedure Initialize; -- Put Standard_Naming_Data into Namings table (called by Prj.Initialize) + -- Above comment is obsolete (see body) ??? procedure Print_Sources; -- Output the list of sources, after Project files have been scanned diff --git a/gcc/ada/prj-nmsc.ads b/gcc/ada/prj-nmsc.ads index 56ee59f..5d13071 100644 --- a/gcc/ada/prj-nmsc.ads +++ b/gcc/ada/prj-nmsc.ads @@ -29,6 +29,10 @@ private package Prj.Nmsc is + -- It would be nicer to have a higher level statement of what these + -- procedures do (related to their names), rather than just an english + -- language summary of the implementation ??? + procedure Ada_Check (Project : Project_Id; Report_Error : Put_Line_Access; @@ -48,7 +52,7 @@ private package Prj.Nmsc is Report_Error : Put_Line_Access); -- Check the object directory and the source directories. -- Check the library attributes, including the library directory if any. - -- Get the set of specification and implementation suffixs, if any. + -- Get the set of specification and implementation suffixes, if any. -- If Report_Error is null , use the standard error reporting mechanism -- (Errout). Otherwise, report errors using Report_Error. diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads index 99a329f..2d0cf44 100644 --- a/gcc/ada/prj-proc.ads +++ b/gcc/ada/prj-proc.ads @@ -41,9 +41,11 @@ package Prj.Proc is -- Process a project file tree into project file data structures. -- If Report_Error is null, use the error reporting mechanism. -- Otherwise, report errors using Report_Error. + -- -- If Trusted_Mode is True, it is assumed that the project doesn't contain -- any file duplicated through symbolic links (although the latter are -- still valid if they point to a file which is outside of the project), -- and that no directory has a name which is a valid source name. + -- Process is a bit of a junk name, how about Process_Project_Tree??? end Prj.Proc; diff --git a/gcc/ada/s-stache.adb b/gcc/ada/s-stache.adb index 738e3ee..e95fb2d 100644 --- a/gcc/ada/s-stache.adb +++ b/gcc/ada/s-stache.adb @@ -31,5 +31,8 @@ -- -- ------------------------------------------------------------------------------ +-- As noted in the spec, this dummy body is present because otherwise we +-- have bootstrapping path problems (there used to be a real body). + package body System.Stack_Checking is end System.Stack_Checking; diff --git a/gcc/ada/s-stache.ads b/gcc/ada/s-stache.ads index 932ecf1..1e77df2 100644 --- a/gcc/ada/s-stache.ads +++ b/gcc/ada/s-stache.ads @@ -33,15 +33,19 @@ -- This package provides a system-independent implementation of stack -- checking using comparison with stack base and limit. --- This package defines basic types and objects. Operations related --- to stack checking can be found in package --- System.Stack_Checking.Operations. + +-- This package defines basic types and objects. Operations related to +-- stack checking can be found in package System.Stack_Checking.Operations. with System.Storage_Elements; package System.Stack_Checking is pragma Elaborate_Body; + -- This unit has a junk null body. The reason is that historically we + -- used to have a real body, and it causes bootstrapping path problems + -- to eliminate it, since the old body may still be present in the + -- compilation environment for a build. type Stack_Info is record Limit : System.Address := System.Null_Address; diff --git a/gcc/ada/scn.adb b/gcc/ada/scn.adb index b1e5707..0398551 100644 --- a/gcc/ada/scn.adb +++ b/gcc/ada/scn.adb @@ -134,8 +134,15 @@ package body Scn is SS : Source_Ptr; begin + -- Loop to check characters. This loop is terminated by end of + -- line, and also we need to check for the EOF case, to take + -- care of files containing only comments. + SP := Scan_Ptr; - while Source (SP) /= CR and then Source (SP) /= LF loop + while Source (SP) /= CR and then + Source (SP) /= LF and then + Source (SP) /= EOF + loop if Source (SP) = S (S'First) then SS := SP; CP := S'First; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index f8d93f3..c821c7c 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -394,7 +394,9 @@ package body Sem_Ch10 is if Unum /= No_Unit then -- Build subprogram declaration and attach parent unit to it - -- This subprogram declaration does not come from source! + -- This subprogram declaration does not come from source, + -- Nevertheless the backend must generate debugging info for + -- it, and this must be indicated explicitly. declare Loc : constant Source_Ptr := Sloc (N); @@ -418,6 +420,7 @@ package body Sem_Ch10 is Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum)); Semantics (Lib_Unit); Set_Acts_As_Spec (N, False); + Set_Needs_Debug_Info (Defining_Entity (Unit (Lib_Unit))); Set_Comes_From_Source_Default (SCS); end; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c1cff22..11483c3 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6586,11 +6586,15 @@ package body Sem_Ch3 is (Full, Related_Nod, Full_Base, Discriminant_Constraint (Priv)); -- If the full base is itself derived from private, build a congruent - -- subtype of its underlying type, for use by the back end. + -- subtype of its underlying type, for use by the back end. Do not + -- do this for a constrained record component, where the back-end has + -- the proper information and there is no place for the declaration. elsif Ekind (Full_Base) in Private_Kind and then Is_Derived_Type (Full_Base) and then Has_Discriminants (Full_Base) + and then Nkind (Related_Nod) /= N_Component_Declaration + and then (Ekind (Current_Scope) /= E_Record_Subtype) and then Nkind (Subtype_Indication (Parent (Priv))) = N_Subtype_Indication then @@ -7324,6 +7328,7 @@ package body Sem_Ch3 is Make_Subtype_Declaration (Loc, Defining_Identifier => Def_Id, Subtype_Indication => Indic); + Set_Parent (Subtyp_Decl, Parent (Related_Node)); -- Itypes must be analyzed with checks off (see itypes.ads). diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 55dbc23..1382485 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1788,10 +1788,14 @@ package body Sem_Ch6 is -- the actuals at the point of inlining, i.e. instantiation. To treat -- the formals as globals to the body to inline, we nest it within -- a dummy parameterless subprogram, declared within the real one. + -- To avoid generating an internal name (which is never public, and + -- which affects serial numbers of other generated names), we use + -- an internal symbol that cannot conflict with user declarations. Set_Parameter_Specifications (Specification (Original_Body), No_List); - Set_Defining_Unit_Name (Specification (Original_Body), - Make_Defining_Identifier (Sloc (N), New_Internal_Name ('S'))); + Set_Defining_Unit_Name + (Specification (Original_Body), + Make_Defining_Identifier (Sloc (N), Name_uParent)); Set_Corresponding_Spec (Original_Body, Empty); Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 9ab12a4..02190ca 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3786,6 +3786,13 @@ package body Sem_Util is when N_Explicit_Dereference => return True; + -- A view conversion of a tagged object is an object reference. + + when N_Type_Conversion => + return Is_Tagged_Type (Etype (Subtype_Mark (N))) + and then Is_Tagged_Type (Etype (Expression (N))) + and then Is_Object_Reference (Expression (N)); + -- An unchecked type conversion is considered to be an object if -- the operand is an object (this construction arises only as a -- result of expansion activities). |