procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2013-01-04  Pascal Obry  <obry@adacore.com>

	* prj-nmsc.adb: Minor reformatting.

2013-01-04  Vincent Celier  <celier@adacore.com>

	* makeutl.ads (Root_Environment): New variable, moved rom
	gprbuild (Load_Standard_Base): New Boolean variable, moved
	from gprbuild.
	* prj-conf.adb (Check_Builder_Switches): New procedure to check
	for switch --RTS in package Builder. If a runtime specified
	by --RTS is a relative path name, but not a base name, then
	find the path on the Project Search Path.
	(Do_Autoconf): Call Check_Builder_Switches.
	(Locate_Runtime): New procedure, moved from gprbuild, to get the
	absolute paths of runtimes when they are not specified as a base name.
	* prj-conf.ads (Locate_Runtime): New procedure, moved from gprbuild.

From-SVN: r194893
This commit is contained in:
Arnaud Charlet 2013-01-04 10:24:06 +01:00
parent 33bd17e742
commit dc8b370ac0
5 changed files with 231 additions and 137 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
gcc/ada/ChangeLog
View file

@ -1,3 +1,21 @@
2013-01-04 Pascal Obry <obry@adacore.com>
* prj-nmsc.adb: Minor reformatting.
2013-01-04 Vincent Celier <celier@adacore.com>
* makeutl.ads (Root_Environment): New variable, moved rom
gprbuild (Load_Standard_Base): New Boolean variable, moved
from gprbuild.
* prj-conf.adb (Check_Builder_Switches): New procedure to check
for switch --RTS in package Builder. If a runtime specified
by --RTS is a relative path name, but not a base name, then
find the path on the Project Search Path.
(Do_Autoconf): Call Check_Builder_Switches.
(Locate_Runtime): New procedure, moved from gprbuild, to get the
absolute paths of runtimes when they are not specified as a base name.
* prj-conf.ads (Locate_Runtime): New procedure, moved from gprbuild.
2013-01-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Build_Private_Derived_Type): Set

11
gcc/ada/makeutl.ads
View file

