Commit 24105bab by Arnaud Charlet

[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
parent ead61c1d
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> 2004-03-21 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* decl.c (gnat_to_gnu_entity): Use SUBSTITUTE_PLACEHOLDER_IN_EXPR. * decl.c (gnat_to_gnu_entity): Use SUBSTITUTE_PLACEHOLDER_IN_EXPR.
......
...@@ -2793,10 +2793,8 @@ ada/s-sopco5.o : ada/system.ads ada/s-secsta.ads ada/s-stoele.ads \ ...@@ -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-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-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-stache.o : ada/system.ads ada/s-stache.ads ada/s-stache.adb \
ada/s-crtl.ads ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads \ ada/s-stoele.ads ada/s-stoele.adb ada/unchconv.ads
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-traent.ads ada/unchconv.ads
ada/s-stalib.o : ada/ada.ads ada/a-except.ads ada/system.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 \ ada/s-memory.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
......
...@@ -253,7 +253,7 @@ package ALI is ...@@ -253,7 +253,7 @@ package ALI is
Dynamic_Elab : Boolean; Dynamic_Elab : Boolean;
-- Set to True if the unit was compiled with dynamic elaboration -- 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). -- was used to compile the unit).
Elaborate_Body : Boolean; Elaborate_Body : Boolean;
......
...@@ -45,6 +45,8 @@ procedure Gnatls is ...@@ -45,6 +45,8 @@ procedure Gnatls is
Max_Column : constant := 80; Max_Column : constant := 80;
No_Obj : aliased String := "<no_obj>";
type File_Status is ( type File_Status is (
OK, -- matching timestamp OK, -- matching timestamp
Checksum_OK, -- only matching checksum Checksum_OK, -- only matching checksum
...@@ -271,8 +273,13 @@ procedure Gnatls is ...@@ -271,8 +273,13 @@ procedure Gnatls is
end if; end if;
if Print_Object then if Print_Object then
Get_Name_String (ALIs.Table (Id).Ofile_Full_Name); if ALIs.Table (Id).No_Object then
Max_Obj_Length := Integer'Max (Max_Obj_Length, Name_Len + 1); 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 if; end if;
end loop; end loop;
...@@ -363,8 +370,13 @@ procedure Gnatls is ...@@ -363,8 +370,13 @@ procedure Gnatls is
begin begin
if Print_Object then if Print_Object then
Get_Name_String (O); if O /= No_File then
Object_Name := To_Host_File_Spec (Name_Buffer (1 .. Name_Len)); 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); Write_Str (Object_Name.all);
if Print_Source or else Print_Unit then if Print_Source or else Print_Unit then
...@@ -501,14 +513,21 @@ procedure Gnatls is ...@@ -501,14 +513,21 @@ procedure Gnatls is
end if; end if;
if Verbose_Mode then if Verbose_Mode then
if U.Preelab or if U.Preelab or
U.No_Elab or U.No_Elab or
U.Pure or U.Pure or
U.Elaborate_Body or U.Dynamic_Elab or
U.Remote_Types or U.Has_RACW or
U.Shared_Passive or U.Remote_Types or
U.RCI or U.Shared_Passive or
U.Predefined 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 then
Write_Eol; Write_Str (" Flags =>"); Write_Eol; Write_Str (" Flags =>");
...@@ -524,6 +543,50 @@ procedure Gnatls is ...@@ -524,6 +543,50 @@ procedure Gnatls is
Write_Str (" Pure"); Write_Str (" Pure");
end if; 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 if U.Elaborate_Body then
Write_Str (" Elaborate Body"); Write_Str (" Elaborate Body");
end if; end if;
...@@ -540,9 +603,6 @@ procedure Gnatls is ...@@ -540,9 +603,6 @@ procedure Gnatls is
Write_Str (" Predefined"); Write_Str (" Predefined");
end if; end if;
if U.RCI then
Write_Str (" Remote_Call_Interface");
end if;
end if; end if;
end if; end if;
...@@ -966,7 +1026,11 @@ begin ...@@ -966,7 +1026,11 @@ begin
Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname); Get_Name_String (Units.Table (ALIs.Table (Id).First_Unit).Uname);
if Also_Predef or else not Is_Internal_Unit then 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 -- In verbose mode print all main units in the ALI file, otherwise
-- just print the first one to ease columnwise printout -- just print the first one to ease columnwise printout
......
...@@ -335,6 +335,7 @@ package body Prj.Env is ...@@ -335,6 +335,7 @@ package body Prj.Env is
-- Check if the directory is already in the table -- Check if the directory is already in the table
for Index in 1 .. Object_Paths.Last loop for Index in 1 .. Object_Paths.Last loop
-- If it is, remove it, and add it as the last one -- If it is, remove it, and add it as the last one
if Object_Paths.Table (Index) = Object_Dir then if Object_Paths.Table (Index) = Object_Dir then
...@@ -361,7 +362,6 @@ package body Prj.Env is ...@@ -361,7 +362,6 @@ package body Prj.Env is
procedure Add_To_Path (Source_Dirs : String_List_Id) is procedure Add_To_Path (Source_Dirs : String_List_Id) is
Current : String_List_Id := Source_Dirs; Current : String_List_Id := Source_Dirs;
Source_Dir : String_Element; Source_Dir : String_Element;
begin begin
while Current /= Nil_String loop while Current /= Nil_String loop
Source_Dir := String_Elements.Table (Current); Source_Dir := String_Elements.Table (Current);
...@@ -384,8 +384,10 @@ package body Prj.Env is ...@@ -384,8 +384,10 @@ package body Prj.Env is
function Is_Present (Path : String; Dir : String) return Boolean is function Is_Present (Path : String; Dir : String) return Boolean is
Last : constant Integer := Path'Last - Dir'Length + 1; Last : constant Integer := Path'Last - Dir'Length + 1;
begin begin
for J in Path'First .. Last loop for J in Path'First .. Last loop
-- Note: the order of the conditions below is important, since -- Note: the order of the conditions below is important, since
-- it ensures a minimal number of string comparisons. -- it ensures a minimal number of string comparisons.
...@@ -403,8 +405,11 @@ package body Prj.Env is ...@@ -403,8 +405,11 @@ package body Prj.Env is
return False; return False;
end Is_Present; end Is_Present;
-- Start of processing for Add_To_Path
begin begin
if Is_Present (Ada_Path_Buffer (1 .. Ada_Path_Length), Dir) then if Is_Present (Ada_Path_Buffer (1 .. Ada_Path_Length), Dir) then
-- Dir is already in the path, nothing to do -- Dir is already in the path, nothing to do
return; return;
...@@ -413,6 +418,7 @@ package body Prj.Env is ...@@ -413,6 +418,7 @@ package body Prj.Env is
Min_Len := Ada_Path_Length + Dir'Length; Min_Len := Ada_Path_Length + Dir'Length;
if Ada_Path_Length > 0 then if Ada_Path_Length > 0 then
-- Add 1 for the Path_Separator character -- Add 1 for the Path_Separator character
Min_Len := Min_Len + 1; Min_Len := Min_Len + 1;
...@@ -535,7 +541,7 @@ package body Prj.Env is ...@@ -535,7 +541,7 @@ package body Prj.Env is
end; end;
end if; end if;
-- Returned the value stored -- Returned the stored value
return Namet.Get_Name_String (Data.File_Names (Body_Part).Path); return Namet.Get_Name_String (Data.File_Names (Body_Part).Path);
end Body_Path_Name_Of; end Body_Path_Name_Of;
...@@ -566,6 +572,7 @@ package body Prj.Env is ...@@ -566,6 +572,7 @@ package body Prj.Env is
-- For call to Close -- For call to Close
procedure Check (Project : Project_Id); procedure Check (Project : Project_Id);
-- ??? requires a comment
procedure Check_Temp_File; procedure Check_Temp_File;
-- Check that a temporary file has been opened. -- Check that a temporary file has been opened.
...@@ -576,11 +583,11 @@ package body Prj.Env is ...@@ -576,11 +583,11 @@ package body Prj.Env is
(Unit_Name : Name_Id; (Unit_Name : Name_Id;
File_Name : Name_Id; File_Name : Name_Id;
Unit_Kind : Spec_Or_Body); 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 (File : File_Descriptor; S : String);
procedure Put_Line (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 -- -- Check --
...@@ -1045,7 +1052,6 @@ package body Prj.Env is ...@@ -1045,7 +1052,6 @@ package body Prj.Env is
if not Status then if not Status then
Prj.Com.Fail ("disk full"); Prj.Com.Fail ("disk full");
end if; end if;
end Create_Mapping_File; end Create_Mapping_File;
-------------------------- --------------------------
...@@ -1163,7 +1169,8 @@ package body Prj.Env is ...@@ -1163,7 +1169,8 @@ package body Prj.Env is
-- this loop will be run only once. -- this loop will be run only once.
loop loop
-- For every unit -- Loop through units
-- Should have comment explaining reverse ???
for Current in reverse Units.First .. Units.Last loop for Current in reverse Units.First .. Units.Last loop
Unit := Units.Table (Current); Unit := Units.Table (Current);
...@@ -1175,7 +1182,7 @@ package body Prj.Env is ...@@ -1175,7 +1182,7 @@ package body Prj.Env is
then then
declare declare
Current_Name : constant Name_Id := Current_Name : constant Name_Id :=
Unit.File_Names (Body_Part).Name; Unit.File_Names (Body_Part).Name;
begin begin
-- Case of a body present -- Case of a body present
...@@ -1238,7 +1245,7 @@ package body Prj.Env is ...@@ -1238,7 +1245,7 @@ package body Prj.Env is
then then
declare declare
Current_Name : constant Name_Id := Current_Name : constant Name_Id :=
Unit.File_Names (Specification).Name; Unit.File_Names (Specification).Name;
begin begin
-- Case of spec present -- Case of spec present
...@@ -1251,8 +1258,7 @@ package body Prj.Env is ...@@ -1251,8 +1258,7 @@ package body Prj.Env is
Write_Eol; Write_Eol;
end if; end if;
-- If name same as the original name, return original -- If name same as original name, return original name
-- name.
if Unit.Name = The_Original_Name if Unit.Name = The_Original_Name
or else Current_Name = The_Original_Name or else Current_Name = The_Original_Name
...@@ -1265,7 +1271,6 @@ package body Prj.Env is ...@@ -1265,7 +1271,6 @@ package body Prj.Env is
if Full_Path then if Full_Path then
return Get_Name_String return Get_Name_String
(Unit.File_Names (Specification).Path); (Unit.File_Names (Specification).Path);
else else
return Get_Name_String (Current_Name); return Get_Name_String (Current_Name);
end if; end if;
...@@ -1281,7 +1286,6 @@ package body Prj.Env is ...@@ -1281,7 +1286,6 @@ package body Prj.Env is
if Full_Path then if Full_Path then
return Get_Name_String return Get_Name_String
(Unit.File_Names (Specification).Path); (Unit.File_Names (Specification).Path);
else else
return Extended_Spec_Name; return Extended_Spec_Name;
end if; end if;
...@@ -1509,6 +1513,8 @@ package body Prj.Env is ...@@ -1509,6 +1513,8 @@ package body Prj.Env is
Path : out Name_Id) Path : out Name_Id)
is is
begin begin
-- Body below could use some comments ???
if Current_Verbosity > Default then if Current_Verbosity > Default then
Write_Str ("Getting Reference_Of ("""); Write_Str ("Getting Reference_Of (""");
Write_Str (Source_File_Name); Write_Str (Source_File_Name);
...@@ -1566,7 +1572,6 @@ package body Prj.Env is ...@@ -1566,7 +1572,6 @@ package body Prj.Env is
return; return;
end if; end if;
end loop; end loop;
end; end;
...@@ -1583,10 +1588,11 @@ package body Prj.Env is ...@@ -1583,10 +1588,11 @@ package body Prj.Env is
-- Initialize -- -- Initialize --
---------------- ----------------
-- This is a place holder for possible required initialization in
-- the future. In the current version no initialization is required.
procedure Initialize is procedure Initialize is
begin begin
-- There is nothing to do anymore
null; null;
end Initialize; end Initialize;
...@@ -1594,11 +1600,13 @@ package body Prj.Env is ...@@ -1594,11 +1600,13 @@ package body Prj.Env is
-- Path_Name_Of_Library_Unit_Body -- -- Path_Name_Of_Library_Unit_Body --
------------------------------------ ------------------------------------
-- Could use some comments in the body here ???
function Path_Name_Of_Library_Unit_Body function Path_Name_Of_Library_Unit_Body
(Name : String; (Name : String;
Project : Project_Id) return String Project : Project_Id) return String
is is
Data : constant Project_Data := Projects.Table (Project); Data : constant Project_Data := Projects.Table (Project);
Original_Name : String := Name; Original_Name : String := Name;
Extended_Spec_Name : String := Extended_Spec_Name : String :=
...@@ -1699,7 +1707,6 @@ package body Prj.Env is ...@@ -1699,7 +1707,6 @@ package body Prj.Env is
return Spec_Path_Name_Of (Current); return Spec_Path_Name_Of (Current);
elsif Current_Name = Extended_Spec_Name then elsif Current_Name = Extended_Spec_Name then
if Current_Verbosity = High then if Current_Verbosity = High then
Write_Line (" OK"); Write_Line (" OK");
end if; end if;
...@@ -1723,6 +1730,8 @@ package body Prj.Env is ...@@ -1723,6 +1730,8 @@ package body Prj.Env is
-- Print_Sources -- -- Print_Sources --
------------------- -------------------
-- Could use some comments in this body ???
procedure Print_Sources is procedure Print_Sources is
Unit : Unit_Data; Unit : Unit_Data;
...@@ -1769,7 +1778,6 @@ package body Prj.Env is ...@@ -1769,7 +1778,6 @@ package body Prj.Env is
(Namet.Get_Name_String (Namet.Get_Name_String
(Unit.File_Names (Body_Part).Name)); (Unit.File_Names (Body_Part).Name));
end if; end if;
end loop; end loop;
Write_Line ("end of List of Sources."); Write_Line ("end of List of Sources.");
...@@ -2070,8 +2078,8 @@ package body Prj.Env is ...@@ -2070,8 +2078,8 @@ package body Prj.Env is
-- Set the env vars, if they need to be changed, and set the -- Set the env vars, if they need to be changed, and set the
-- corresponding flags. -- corresponding flags.
if if Current_Source_Path_File /=
Current_Source_Path_File /= Projects.Table (Project).Include_Path_File Projects.Table (Project).Include_Path_File
then then
Current_Source_Path_File := Current_Source_Path_File :=
Projects.Table (Project).Include_Path_File; Projects.Table (Project).Include_Path_File;
...@@ -2192,6 +2200,9 @@ package body Prj.Env is ...@@ -2192,6 +2200,9 @@ package body Prj.Env is
return Result; return Result;
end Ultimate_Extension_Of; end Ultimate_Extension_Of;
-- Package initialization
-- What is relationshiop to procedure Initialize
begin begin
Path_Files.Set_Last (0); Path_Files.Set_Last (0);
end Prj.Env; end Prj.Env;
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -33,6 +33,7 @@ package Prj.Env is ...@@ -33,6 +33,7 @@ package Prj.Env is
procedure Initialize; procedure Initialize;
-- Put Standard_Naming_Data into Namings table (called by Prj.Initialize) -- Put Standard_Naming_Data into Namings table (called by Prj.Initialize)
-- Above comment is obsolete (see body) ???
procedure Print_Sources; procedure Print_Sources;
-- Output the list of sources, after Project files have been scanned -- Output the list of sources, after Project files have been scanned
......
...@@ -29,6 +29,10 @@ ...@@ -29,6 +29,10 @@
private package Prj.Nmsc is 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 procedure Ada_Check
(Project : Project_Id; (Project : Project_Id;
Report_Error : Put_Line_Access; Report_Error : Put_Line_Access;
...@@ -48,7 +52,7 @@ private package Prj.Nmsc is ...@@ -48,7 +52,7 @@ private package Prj.Nmsc is
Report_Error : Put_Line_Access); Report_Error : Put_Line_Access);
-- Check the object directory and the source directories. -- Check the object directory and the source directories.
-- Check the library attributes, including the library directory if any. -- 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 -- If Report_Error is null , use the standard error reporting mechanism
-- (Errout). Otherwise, report errors using Report_Error. -- (Errout). Otherwise, report errors using Report_Error.
......
...@@ -41,9 +41,11 @@ package Prj.Proc is ...@@ -41,9 +41,11 @@ package Prj.Proc is
-- Process a project file tree into project file data structures. -- Process a project file tree into project file data structures.
-- If Report_Error is null, use the error reporting mechanism. -- If Report_Error is null, use the error reporting mechanism.
-- Otherwise, report errors using Report_Error. -- Otherwise, report errors using Report_Error.
--
-- If Trusted_Mode is True, it is assumed that the project doesn't contain -- If Trusted_Mode is True, it is assumed that the project doesn't contain
-- any file duplicated through symbolic links (although the latter are -- any file duplicated through symbolic links (although the latter are
-- still valid if they point to a file which is outside of the project), -- 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. -- 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; end Prj.Proc;
...@@ -31,5 +31,8 @@ ...@@ -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 package body System.Stack_Checking is
end System.Stack_Checking; end System.Stack_Checking;
...@@ -33,15 +33,19 @@ ...@@ -33,15 +33,19 @@
-- This package provides a system-independent implementation of stack -- This package provides a system-independent implementation of stack
-- checking using comparison with stack base and limit. -- 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 -- This package defines basic types and objects. Operations related to
-- System.Stack_Checking.Operations. -- stack checking can be found in package System.Stack_Checking.Operations.
with System.Storage_Elements; with System.Storage_Elements;
package System.Stack_Checking is package System.Stack_Checking is
pragma Elaborate_Body; 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 type Stack_Info is record
Limit : System.Address := System.Null_Address; Limit : System.Address := System.Null_Address;
......
...@@ -134,8 +134,15 @@ package body Scn is ...@@ -134,8 +134,15 @@ package body Scn is
SS : Source_Ptr; SS : Source_Ptr;
begin 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; 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 if Source (SP) = S (S'First) then
SS := SP; SS := SP;
CP := S'First; CP := S'First;
......
...@@ -394,7 +394,9 @@ package body Sem_Ch10 is ...@@ -394,7 +394,9 @@ package body Sem_Ch10 is
if Unum /= No_Unit then if Unum /= No_Unit then
-- Build subprogram declaration and attach parent unit to it -- 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 declare
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
...@@ -418,6 +420,7 @@ package body Sem_Ch10 is ...@@ -418,6 +420,7 @@ package body Sem_Ch10 is
Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum)); Set_Parent_Spec (Unit (Lib_Unit), Cunit (Unum));
Semantics (Lib_Unit); Semantics (Lib_Unit);
Set_Acts_As_Spec (N, False); Set_Acts_As_Spec (N, False);
Set_Needs_Debug_Info (Defining_Entity (Unit (Lib_Unit)));
Set_Comes_From_Source_Default (SCS); Set_Comes_From_Source_Default (SCS);
end; end;
end if; end if;
......
...@@ -6586,11 +6586,15 @@ package body Sem_Ch3 is ...@@ -6586,11 +6586,15 @@ package body Sem_Ch3 is
(Full, Related_Nod, Full_Base, Discriminant_Constraint (Priv)); (Full, Related_Nod, Full_Base, Discriminant_Constraint (Priv));
-- If the full base is itself derived from private, build a congruent -- 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 elsif Ekind (Full_Base) in Private_Kind
and then Is_Derived_Type (Full_Base) and then Is_Derived_Type (Full_Base)
and then Has_Discriminants (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 and then
Nkind (Subtype_Indication (Parent (Priv))) = N_Subtype_Indication Nkind (Subtype_Indication (Parent (Priv))) = N_Subtype_Indication
then then
...@@ -7324,6 +7328,7 @@ package body Sem_Ch3 is ...@@ -7324,6 +7328,7 @@ package body Sem_Ch3 is
Make_Subtype_Declaration (Loc, Make_Subtype_Declaration (Loc,
Defining_Identifier => Def_Id, Defining_Identifier => Def_Id,
Subtype_Indication => Indic); Subtype_Indication => Indic);
Set_Parent (Subtyp_Decl, Parent (Related_Node)); Set_Parent (Subtyp_Decl, Parent (Related_Node));
-- Itypes must be analyzed with checks off (see itypes.ads). -- Itypes must be analyzed with checks off (see itypes.ads).
......
...@@ -1788,10 +1788,14 @@ package body Sem_Ch6 is ...@@ -1788,10 +1788,14 @@ package body Sem_Ch6 is
-- the actuals at the point of inlining, i.e. instantiation. To treat -- 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 -- the formals as globals to the body to inline, we nest it within
-- a dummy parameterless subprogram, declared within the real one. -- 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_Parameter_Specifications (Specification (Original_Body), No_List);
Set_Defining_Unit_Name (Specification (Original_Body), Set_Defining_Unit_Name
Make_Defining_Identifier (Sloc (N), New_Internal_Name ('S'))); (Specification (Original_Body),
Make_Defining_Identifier (Sloc (N), Name_uParent));
Set_Corresponding_Spec (Original_Body, Empty); Set_Corresponding_Spec (Original_Body, Empty);
Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False); Body_To_Analyze := Copy_Generic_Node (Original_Body, Empty, False);
......
...@@ -3786,6 +3786,13 @@ package body Sem_Util is ...@@ -3786,6 +3786,13 @@ package body Sem_Util is
when N_Explicit_Dereference => when N_Explicit_Dereference =>
return True; 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 -- An unchecked type conversion is considered to be an object if
-- the operand is an object (this construction arises only as a -- the operand is an object (this construction arises only as a
-- result of expansion activities). -- result of expansion activities).
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment