Skip to content

R
riscv-gcc-1
Commit 79503fdd by Geert Bosch
Options

* make.adb: 

	(Switches_Of): New function
	(Test_If_Relative_Path): New procedure
	(Add_Switches): Use new function Switches_Of
	(Collect_Arguments_And_Compile): Use new function Switches_Of.
	When using a project file, test if there are any relative
	search path. Fail if there are any.
	(Gnatmake): Only add switches for the primary directory when not using
	a project file. When using a project file, change directory to the
	object directory of the main project file. When using a project file,
	test if there are any relative search path. Fail if there are any.
	When using a project file, fail if specified executable is relative
	path with directory information, and prepend executable, if not
	specified as an absolute path, with the exec directory.  Make sure
	that only one -o switch is transmitted to the linker.

	* prj-attr.adb (Initialization_Data): Add project attribute Exec_Dir

	* prj-nmsc.adb:
	(Ada_Check): Get Spec_Suffix_Loc and Impl_Suffix_Loc,
	when using a non standard naming scheme.
	(Check_Ada_Naming_Scheme): Make sure that error messages
	do not raise exceptions.
	(Is_Illegal_Append): Return True if there is no dot in the suffix.
	(Language_Independent_Check): Check the exec directory.

	* prj.adb (Project_Empty): Add new component Exec_Directory

	* prj.ads:
	(Default_Ada_Spec_Suffix, Default_Ada_Impl_Suffix): Add defaults.
	(Project_Data): Add component Exec_Directory

	* snames.adb: Updated to match snames.ads revision 1.215

	* snames.ads: Added Exec_Dir

	* make.adb: Minor reformatting

	* prj-nmsc.adb: Minor reformatting

	* snames.adb: Updated to match snames.ads

	* snames.ads: Alphebetize entries for project file

	* trans.c (process_freeze_entity): Do nothing if the entity is a
	subprogram that was already elaborated.

	* decl.c (gnat_to_gnu_entity, object): Do not back-annotate Alignment
	and Esize if object is referenced via pointer.

From-SVN: r48127
parent 855ff2e1
Showing with 516 additions and 169 deletions
gcc/ada/ChangeLog
2001-12-17 Vincent Celier <celier@gnat.com>
* make.adb:
(Switches_Of): New function
(Test_If_Relative_Path): New procedure
(Add_Switches): Use new function Switches_Of
(Collect_Arguments_And_Compile): Use new function Switches_Of.
When using a project file, test if there are any relative
search path. Fail if there are any.
(Gnatmake): Only add switches for the primary directory when not using
a project file. When using a project file, change directory to the
object directory of the main project file. When using a project file,
test if there are any relative search path. Fail if there are any.
When using a project file, fail if specified executable is relative
path with directory information, and prepend executable, if not
specified as an absolute path, with the exec directory. Make sure
that only one -o switch is transmitted to the linker.
* prj-attr.adb (Initialization_Data): Add project attribute Exec_Dir
* prj-nmsc.adb:
(Ada_Check): Get Spec_Suffix_Loc and Impl_Suffix_Loc,
when using a non standard naming scheme.
(Check_Ada_Naming_Scheme): Make sure that error messages
do not raise exceptions.
(Is_Illegal_Append): Return True if there is no dot in the suffix.
(Language_Independent_Check): Check the exec directory.
* prj.adb (Project_Empty): Add new component Exec_Directory
* prj.ads:
(Default_Ada_Spec_Suffix, Default_Ada_Impl_Suffix): Add defaults.
(Project_Data): Add component Exec_Directory
* snames.adb: Updated to match snames.ads revision 1.215
* snames.ads: Added Exec_Dir
2001-12-17 Robert Dewar <dewar@gnat.com>
* make.adb: Minor reformatting
* prj-nmsc.adb: Minor reformatting
* snames.adb: Updated to match snames.ads
* snames.ads: Alphebetize entries for project file
2001-12-17 Ed Schonberg <schonber@gnat.com>
* trans.c (process_freeze_entity): Do nothing if the entity is a
subprogram that was already elaborated.
2001-12-17 Richard Kenner <kenner@gnat.com>
* decl.c (gnat_to_gnu_entity, object): Do not back-annotate Alignment
and Esize if object is referenced via pointer.
2001-12-17 Ed Schonberg <schonber@gnat.com> 2001-12-17 Ed Schonberg <schonber@gnat.com>
* sem_ch3.adb (Analyze_Variant_Part): check that type of discriminant * sem_ch3.adb (Analyze_Variant_Part): check that type of discriminant
......
gcc/ada/decl.c
...@@ -1060,12 +1060,15 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition) ...@@ -1060,12 +1060,15 @@ gnat_to_gnu_entity (gnat_entity, gnu_expr, definition)
} }
/* Back-annotate the Alignment of the object if not already in the /* Back-annotate the Alignment of the object if not already in the
tree. Likewise for Esize if the object is of a constant size. */ tree. Likewise for Esize if the object is of a constant size.
if (Unknown_Alignment (gnat_entity)) But if the "object" is actually a pointer to an object, the
alignment and size are the same as teh type, so don't back-annotate
the values for the pointer. */
if (! used_by_ref && Unknown_Alignment (gnat_entity))
Set_Alignment (gnat_entity, Set_Alignment (gnat_entity,
UI_From_Int (DECL_ALIGN (gnu_decl) / BITS_PER_UNIT)); UI_From_Int (DECL_ALIGN (gnu_decl) / BITS_PER_UNIT));
if (Unknown_Esize (gnat_entity) if (! used_by_ref && Unknown_Esize (gnat_entity)
&& DECL_SIZE (gnu_decl) != 0) && DECL_SIZE (gnu_decl) != 0)
{ {
tree gnu_back_size = DECL_SIZE (gnu_decl); tree gnu_back_size = DECL_SIZE (gnu_decl);
......
gcc/ada/make.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- $Revision: 1.5 $ -- $Revision$
-- -- -- --
-- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
-- -- -- --
...@@ -28,7 +28,9 @@ ...@@ -28,7 +28,9 @@
with Ada.Exceptions; use Ada.Exceptions; with Ada.Exceptions; use Ada.Exceptions;
with Ada.Command_Line; use Ada.Command_Line; with Ada.Command_Line; use Ada.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;
with ALI; use ALI; with ALI; use ALI;
with ALI.Util; use ALI.Util; with ALI.Util; use ALI.Util;
...@@ -376,6 +378,25 @@ package body Make is ...@@ -376,6 +378,25 @@ package body Make is
-- The caller process ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are -- The caller process ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
-- not affected. -- not affected.
function Switches_Of
(Source_File : Name_Id;
Source_File_Name : String;
Naming : Naming_Data;
In_Package : Package_Id;
Allow_ALI : Boolean)
return Variable_Value;
-- Return the switches for the source file in the specified package
-- of a project file. If the Source_File ends with a standard GNAT
-- extension (".ads" or ".adb"), try first the full name, then the
-- name without the extension. If there is no switches for either
-- names, try the default switches for Ada. If all failed, return
-- No_Variable_Value.
procedure Test_If_Relative_Path (Switch : String_Access);
-- Test if Switch is a relative search path switch.
-- Fail if it is. This subprogram is only called
-- when using project files.
procedure Set_Library_For procedure Set_Library_For
(Project : Project_Id; (Project : Project_Id;
There_Are_Libraries : in out Boolean); There_Are_Libraries : in out Boolean);
...@@ -630,27 +651,18 @@ package body Make is ...@@ -630,27 +651,18 @@ package body Make is
Switch_List : String_List_Id; Switch_List : String_List_Id;
Element : String_Element; Element : String_Element;
Switches_Array : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays => Packages.Table (The_Package).Decl.Arrays);
Default_Switches_Array : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Packages.Table (The_Package).Decl.Arrays);
begin begin
if File_Name'Length > 0 then if File_Name'Length > 0 then
Name_Len := File_Name'Length; Name_Len := File_Name'Length;
Name_Buffer (1 .. Name_Len) := File_Name; Name_Buffer (1 .. Name_Len) := File_Name;
Switches := Switches :=
Prj.Util.Value_Of (Index => Name_Find, In_Array => Switches_Array); Switches_Of
(Source_File => Name_Find,
if Switches = Nil_Variable_Value then Source_File_Name => File_Name,
Switches := Prj.Util.Value_Of Naming => Projects.Table (Main_Project).Naming,
(Index => Name_Ada, In_Package => The_Package,
In_Array => Default_Switches_Array); Allow_ALI =>
end if; Program = Binder or else Program = Linker);
case Switches.Kind is case Switches.Kind is
when Undefined => when Undefined =>
...@@ -861,30 +873,30 @@ package body Make is ...@@ -861,30 +873,30 @@ package body Make is
-- Data declarations for Check -- -- Data declarations for Check --
--------------------------------- ---------------------------------
Full_Lib_File : File_Name_Type; Full_Lib_File : File_Name_Type;
-- Full name of current library file -- Full name of current library file
Full_Obj_File : File_Name_Type; Full_Obj_File : File_Name_Type;
-- Full name of the object file corresponding to Lib_File. -- Full name of the object file corresponding to Lib_File.
Lib_Stamp : Time_Stamp_Type; Lib_Stamp : Time_Stamp_Type;
-- Time stamp of the current ada library file. -- Time stamp of the current ada library file.
Obj_Stamp : Time_Stamp_Type; Obj_Stamp : Time_Stamp_Type;
-- Time stamp of the current object file. -- Time stamp of the current object file.
Modified_Source : File_Name_Type; Modified_Source : File_Name_Type;
-- The first source in Lib_File whose current time stamp differs -- The first source in Lib_File whose current time stamp differs
-- from that stored in Lib_File. -- from that stored in Lib_File.
New_Spec : File_Name_Type; New_Spec : File_Name_Type;
-- If Lib_File contains in its W (with) section a body (for a -- If Lib_File contains in its W (with) section a body (for a
-- subprogram) for which there exists a spec and the spec did not -- subprogram) for which there exists a spec and the spec did not
-- appear in the Sdep section of Lib_File, New_Spec contains the file -- appear in the Sdep section of Lib_File, New_Spec contains the file
-- name of this new spec. -- name of this new spec.
Source_Name : Name_Id; Source_Name : Name_Id;
Text : Text_Buffer_Ptr; Text : Text_Buffer_Ptr;
Prev_Switch : Character; Prev_Switch : Character;
-- First character of previous switch processed -- First character of previous switch processed
...@@ -1034,6 +1046,8 @@ package body Make is ...@@ -1034,6 +1046,8 @@ package body Make is
end if; end if;
end loop; end loop;
-- Special_Arg is non-null
else else
for J in Special_Arg'Range loop for J in Special_Arg'Range loop
...@@ -1679,34 +1693,14 @@ package body Make is ...@@ -1679,34 +1693,14 @@ package body Make is
-- the specific switches for the current source, -- the specific switches for the current source,
-- or the global switches, if any. -- or the global switches, if any.
declare Switches := Switches_Of
Defaults : constant Array_Element_Id := (Source_File => Source_File,
Prj.Util.Value_Of Source_File_Name => Source_File_Name,
(Name => Name_Default_Switches, Naming =>
In_Arrays => Projects.Table (Current_Project).Naming,
Packages.Table In_Package => Compiler_Package,
(Compiler_Package) .Decl.Arrays); Allow_ALI => False);
Switches_Array : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays =>
Packages.Table
(Compiler_Package).
Decl.Arrays);
begin
Switches :=
Prj.Util.Value_Of
(Index => Source_File,
In_Array => Switches_Array);
if Switches = Nil_Variable_Value then
Switches :=
Prj.Util.Value_Of
(Index => Name_Ada, In_Array => Defaults);
end if;
end;
end if; end if;
case Switches.Kind is case Switches.Kind is
...@@ -1739,6 +1733,7 @@ package body Make is ...@@ -1739,6 +1733,7 @@ package body Make is
String_To_Name_Buffer (Element.Value); String_To_Name_Buffer (Element.Value);
New_Args (Index) := New_Args (Index) :=
new String' (Name_Buffer (1 .. Name_Len)); new String' (Name_Buffer (1 .. Name_Len));
Test_If_Relative_Path (New_Args (Index));
Current := Element.Next; Current := Element.Next;
end loop; end loop;
...@@ -1764,6 +1759,7 @@ package body Make is ...@@ -1764,6 +1759,7 @@ package body Make is
(Name_Buffer (1 .. Name_Len))); (Name_Buffer (1 .. Name_Len)));
begin begin
Test_If_Relative_Path (New_Args (1));
Pid := Compile Pid := Compile
(Path_Name, (Path_Name,
Lib_File, Lib_File,
...@@ -2388,7 +2384,6 @@ package body Make is ...@@ -2388,7 +2384,6 @@ package body Make is
end loop; end loop;
end; end;
end if; end if;
end Compile_Sources; end Compile_Sources;
------------- -------------
...@@ -2551,11 +2546,11 @@ package body Make is ...@@ -2551,11 +2546,11 @@ package body Make is
declare declare
Main_Id : constant Name_Id := Name_Find; Main_Id : constant Name_Id := Name_Find;
Mains : constant Prj.Variable_Value := Mains : constant Prj.Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Variable_Name => Main_Id, (Variable_Name => Main_Id,
In_Variables => In_Variables =>
Projects.Table (Main_Project).Decl.Attributes); Projects.Table (Main_Project).Decl.Attributes);
Value : String_List_Id := Mains.Values; Value : String_List_Id := Mains.Values;
...@@ -2615,21 +2610,22 @@ package body Make is ...@@ -2615,21 +2610,22 @@ package body Make is
if Project_File_Name = null then if Project_File_Name = null then
Add_Switch ("-I-", Compiler, And_Save => True); Add_Switch ("-I-", Compiler, And_Save => True);
Add_Switch ("-I-", Binder, And_Save => True); Add_Switch ("-I-", Binder, And_Save => True);
end if;
if Opt.Look_In_Primary_Dir then if Opt.Look_In_Primary_Dir then
Add_Switch Add_Switch
("-I" & ("-I" &
Normalize_Directory_Name Normalize_Directory_Name
(Get_Primary_Src_Search_Directory.all).all, (Get_Primary_Src_Search_Directory.all).all,
Compiler, Append_Switch => False, Compiler, Append_Switch => False,
And_Save => False); And_Save => False);
Add_Switch ("-aO" & Normalized_CWD,
Binder,
Append_Switch => False,
And_Save => False);
end if;
Add_Switch ("-aO" & Normalized_CWD,
Binder,
Append_Switch => False,
And_Save => False);
end if; end if;
-- If the user wants a program without a main subprogram, add the -- If the user wants a program without a main subprogram, add the
...@@ -2641,6 +2637,9 @@ package body Make is ...@@ -2641,6 +2637,9 @@ package body Make is
if Main_Project /= No_Project then if Main_Project /= No_Project then
Change_Dir
(Get_Name_String (Projects.Table (Main_Project).Object_Directory));
-- Find the file name of the main unit -- Find the file name of the main unit
declare declare
...@@ -2859,12 +2858,26 @@ package body Make is ...@@ -2859,12 +2858,26 @@ package body Make is
for J in 1 .. Saved_Gcc_Switches.Last loop for J in 1 .. Saved_Gcc_Switches.Last loop
The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J); The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
Test_If_Relative_Path (The_Saved_Gcc_Switches (J));
end loop; end loop;
-- We never use gnat.adc when a project file is used -- We never use gnat.adc when a project file is used
The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) := The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) :=
No_gnat_adc; No_gnat_adc;
for J in 1 .. Gcc_Switches.Last loop
Test_If_Relative_Path (Gcc_Switches.Table (J));
end loop;
for J in 1 .. Binder_Switches.Last loop
Test_If_Relative_Path (Binder_Switches.Table (J));
end loop;
for J in 1 .. Linker_Switches.Last loop
Test_If_Relative_Path (Linker_Switches.Table (J));
end loop;
end if; end if;
-- If there was a --GCC, --GNATBIND or --GNATLINK switch on -- If there was a --GCC, --GNATBIND or --GNATLINK switch on
...@@ -2939,7 +2952,9 @@ package body Make is ...@@ -2939,7 +2952,9 @@ package body Make is
-- Look inside the linker switches to see if the name -- Look inside the linker switches to see if the name
-- of the final executable program was specified. -- of the final executable program was specified.
for J in Linker_Switches.First .. Linker_Switches.Last loop for
J in reverse Linker_Switches.First .. Linker_Switches.Last
loop
if Linker_Switches.Table (J).all = Output_Flag.all then if Linker_Switches.Table (J).all = Output_Flag.all then
pragma Assert (J < Linker_Switches.Last); pragma Assert (J < Linker_Switches.Last);
...@@ -2998,6 +3013,7 @@ package body Make is ...@@ -2998,6 +3013,7 @@ package body Make is
(Projects.Table (Projects.Table
(Main_Project). (Main_Project).
Naming.Current_Impl_Suffix); Naming.Current_Impl_Suffix);
Spec_Append : constant String := Spec_Append : constant String :=
Get_Name_String Get_Name_String
(Projects.Table (Projects.Table
...@@ -3013,12 +3029,10 @@ package body Make is ...@@ -3013,12 +3029,10 @@ package body Make is
Body_Append Body_Append
then then
-- We have found the body termination. We remove it -- We have found the body termination. We remove it
-- add the executable termination (if any) and set -- add the executable termination, if any.
-- Non_Std_Executable.
Name_Len := Name_Len - Body_Append'Length; Name_Len := Name_Len - Body_Append'Length;
Executable := Executable_Name (Name_Find); Executable := Executable_Name (Name_Find);
Non_Std_Executable := True;
elsif Name_Len > Spec_Append'Length elsif Name_Len > Spec_Append'Length
and then and then
...@@ -3027,21 +3041,57 @@ package body Make is ...@@ -3027,21 +3041,57 @@ package body Make is
Spec_Append Spec_Append
then then
-- We have found the spec termination. We remove -- We have found the spec termination. We remove
-- it, add the executable termination (if any), -- it, add the executable termination, if any.
-- and set Non_Std_Executable.
Name_Len := Name_Len - Spec_Append'Length; Name_Len := Name_Len - Spec_Append'Length;
Executable := Executable_Name (Name_Find); Executable := Executable_Name (Name_Find);
Non_Std_Executable := True;
else else
Executable := Executable :=
Executable_Name (Strip_Suffix (Main_Source_File)); Executable_Name (Strip_Suffix (Main_Source_File));
end if; end if;
end; end;
end if; end if;
end if; end if;
if Main_Project /= No_Project then
declare
Exec_File_Name : constant String :=
Get_Name_String (Executable);
begin
if not Is_Absolute_Path (Exec_File_Name) then
for Index in Exec_File_Name'Range loop
if Exec_File_Name (Index) = Directory_Separator then
Fail ("relative executable (""" &
Exec_File_Name &
""") with directory part not allowed " &
"when using project files");
end if;
end loop;
Get_Name_String (Projects.Table
(Main_Project).Exec_Directory);
if
Name_Buffer (Name_Len) /= Directory_Separator
then
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Directory_Separator;
end if;
Name_Buffer (Name_Len + 1 ..
Name_Len + Exec_File_Name'Length) :=
Exec_File_Name;
Name_Len := Name_Len + Exec_File_Name'Length;
Executable := Name_Find;
Non_Std_Executable := True;
end if;
end;
end if;
-- Now we invoke Compile_Sources for the current main -- Now we invoke Compile_Sources for the current main
Compile_Sources Compile_Sources
...@@ -3212,7 +3262,6 @@ package body Make is ...@@ -3212,7 +3262,6 @@ package body Make is
end if; end if;
end if; end if;
end Recursive_Compilation_Step; end Recursive_Compilation_Step;
end if; end if;
-- If we are here, it means that we need to rebuilt the current -- If we are here, it means that we need to rebuilt the current
...@@ -3243,7 +3292,10 @@ package body Make is ...@@ -3243,7 +3292,10 @@ package body Make is
Main_ALI_File := Full_Lib_File_Name (Main_ALI_File); Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
end if; end if;
pragma Assert (Main_ALI_File /= No_File); if Main_ALI_File = No_File then
Fail ("could not find the main ALI file");
end if;
end Main_ALI_In_Place_Mode_Step; end Main_ALI_In_Place_Mode_Step;
if Do_Bind_Step then if Do_Bind_Step then
...@@ -3268,7 +3320,6 @@ package body Make is ...@@ -3268,7 +3320,6 @@ package body Make is
Bind (Main_ALI_File, Args); Bind (Main_ALI_File, Args);
end Bind_Step; end Bind_Step;
end if; end if;
if Do_Link_Step then if Do_Link_Step then
...@@ -3278,7 +3329,6 @@ package body Make is ...@@ -3278,7 +3329,6 @@ package body Make is
Linker_Switches_Last : constant Integer := Linker_Switches.Last; Linker_Switches_Last : constant Integer := Linker_Switches.Last;
begin begin
if Main_Project /= No_Project then if Main_Project /= No_Project then
if MLib.Tgt.Libraries_Are_Supported then if MLib.Tgt.Libraries_Are_Supported then
...@@ -3310,9 +3360,7 @@ package body Make is ...@@ -3310,9 +3360,7 @@ package body Make is
Linker_Switches.Table (Linker_Switches.Last) := Linker_Switches.Table (Linker_Switches.Last) :=
Option; Option;
end if; end if;
end; end;
end if; end if;
-- Put the object directories in ADA_OBJECTS_PATH -- Put the object directories in ADA_OBJECTS_PATH
...@@ -3322,34 +3370,50 @@ package body Make is ...@@ -3322,34 +3370,50 @@ package body Make is
declare declare
Args : Argument_List Args : Argument_List
(Linker_Switches.First .. Linker_Switches.Last + 2); (Linker_Switches.First .. Linker_Switches.Last + 2);
Last_Arg : Integer := Linker_Switches.First - 1;
Skip : Boolean := False;
begin begin
-- Get all the linker switches -- Get all the linker switches
for J in Linker_Switches.First .. Linker_Switches.Last loop for J in Linker_Switches.First .. Linker_Switches.Last loop
Args (J) := Linker_Switches.Table (J); if Skip then
Skip := False;
elsif Non_Std_Executable
and then Linker_Switches.Table (J).all = "-o"
then
Skip := True;
else
Last_Arg := Last_Arg + 1;
Args (Last_Arg) := Linker_Switches.Table (J);
end if;
end loop; end loop;
-- And invoke the linker -- And invoke the linker
if Non_Std_Executable then if Non_Std_Executable then
Args (Linker_Switches.Last + 1) := new String'("-o"); Last_Arg := Last_Arg + 1;
Args (Linker_Switches.Last + 2) := Args (Last_Arg) := new String'("-o");
Last_Arg := Last_Arg + 1;
Args (Last_Arg) :=
new String'(Get_Name_String (Executable)); new String'(Get_Name_String (Executable));
Link (Main_ALI_File, Args); Link (Main_ALI_File, Args (Args'First .. Last_Arg));
else else
Link Link
(Main_ALI_File, (Main_ALI_File,
Args (Linker_Switches.First .. Linker_Switches.Last)); Args (Args'First .. Last_Arg));
end if; end if;
end; end;
Linker_Switches.Set_Last (Linker_Switches_Last); Linker_Switches.Set_Last (Linker_Switches_Last);
end Link_Step; end Link_Step;
end if; end if;
-- We go to here when we skip the bind and link steps. -- We go to here when we skip the bind and link steps.
...@@ -3592,7 +3656,6 @@ package body Make is ...@@ -3592,7 +3656,6 @@ package body Make is
when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC => when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
Osint.Fail (Exception_Message (Err)); Osint.Fail (Exception_Message (Err));
end; end;
end Initialize; end Initialize;
----------------------------------- -----------------------------------
...@@ -4515,6 +4578,150 @@ package body Make is ...@@ -4515,6 +4578,150 @@ package body Make is
end if; end if;
end Set_Library_For; end Set_Library_For;
-----------------
-- Switches_Of --
-----------------
function Switches_Of
(Source_File : Name_Id;
Source_File_Name : String;
Naming : Naming_Data;
In_Package : Package_Id;
Allow_ALI : Boolean)
return Variable_Value
is
Switches : Variable_Value;
Defaults : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
Packages.Table (In_Package).Decl.Arrays);
Switches_Array : constant Array_Element_Id :=
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays =>
Packages.Table (In_Package).Decl.Arrays);
begin
Switches :=
Prj.Util.Value_Of
(Index => Source_File,
In_Array => Switches_Array);
if Switches = Nil_Variable_Value then
declare
Name : String (1 .. Source_File_Name'Length + 3);
Last : Positive := Source_File_Name'Length;
Spec_Suffix : constant String :=
Get_Name_String (Naming.Current_Spec_Suffix);
Impl_Suffix : constant String :=
Get_Name_String (Naming.Current_Impl_Suffix);
Truncated : Boolean := False;
begin
Name (1 .. Last) := Source_File_Name;
if Last > Impl_Suffix'Length
and then Name (Last - Impl_Suffix'Length + 1 .. Last) =
Impl_Suffix
then
Truncated := True;
Last := Last - Impl_Suffix'Length;
end if;
if not Truncated
and then Last > Spec_Suffix'Length
and then Name (Last - Spec_Suffix'Length + 1 .. Last) =
Spec_Suffix
then
Truncated := True;
Last := Last - Spec_Suffix'Length;
end if;
if Truncated then
Name_Len := Last;
Name_Buffer (1 .. Name_Len) := Name (1 .. Last);
Switches :=
Prj.Util.Value_Of
(Index => Name_Find,
In_Array => Switches_Array);
if Switches = Nil_Variable_Value then
Last := Source_File_Name'Length;
while Name (Last) /= '.' loop
Last := Last - 1;
end loop;
Name (Last + 1 .. Last + 3) := "ali";
Name_Len := Last + 3;
Name_Buffer (1 .. Name_Len) := Name (1 .. Name_Len);
Switches :=
Prj.Util.Value_Of
(Index => Name_Find,
In_Array => Switches_Array);
end if;
end if;
end;
end if;
if Switches = Nil_Variable_Value then
Switches := Prj.Util.Value_Of
(Index => Name_Ada, In_Array => Defaults);
end if;
return Switches;
end Switches_Of;
---------------------------
-- Test_If_Relative_Path --
---------------------------
procedure Test_If_Relative_Path (Switch : String_Access) is
begin
if Switch /= null then
declare
Sw : String (1 .. Switch'Length);
Start : Positive;
begin
Sw := Switch.all;
if Sw (1) = '-' then
if Sw'Length >= 3
and then (Sw (2) = 'A'
or else Sw (2) = 'I'
or else Sw (2) = 'L')
then
Start := 3;
if Sw = "-I-" then
return;
end if;
elsif Sw'Length >= 4
and then (Sw (2 .. 3) = "aL"
or else Sw (2 .. 3) = "aO"
or else Sw (2 .. 3) = "aI")
then
Start := 4;
else
return;
end if;
if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then
Fail ("relative search path switches (""" &
Sw & """) are not allowed when using project files");
end if;
end if;
end;
end if;
end Test_If_Relative_Path;
------------ ------------
-- Unmark -- -- Unmark --
------------ ------------
......
gcc/ada/prj-attr.adb
...@@ -54,6 +54,7 @@ package body Prj.Attr is ...@@ -54,6 +54,7 @@ package body Prj.Attr is
-- project attributes -- project attributes
"SVobject_dir#" & "SVobject_dir#" &
"SVexec_dir#" &
"LVsource_dirs#" & "LVsource_dirs#" &
"LVsource_files#" & "LVsource_files#" &
"SVsource_list_file#" & "SVsource_list_file#" &
......
gcc/ada/prj-nmsc.adb
...@@ -628,14 +628,18 @@ package body Prj.Nmsc is ...@@ -628,14 +628,18 @@ package body Prj.Nmsc is
-- Check Specification_Suffix -- Check Specification_Suffix
declare declare
Ada_Spec_Suffix : constant Name_Id := Ada_Spec_Suffix : constant Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Index => Name_Ada, (Index => Name_Ada,
In_Array => Data.Naming.Specification_Suffix); In_Array => Data.Naming.Specification_Suffix);
begin begin
if Ada_Spec_Suffix /= No_Name then if Ada_Spec_Suffix.Kind = Single
Data.Naming.Current_Spec_Suffix := Ada_Spec_Suffix; and then String_Length (Ada_Spec_Suffix.Value) /= 0
then
String_To_Name_Buffer (Ada_Spec_Suffix.Value);
Data.Naming.Current_Spec_Suffix := Name_Find;
Data.Naming.Spec_Suffix_Loc := Ada_Spec_Suffix.Location;
else else
Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix; Data.Naming.Current_Spec_Suffix := Default_Ada_Spec_Suffix;
...@@ -652,14 +656,18 @@ package body Prj.Nmsc is ...@@ -652,14 +656,18 @@ package body Prj.Nmsc is
-- Check Implementation_Suffix -- Check Implementation_Suffix
declare declare
Ada_Impl_Suffix : constant Name_Id := Ada_Impl_Suffix : constant Variable_Value :=
Prj.Util.Value_Of Prj.Util.Value_Of
(Index => Name_Ada, (Index => Name_Ada,
In_Array => Data.Naming.Implementation_Suffix); In_Array => Data.Naming.Implementation_Suffix);
begin begin
if Ada_Impl_Suffix /= No_Name then if Ada_Impl_Suffix.Kind = Single
Data.Naming.Current_Impl_Suffix := Ada_Impl_Suffix; and then String_Length (Ada_Impl_Suffix.Value) /= 0
then
String_To_Name_Buffer (Ada_Impl_Suffix.Value);
Data.Naming.Current_Impl_Suffix := Name_Find;
Data.Naming.Impl_Suffix_Loc := Ada_Impl_Suffix.Location;
else else
Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix; Data.Naming.Current_Impl_Suffix := Default_Ada_Impl_Suffix;
...@@ -920,9 +928,9 @@ package body Prj.Nmsc is ...@@ -920,9 +928,9 @@ package body Prj.Nmsc is
end if; end if;
end Check_Ada_Name; end Check_Ada_Name;
------------------------- -----------------------------
-- Check_Naming_Scheme -- -- Check_Ada_Naming_Scheme --
------------------------- -----------------------------
procedure Check_Ada_Naming_Scheme (Naming : Naming_Data) is procedure Check_Ada_Naming_Scheme (Naming : Naming_Data) is
begin begin
...@@ -982,24 +990,24 @@ package body Prj.Nmsc is ...@@ -982,24 +990,24 @@ package body Prj.Nmsc is
-- - start with an '_' followed by an alphanumeric -- - start with an '_' followed by an alphanumeric
if Is_Illegal_Append (Specification_Suffix) then if Is_Illegal_Append (Specification_Suffix) then
Error_Msg_Name_1 := Naming.Current_Spec_Suffix;
Error_Msg Error_Msg
('"' & Specification_Suffix & ("{ is illegal for Specification_Suffix",
""" is illegal for Specification_Suffix.",
Naming.Spec_Suffix_Loc); Naming.Spec_Suffix_Loc);
end if; end if;
if Is_Illegal_Append (Implementation_Suffix) then if Is_Illegal_Append (Implementation_Suffix) then
Error_Msg_Name_1 := Naming.Current_Impl_Suffix;
Error_Msg Error_Msg
('"' & Implementation_Suffix & ("% is illegal for Implementation_Suffix",
""" is illegal for Implementation_Suffix.",
Naming.Impl_Suffix_Loc); Naming.Impl_Suffix_Loc);
end if; end if;
if Implementation_Suffix /= Separate_Suffix then if Implementation_Suffix /= Separate_Suffix then
if Is_Illegal_Append (Separate_Suffix) then if Is_Illegal_Append (Separate_Suffix) then
Error_Msg_Name_1 := Naming.Separate_Suffix;
Error_Msg Error_Msg
('"' & Separate_Suffix & ("{ is illegal for Separate_Append",
""" is illegal for Separate_Append.",
Naming.Sep_Suffix_Loc); Naming.Sep_Suffix_Loc);
end if; end if;
end if; end if;
...@@ -1039,6 +1047,7 @@ package body Prj.Nmsc is ...@@ -1039,6 +1047,7 @@ package body Prj.Nmsc is
end if; end if;
end; end;
end if; end if;
end Check_Ada_Naming_Scheme; end Check_Ada_Naming_Scheme;
--------------- ---------------
...@@ -1430,6 +1439,7 @@ package body Prj.Nmsc is ...@@ -1430,6 +1439,7 @@ package body Prj.Nmsc is
begin begin
return This'Length = 0 return This'Length = 0
or else Is_Alphanumeric (This (This'First)) or else Is_Alphanumeric (This (This'First))
or else Index (This, ".") = 0
or else (This'Length >= 2 or else (This'Length >= 2
and then This (This'First) = '_' and then This (This'First) = '_'
and then Is_Alphanumeric (This (This'First + 1))); and then Is_Alphanumeric (This (This'First + 1)));
...@@ -1701,7 +1711,7 @@ package body Prj.Nmsc is ...@@ -1701,7 +1711,7 @@ package body Prj.Nmsc is
Write_Line ("Starting to look for directories"); Write_Line ("Starting to look for directories");
end if; end if;
-- Let's check the object directory -- Check the object directory
declare declare
Object_Dir : Variable_Value := Object_Dir : Variable_Value :=
...@@ -1757,6 +1767,62 @@ package body Prj.Nmsc is ...@@ -1757,6 +1767,62 @@ package body Prj.Nmsc is
end if; end if;
end if; end if;
-- Check the exec directory
declare
Exec_Dir : Variable_Value :=
Util.Value_Of (Name_Exec_Dir, Data.Decl.Attributes);
begin
pragma Assert (Exec_Dir.Kind = Single,
"Exec_Dir is not a single string");
-- We set the object directory to its default
Data.Exec_Directory := Data.Object_Directory;
if not String_Equal (Exec_Dir.Value, Empty_String) then
String_To_Name_Buffer (Exec_Dir.Value);
if Name_Len = 0 then
Error_Msg ("Exec_Dir cannot be empty",
Exec_Dir.Location);
else
-- We check that the specified object directory
-- does exist.
Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
declare
Dir_Id : constant Name_Id := Name_Find;
begin
Data.Exec_Directory :=
Locate_Directory (Dir_Id, Data.Directory);
if Data.Exec_Directory = No_Name then
Error_Msg_Name_1 := Dir_Id;
Error_Msg
("the exec directory { cannot be found",
Data.Location);
end if;
end;
end if;
end if;
end;
if Current_Verbosity = High then
if Data.Exec_Directory = No_Name then
Write_Line ("No exec directory");
else
Write_Str ("Exec directory: """);
Write_Str (Get_Name_String (Data.Exec_Directory));
Write_Line ("""");
end if;
end if;
-- Look for the source directories -- Look for the source directories
declare declare
......
gcc/ada/prj.adb
...@@ -89,6 +89,7 @@ package body Prj is ...@@ -89,6 +89,7 @@ package body Prj is
Sources => Nil_String, Sources => Nil_String,
Source_Dirs => Nil_String, Source_Dirs => Nil_String,
Object_Directory => No_Name, Object_Directory => No_Name,
Exec_Directory => No_Name,
Modifies => No_Project, Modifies => No_Project,
Modified_By => No_Project, Modified_By => No_Project,
Naming => Std_Naming_Data, Naming => Std_Naming_Data,
......
gcc/ada/prj.ads
...@@ -40,11 +40,11 @@ with Types; use Types; ...@@ -40,11 +40,11 @@ with Types; use Types;
package Prj is package Prj is
Default_Ada_Spec_Suffix : Name_Id := No_Name; Default_Ada_Spec_Suffix : Name_Id;
-- The Name_Id for the standard GNAT suffix for Ada spec source file -- The Name_Id for the standard GNAT suffix for Ada spec source file
-- name ".ads". Initialized by Prj.Initialize. -- name ".ads". Initialized by Prj.Initialize.
Default_Ada_Impl_Suffix : Name_Id := No_Name; Default_Ada_Impl_Suffix : Name_Id;
-- The Name_Id for the standard GNAT suffix for Ada body source file -- The Name_Id for the standard GNAT suffix for Ada body source file
-- name ".adb". Initialized by Prj.Initialize. -- name ".adb". Initialized by Prj.Initialize.
...@@ -366,6 +366,11 @@ package Prj is ...@@ -366,6 +366,11 @@ package Prj is
-- The object directory of this project file. -- The object directory of this project file.
-- Set by Prj.Nmsc.Check_Naming_Scheme. -- Set by Prj.Nmsc.Check_Naming_Scheme.
Exec_Directory : Name_Id := No_Name;
-- The exec directory of this project file.
-- Default is equal to Object_Directory.
-- Set by Prj.Nmsc.Check_Naming_Scheme.
Modifies : Project_Id := No_Project; Modifies : Project_Id := No_Project;
-- The reference of the project file, if any, that this -- The reference of the project file, if any, that this
-- project file modifies. -- project file modifies.
......
gcc/ada/snames.adb
...@@ -566,36 +566,37 @@ package body Snames is ...@@ -566,36 +566,37 @@ package body Snames is
"requeue#" & "requeue#" &
"tagged#" & "tagged#" &
"raise_exception#" & "raise_exception#" &
"project#" & "binder#" &
"builder#" &
"compiler#" &
"cross_reference#" &
"default_switches#" &
"exec_dir#" &
"extends#" & "extends#" &
"naming#" & "finder#" &
"object_dir#" & "gnatls#" &
"source_dirs#" & "gnatstub#" &
"specification#" &
"implementation#" & "implementation#" &
"specification_exceptions#" &
"implementation_exceptions#" & "implementation_exceptions#" &
"specification_suffix#" &
"implementation_suffix#" & "implementation_suffix#" &
"separate_suffix#" & "languages#" &
"source_files#" &
"source_list_file#" &
"default_switches#" &
"switches#" &
"library_dir#" & "library_dir#" &
"library_name#" & "library_elaboration#" &
"library_kind#" & "library_kind#" &
"library_name#" &
"library_version#" & "library_version#" &
"library_elaboration#" &
"languages#" &
"builder#" &
"gnatls#" &
"cross_reference#" &
"finder#" &
"binder#" &
"linker#" & "linker#" &
"compiler#" & "naming#" &
"gnatstub#" & "object_dir#" &
"project#" &
"separate_suffix#" &
"source_dirs#" &
"source_files#" &
"source_list_file#" &
"specification#" &
"specification_exceptions#" &
"specification_suffix#" &
"switches#" &
"#"; "#";
--------------------- ---------------------
......
gcc/ada/snames.ads
...@@ -861,44 +861,40 @@ package Snames is ...@@ -861,44 +861,40 @@ package Snames is
-- Additional reserved words in GNAT Project Files -- Additional reserved words in GNAT Project Files
-- Note that Name_External is already previously declared -- Note that Name_External is already previously declared
Name_Project : constant Name_Id := N + 523; Name_Binder : constant Name_Id := N + 523;
Name_Extends : constant Name_Id := N + 524; Name_Builder : constant Name_Id := N + 524;
Name_Compiler : constant Name_Id := N + 525;
-- Names used in GNAT Project Files Name_Cross_Reference : constant Name_Id := N + 526;
Name_Default_Switches : constant Name_Id := N + 527;
Name_Naming : constant Name_Id := N + 525; Name_Exec_Dir : constant Name_Id := N + 528;
Name_Object_Dir : constant Name_Id := N + 526; Name_Extends : constant Name_Id := N + 529;
Name_Source_Dirs : constant Name_Id := N + 527; Name_Finder : constant Name_Id := N + 530;
Name_Specification : constant Name_Id := N + 528; Name_Gnatls : constant Name_Id := N + 531;
Name_Implementation : constant Name_Id := N + 529; Name_Gnatstub : constant Name_Id := N + 532;
Name_Specification_Exceptions : constant Name_Id := N + 530; Name_Implementation : constant Name_Id := N + 533;
Name_Implementation_Exceptions : constant Name_Id := N + 531; Name_Implementation_Exceptions : constant Name_Id := N + 534;
Name_Specification_Suffix : constant Name_Id := N + 532; Name_Implementation_Suffix : constant Name_Id := N + 535;
Name_Implementation_Suffix : constant Name_Id := N + 533; Name_Languages : constant Name_Id := N + 536;
Name_Separate_Suffix : constant Name_Id := N + 534; Name_Library_Dir : constant Name_Id := N + 537;
Name_Source_Files : constant Name_Id := N + 535; Name_Library_Elaboration : constant Name_Id := N + 538;
Name_Source_List_File : constant Name_Id := N + 536; Name_Library_Kind : constant Name_Id := N + 539;
Name_Default_Switches : constant Name_Id := N + 537;
Name_Switches : constant Name_Id := N + 538;
Name_Library_Dir : constant Name_Id := N + 539;
Name_Library_Name : constant Name_Id := N + 540; Name_Library_Name : constant Name_Id := N + 540;
Name_Library_Kind : constant Name_Id := N + 541; Name_Library_Version : constant Name_Id := N + 541;
Name_Library_Version : constant Name_Id := N + 542; Name_Linker : constant Name_Id := N + 542;
Name_Library_Elaboration : constant Name_Id := N + 543; Name_Naming : constant Name_Id := N + 543;
Name_Languages : constant Name_Id := N + 544; Name_Object_Dir : constant Name_Id := N + 544;
Name_Project : constant Name_Id := N + 545;
Name_Builder : constant Name_Id := N + 545; Name_Separate_Suffix : constant Name_Id := N + 546;
Name_Gnatls : constant Name_Id := N + 546; Name_Source_Dirs : constant Name_Id := N + 547;
Name_Cross_Reference : constant Name_Id := N + 547; Name_Source_Files : constant Name_Id := N + 548;
Name_Finder : constant Name_Id := N + 548; Name_Source_List_File : constant Name_Id := N + 549;
Name_Binder : constant Name_Id := N + 549; Name_Specification : constant Name_Id := N + 550;
Name_Linker : constant Name_Id := N + 550; Name_Specification_Exceptions : constant Name_Id := N + 551;
Name_Compiler : constant Name_Id := N + 551; Name_Specification_Suffix : constant Name_Id := N + 552;
Name_Gnatstub : constant Name_Id := N + 552; Name_Switches : constant Name_Id := N + 553;
-- Mark last defined name for consistency check in Snames body -- Mark last defined name for consistency check in Snames body
Last_Predefined_Name : constant Name_Id := N + 552; Last_Predefined_Name : constant Name_Id := N + 553;
subtype Any_Operator_Name is Name_Id range subtype Any_Operator_Name is Name_Id range
First_Operator_Name .. Last_Operator_Name; First_Operator_Name .. Last_Operator_Name;
......
gcc/ada/trans.c
...@@ -3993,6 +3993,15 @@ process_freeze_entity (gnat_node) ...@@ -3993,6 +3993,15 @@ process_freeze_entity (gnat_node)
&& Present (Equivalent_Type (gnat_entity)))) && Present (Equivalent_Type (gnat_entity))))
return; return;
/* Don't do anything for subprograms that may have been elaborated before
their freeze nodes. This can happen, for example because of an inner call
in an instance body. */
if (gnu_old != 0
&& TREE_CODE (gnu_old) == FUNCTION_DECL
&& (Ekind (gnat_entity) == E_Function
|| Ekind (gnat_entity) == E_Procedure))
return;
/* If we have a non-dummy type old tree, we have nothing to do. Unless /* If we have a non-dummy type old tree, we have nothing to do. Unless
this is the public view of a private type whose full view was not this is the public view of a private type whose full view was not
delayed, this node was never delayed as it should have been. delayed, this node was never delayed as it should have been.
......
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