@ -44,6 +44,14 @@ package Makeutl is
type Fail_Proc is access procedure (S : String);
-- Pointer to procedure which outputs a failure message
Root_Environment : Prj.Tree.Environment;
-- The environment coming from environment variables and command line
-- switches. When we do not have an aggregate project, this is used for
-- parsing the project tree. When we have an aggregate project, this is
-- used to parse the aggregate project; the latter then generates another
-- environment (with additional external values and project path) to parse
-- the aggregated projects.
Default_Config_Name : constant String := "default.cgpr";
-- Name of the configuration file used by gprbuild and generated by
-- gprconfig by default.
@ -71,6 +79,9 @@ package Makeutl is
Create_Map_File_Switch : constant String := "--create-map-file";
-- Switch to create a map file when an executable is linked
Load_Standard_Base : Boolean := True;
-- False when gprbuild is called with --db-
package Directories is new Table.Table
(Table_Component_Type => Path_Name_Type,
Table_Index_Type => Integer,

297
gcc/ada/prj-conf.adb
View file

@ -628,6 +628,9 @@ package body Prj.Conf is
-- Generate a new config file through gprconfig. In case of error, this
-- raises the Invalid_Config exception with an appropriate message
procedure Check_Builder_Switches;
-- Check for switch --RTS in package Builder
function Get_Config_Switches return Argument_List_Access;
-- Return the --config switches to use for gprconfig
@ -636,6 +639,119 @@ package body Prj.Conf is
-- explicitly specified it. We haven't checked the file system, nor do
-- we need to at this stage.
----------------------------
-- Check_Builder_Switches --
----------------------------
procedure Check_Builder_Switches is
Get_RTS_Switches : constant Boolean :=
RTS_Languages.Get_First = No_Name;
-- If no switch --RTS have been specified on the command line, look
-- for --RTS switches in the Builder switches.
Builder : constant Package_Id :=
Value_Of (Name_Builder, Project.Decl.Packages, Shared);
Switch_Array_Id : Array_Element_Id;
-- The Switches to be checked
procedure Check_Switches;
-- Check the switches in Switch_Array_Id
--------------------
-- Check_Switches --
--------------------
procedure Check_Switches is
Switch_Array : Array_Element;
Switch_List : String_List_Id := Nil_String;
Switch : String_Element;
Lang : Name_Id;
Lang_Last : Positive;
begin
while Switch_Array_Id /= No_Array_Element loop
Switch_Array :=
Shared.Array_Elements.Table (Switch_Array_Id);
Switch_List := Switch_Array.Value.Values;
List_Loop : while Switch_List /= Nil_String loop
Switch := Shared.String_Elements.Table (Switch_List);
if Switch.Value /= No_Name then
Get_Name_String (Switch.Value);
if Get_RTS_Switches
and then Name_Len >= 7
and then Name_Buffer (1 .. 5) = "--RTS"
then
if Name_Buffer (6) = '=' then
if not Runtime_Name_Set_For (Name_Ada) then
Set_Runtime_For
(Name_Ada,
Name_Buffer (7 .. Name_Len));
Locate_Runtime (Name_Ada, Project_Tree);
end if;
elsif Name_Len > 7
and then Name_Buffer (6) = ':'
and then Name_Buffer (7) /= '='
then
Lang_Last := 7;
while Lang_Last < Name_Len
and then Name_Buffer (Lang_Last + 1) /= '='
loop
Lang_Last := Lang_Last + 1;
end loop;
if Name_Buffer (Lang_Last + 1) = '=' then
declare
RTS : constant String :=
Name_Buffer (Lang_Last + 2 .. Name_Len);
begin
Name_Buffer (1 .. Lang_Last - 6) :=
Name_Buffer (7 .. Lang_Last);
Name_Len := Lang_Last - 6;
To_Lower (Name_Buffer (1 .. Name_Len));
Lang := Name_Find;
if not Runtime_Name_Set_For (Lang) then
Set_Runtime_For (Lang, RTS);
Locate_Runtime (Lang, Project_Tree);
end if;
end;
end if;
end if;
end if;
end if;
Switch_List := Switch.Next;
end loop List_Loop;
Switch_Array_Id := Switch_Array.Next;
end loop;
end Check_Switches;
-- Start of processing for Check_Builder_Switches
begin
if Builder /= No_Package then
Switch_Array_Id :=
Value_Of
(Name => Name_Switches,
In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
Shared => Shared);
Check_Switches;
Switch_Array_Id :=
Value_Of
(Name => Name_Default_Switches,
In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
Shared => Shared);
Check_Switches;
end if;
end Check_Builder_Switches;
-----------------------
-- Default_File_Name --
-----------------------
@ -647,10 +763,11 @@ package body Prj.Conf is
begin
if Target_Name /= "" then
if Ada_RTS /= "" then
return Target_Name & '-' & Ada_RTS
& Config_Project_File_Extension;
return
Target_Name & '-' & Ada_RTS & Config_Project_File_Extension;
else
return Target_Name & Config_Project_File_Extension;
return
Target_Name & Config_Project_File_Extension;
end if;
elsif Ada_RTS /= "" then
@ -1012,117 +1129,6 @@ package body Prj.Conf is
end case;
end if;
-- If no switch --RTS have been specified on the command line,
-- look for --RTS switches in the Builder switches.
if RTS_Languages.Get_First = No_Name then
declare
Builder : constant Package_Id :=
Value_Of
(Name_Builder, Project.Decl.Packages, Shared);
Switch_Array_Id : Array_Element_Id;
procedure Check_RTS_Switches;
-- Take into account eventual switches --RTS in
-- Switch_Array_Id.
------------------------
-- Check_RTS_SWitches --
------------------------
procedure Check_RTS_Switches is
Switch_Array : Array_Element;
Switch_List : String_List_Id := Nil_String;
Switch : String_Element;
Lang : Name_Id;
Lang_Last : Positive;
begin
while Switch_Array_Id /= No_Array_Element loop
Switch_Array :=
Shared.Array_Elements.Table (Switch_Array_Id);
Switch_List := Switch_Array.Value.Values;
while Switch_List /= Nil_String loop
Switch :=
Shared.String_Elements.Table (Switch_List);
if Switch.Value /= No_Name then
Get_Name_String (Switch.Value);
if Name_Len >= 7 and then
Name_Buffer (1 .. 5) = "--RTS"
then
if Name_Buffer (6) = '=' then
if not Runtime_Name_Set_For (Name_Ada) then
Set_Runtime_For
(Name_Ada,
Name_Buffer (7 .. Name_Len));
end if;
elsif Name_Len > 7 and then
Name_Buffer (6) = ':' and then
Name_Buffer (7) /= '='
then
Lang_Last := 7;
while Lang_Last < Name_Len and then
Name_Buffer (Lang_Last + 1) /= '='
loop
Lang_Last := Lang_Last + 1;
end loop;
if Name_Buffer (Lang_Last + 1) = '=' then
declare
RTS : constant String :=
Name_Buffer (Lang_Last + 2 ..
Name_Len);
begin
Name_Buffer (1 .. Lang_Last - 6) :=
Name_Buffer (7 .. Lang_Last);
Name_Len := Lang_Last - 6;
To_Lower
(Name_Buffer (1 .. Name_Len));
Lang := Name_Find;
if not
Runtime_Name_Set_For (Lang)
then
Set_Runtime_For (Lang, RTS);
end if;
end;
end if;
end if;
end if;
end if;
Switch_List := Switch.Next;
end loop;
Switch_Array_Id := Switch_Array.Next;
end loop;
end Check_RTS_Switches;
begin
if Builder /= No_Package then
Switch_Array_Id :=
Value_Of
(Name => Name_Switches,
In_Arrays =>
Shared.Packages.Table (Builder).Decl.Arrays,
Shared => Shared);
Check_RTS_Switches;
Switch_Array_Id :=
Value_Of
(Name => Name_Default_Switches,
In_Arrays =>
Shared.Packages.Table (Builder).Decl.Arrays,
Shared => Shared);
Check_RTS_Switches;
end if;
end;
end if;
-- Get the config switches. This should be done only now, as some
-- runtimes may have been found if the Builder switches.
@ -1135,7 +1141,7 @@ package body Prj.Conf is
-- If no config file was specified, set the auto.cgpr one
if Config_File_Name = "" then
if Config_File_Name'Length = 0 then
if Obj_Dir_Exists then
Args (3) := new String'(Obj_Dir & Auto_Cgpr);
@ -1253,7 +1259,7 @@ package body Prj.Conf is
-- Display no message if we are creating auto.cgpr, unless in
-- verbose mode
if Config_File_Name /= ""
if Config_File_Name'Length > 0
or else Verbose_Mode
then
Write_Str ("creating ");
@ -1290,7 +1296,9 @@ package body Prj.Conf is
Free (Config_File_Path);
Config := No_Project;
if Config_File_Name /= "" then
Check_Builder_Switches;
if Config_File_Name'Length > 0 then
Config_File_Path := Locate_Config_File (Config_File_Name);
else
Config_File_Path := Locate_Config_File (Default_File_Name);
@ -1298,7 +1306,7 @@ package body Prj.Conf is
if Config_File_Path = null then
if (not Allow_Automatic_Generation)
and then Config_File_Name /= ""
and then Config_File_Name'Length > 0
then
Raise_Invalid_Config
("could not locate main configuration project "
@ -1326,10 +1334,11 @@ package body Prj.Conf is
end if;
-- If the config file is not auto-generated, warn if there is any --RTS
-- switch on the command line.
-- switch, but not when the config file is generated in memory.
elsif RTS_Languages.Get_First /= No_Name
and then Opt.Warning_Mode /= Opt.Suppress
and then On_Load_Config = null
then
Write_Line
("warning: --RTS is taken into account only in auto-configuration");
@ -1411,6 +1420,56 @@ package body Prj.Conf is
end if;
end Locate_Config_File;
--------------------
-- Locate_Runtime --
--------------------
procedure Locate_Runtime
(Language : Name_Id;
Project_Tree : Prj.Project_Tree_Ref)
is
function Is_Base_Name (Path : String) return Boolean;
-- Returns True if Path has no directory separator
------------------
-- Is_Base_Name --
------------------
function Is_Base_Name (Path : String) return Boolean is
begin
for I in Path'Range loop
if Path (I) = Directory_Separator or else Path (I) = '/' then
return False;
end if;
end loop;
return True;
end Is_Base_Name;
-- Local declarations
function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
(Check_Filename => Is_Directory);
RTS_Name : constant String := Runtime_Name_For (Language);
Full_Path : String_Access;
-- Start of processing for Locate_Runtime
begin
if not Is_Base_Name (RTS_Name) then
Full_Path :=
Find_Rts_In_Path (Root_Environment.Project_Path, RTS_Name);
if Full_Path = null then
Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name);
end if;
Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all));
Free (Full_Path);
end if;
end Locate_Runtime;
------------------------------------
-- Parse_Project_And_Apply_Config --
------------------------------------

