+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.
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 \
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;
Max_Column : constant := 80;
+ No_Obj : aliased String := "<no_obj>";
+
type File_Status is (
OK, -- matching timestamp
Checksum_OK, -- only matching checksum
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;
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
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 =>");
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;
Write_Str (" Predefined");
end if;
- if U.RCI then
- Write_Str (" Remote_Call_Interface");
- end if;
end if;
end if;
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
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
-- 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)
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 --
-----------------
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.
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!)
-- 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;
-- 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.
if Deffile = No_Source_File then
Fail ("unable to find definition file """,
- Deffile_Name.all,
+ Get_Name_String (Deffile_Name),
"""");
end if;
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
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 --
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 --
--------------------------------------------
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 --
-------------------------
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;
-- 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
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);
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.
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;
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;
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;
-- For call to Close
procedure Check (Project : Project_Id);
+ -- ??? requires a comment
procedure Check_Temp_File;
-- Check that a temporary file has been opened.
(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 --
if not Status then
Prj.Com.Fail ("disk full");
end if;
-
end Create_Mapping_File;
--------------------------
-- 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);
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
then
declare
Current_Name : constant Name_Id :=
- Unit.File_Names (Specification).Name;
+ Unit.File_Names (Specification).Name;
begin
-- Case of spec present
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
if Full_Path then
return Get_Name_String
(Unit.File_Names (Specification).Path);
-
else
return Get_Name_String (Current_Name);
end if;
if Full_Path then
return Get_Name_String
(Unit.File_Names (Specification).Path);
-
else
return Extended_Spec_Name;
end if;
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);
return;
end if;
-
end loop;
end;
-- 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;
-- 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 :=
return Spec_Path_Name_Of (Current);
elsif Current_Name = Extended_Spec_Name then
-
if Current_Verbosity = High then
Write_Line (" OK");
end if;
-- Print_Sources --
-------------------
+ -- Could use some comments in this body ???
+
procedure Print_Sources is
Unit : Unit_Data;
(Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name));
end if;
-
end loop;
Write_Line ("end of List of Sources.");
-- 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;
return Result;
end Ultimate_Extension_Of;
+-- Package initialization
+-- What is relationshiop to procedure Initialize
+
begin
Path_Files.Set_Last (0);
end Prj.Env;
-- --
-- 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- --
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
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;
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.
-- 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;
-- --
------------------------------------------------------------------------------
+-- 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;
-- 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;
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;
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);
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;
(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
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).
-- 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);
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).
projects / gcc.git / commitdiff