10
gcc/ada/prj-conf.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2012, 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- --
@ -189,4 +189,12 @@ package Prj.Conf is
function Runtime_Name_Set_For (Language : Name_Id) return Boolean;
-- Returns True only if Set_Runtime_For has been called for the Language
procedure Locate_Runtime
(Language : Name_Id;
Project_Tree : Prj.Project_Tree_Ref);
-- If RTS_Name is a base name (a name without path separator), then
-- do nothing. Otherwise, convert it to an absolute path (possibly by
-- searching it in the project path) and call Set_Runtime_For with the
-- absolute path. Fail the program if the path does not exist.
end Prj.Conf;

32
gcc/ada/prj-nmsc.adb
View file

@ -6727,9 +6727,9 @@ package body Prj.Nmsc is
procedure Free (Data : in out Project_Processing_Data) is
begin
Source_Names_Htable.Reset (Data.Source_Names);
Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
Excluded_Sources_Htable.Reset (Data.Excluded);
Source_Names_Htable.Reset (Data.Source_Names);
Unit_Exceptions_Htable.Reset (Data.Unit_Exceptions);
Excluded_Sources_Htable.Reset (Data.Excluded);
end Free;
-------------------------------
@ -6996,9 +6996,9 @@ package body Prj.Nmsc is
if Name_Loc.Source.Naming_Exception = Inherited then
declare
Proj : Project_Id := Name_Loc.Source.Project.Extends;
Iter : Source_Iterator;
Src : Source_Id;
Proj : Project_Id := Name_Loc.Source.Project.Extends;
Iter : Source_Iterator;
Src : Source_Id;
begin
while Proj /= No_Project loop
Iter := For_Each_Source (Data.Tree, Proj);
@ -7149,10 +7149,10 @@ package body Prj.Nmsc is
(Path : Path_Information;
Rank : Natural) return Boolean
is
Dir : Dir_Type;
Name : String (1 .. 250);
Last : Natural;
Found : Path_Information;
Dir : Dir_Type;
Name : String (1 .. 250);
Last : Natural;
Found : Path_Information;
Success : Boolean := False;
begin
@ -7198,10 +7198,10 @@ package body Prj.Nmsc is
Rank : Natural) return Boolean
is
Path_Str : constant String := Get_Name_String (Path.Display_Name);
Dir : Dir_Type;
Name : String (1 .. 250);
Last : Natural;
Success : Boolean := False;
Dir : Dir_Type;
Name : String (1 .. 250);
Last : Natural;
Success : Boolean := False;
begin
Debug_Output ("looking for subdirs of ", Name_Id (Path.Display_Name));
@ -8321,9 +8321,7 @@ package body Prj.Nmsc is
procedure Check_Not_Defined (Name : Name_Id) is
Var : constant Prj.Variable_Value :=
Prj.Util.Value_Of
(Name,
Project.Decl.Attributes,
Data.Tree.Shared);
(Name, Project.Decl.Attributes, Data.Tree.Shared);
begin
if not Var.Default then
Error_Msg_Name_1 := Name;