[multiple changes]

2009-11-30  Emmanuel Briot  <briot@adacore.com>

	* prj.adb, prj.ads, prj-nmsc.adb (Has_Multi_Unit_Sources): New field in
	project_data.

2009-11-30  Vincent Celier  <celier@adacore.com>

	* osint.adb (Executable_Name): Correctly decide if the executable
	suffix should be added when Only_If_No_Suffix is True.

2009-11-30  Robert Dewar  <dewar@adacore.com>

	* frontend.adb, gnatlink.adb, prj-conf.adb, prj-tree.adb,
	prj-tree.ads: Minor reformatting

From-SVN: r154793
This commit is contained in:
Arnaud Charlet 2009-11-30 13:02:49 +01:00
parent 828781519a
commit 43ccd04be7
10 changed files with 104 additions and 59 deletions

View File

@ -1,3 +1,18 @@
2009-11-30 Emmanuel Briot <briot@adacore.com>
* prj.adb, prj.ads, prj-nmsc.adb (Has_Multi_Unit_Sources): New field in
project_data.
2009-11-30 Vincent Celier <celier@adacore.com>
* osint.adb (Executable_Name): Correctly decide if the executable
suffix should be added when Only_If_No_Suffix is True.
2009-11-30 Robert Dewar <dewar@adacore.com>
* frontend.adb, gnatlink.adb, prj-conf.adb, prj-tree.adb,
prj-tree.ads: Minor reformatting
2009-11-30 Vincent Celier <celier@adacore.com>
* gnatlink.adb (Process_Args): Call Executable_Name on argument of -o

View File

@ -400,6 +400,7 @@ begin
then
Initialize_Scalars := True;
end if;
Next (Item);
end loop;
end;

View File

@ -447,8 +447,8 @@ procedure Gnatlink is
Output_File_Name :=
new String'(Executable_Name
(Argument (Next_Arg),
Only_If_No_Suffix => True));
(Argument (Next_Arg),
Only_If_No_Suffix => True));
when 'R' =>
Opt.Run_Path_Option := False;

View File

@ -813,12 +813,16 @@ package body Osint is
end if;
if Exec_Suffix'Length /= 0 then
Add_Suffix := not Only_If_No_Suffix;
if not Add_Suffix then
for J in 1 .. Name_Len loop
Add_Suffix := True;
if Only_If_No_Suffix then
for J in reverse 1 .. Name_Len loop
if Name_Buffer (J) = '.' then
Add_Suffix := True;
Add_Suffix := False;
exit;
elsif Name_Buffer (J) = '/' or else
Name_Buffer (J) = Directory_Separator
then
exit;
end if;
end loop;
@ -875,40 +879,50 @@ package body Osint is
Exec_Suffix := new String'(Name_Buffer (1 .. Name_Len));
end if;
declare
Suffix : constant String := Exec_Suffix.all;
begin
if Exec_Suffix'Length = 0 then
Free (Exec_Suffix);
Canonical_Case_File_Name (Canonical_Name);
Add_Suffix := not Only_If_No_Suffix;
return Name;
if not Add_Suffix then
for J in 1 .. Name_Len loop
if Name_Buffer (J) = '.' then
Add_Suffix := True;
exit;
end if;
end loop;
end if;
else
declare
Suffix : constant String := Exec_Suffix.all;
if Suffix'Length = 0 and then
Add_Suffix and then
(Canonical_Name'Length <= Suffix'Length
or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
.. Canonical_Name'Last) /= Suffix)
then
declare
Result : String (1 .. Name'Length + Suffix'Length);
begin
Result (1 .. Name'Length) := Name;
Result (Name'Length + 1 .. Result'Last) := Suffix;
return Result;
end;
else
return Name;
end if;
end;
begin
Free (Exec_Suffix);
Canonical_Case_File_Name (Canonical_Name);
Add_Suffix := True;
if Only_If_No_Suffix then
for J in reverse 1 .. Name_Len loop
if Name_Buffer (J) = '.' then
Add_Suffix := False;
exit;
elsif Name_Buffer (J) = '/' or else
Name_Buffer (J) = Directory_Separator
then
exit;
end if;
end loop;
end if;
if Add_Suffix and then
(Canonical_Name'Length <= Suffix'Length
or else Canonical_Name (Canonical_Name'Last - Suffix'Length + 1
.. Canonical_Name'Last) /= Suffix)
then
declare
Result : String (1 .. Name'Length + Suffix'Length);
begin
Result (1 .. Name'Length) := Name;
Result (Name'Length + 1 .. Result'Last) := Suffix;
return Result;
end;
else
return Name;
end if;
end;
end if;
end Executable_Name;
-----------------------

View File

@ -1188,10 +1188,12 @@ package body Prj.Conf is
Index : String := "";
Pkg : Project_Node_Id := Empty_Node)
is
Attr : Project_Node_Id;
Val, Expr : Name_Id := No_Name;
Parent : Project_Node_Id := Config_File;
Attr : Project_Node_Id;
pragma Unreferenced (Attr);
Expr : Name_Id := No_Name;
Val : Name_Id := No_Name;
Parent : Project_Node_Id := Config_File;
begin
if Index /= "" then
Name_Len := Index'Length;
@ -1216,6 +1218,8 @@ package body Prj.Conf is
Value => Create_Literal_String (Expr, Project_Tree));
end Create_Attribute;
-- Local variables
Name : Name_Id;
Naming : Project_Node_Id;

View File

@ -777,6 +777,10 @@ package body Prj.Nmsc is
Source_Paths_Htable.Set (Data.Tree.Source_Paths_HT, Path.Name, Id);
end if;
if Index /= 0 then
Project.Has_Multi_Unit_Sources := True;
end if;
-- Add the source to the language list
Id.Next_In_Lang := Lang_Id.First_Source;

View File

@ -3083,15 +3083,17 @@ package body Prj.Tree is
Optional_Index_Case_Insensitive_Associative_Array
then
-- Results in: for Name ("index" at index) use "value";
-- This is currently only used for executables
-- This is currently only used for executables.
Set_Source_Index_Of (Node, Tree, To => Int (At_Index));
else
-- Results in: for Name ("index") use "value" at index;
-- ??? This limitation makes no sense, we should be able to
-- set the source index on an expression
pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
-- set the source index on an expression.
pragma Assert (Kind_Of (Value, Tree) = N_Literal_String);
Set_Source_Index_Of (Value, Tree, To => Int (At_Index));
end if;
end if;

View File

@ -614,9 +614,9 @@ package Prj.Tree is
(Tree : Project_Node_Tree_Ref;
Prj_Or_Pkg : Project_Node_Id;
Name : Name_Id;
Index_Name : Name_Id := No_Name;
Kind : Variable_Kind := List;
At_Index : Integer := 0;
Index_Name : Name_Id := No_Name;
Kind : Variable_Kind := List;
At_Index : Integer := 0;
Value : Project_Node_Id := Empty_Node) return Project_Node_Id;
-- Create a new attribute. The new declaration is added at the end of the
-- declarative item list for Prj_Or_Pkg (a project or a package), but
@ -624,14 +624,15 @@ package Prj.Tree is
-- Empty_Node. If Index_Name is not "", then if creates an attribute value
-- for a specific index. At_Index is used for the " at <idx>" in the naming
-- exceptions.
-- To set the value of the attribute, either provide a value for
-- Value, or use Set_Expression_Of to set the value of the attribute
-- (in which case Enclose_In_Expression might be useful). The former is
-- recommended since it will more correctly handle cases where the index
-- needs to be set on the expression rather than on the index of the
-- attribute ('for Specification ("unit") use "file" at 3', versus
-- 'for Executable ("file" at 3) use "name"'). Value must be a
-- N_String_Literal if an index will be added to it
--
-- To set the value of the attribute, either provide a value for Value, or
-- use Set_Expression_Of to set the value of the attribute (in which case
-- Enclose_In_Expression might be useful). The former is recommended since
-- it will more correctly handle cases where the index needs to be set on
-- the expression rather than on the index of the attribute (i.e. 'for
-- Specification ("unit") use "file" at 3', versus 'for Executable ("file"
-- at 3) use "name"'). Value must be a N_String_Literal if an index will be
-- added to it.
function Create_Literal_String
(Str : Namet.Name_Id;
@ -657,7 +658,7 @@ package Prj.Tree is
(Node : Project_Node_Id;
Tree : Project_Node_Tree_Ref) return Project_Node_Id;
-- Enclose the Node inside a N_Expression node, and return this expression.
-- This does nothing if Node is already a N_Expression
-- This does nothing if Node is already a N_Expression.
--------------------
-- Set Procedures --

View File

@ -23,9 +23,6 @@
-- --
------------------------------------------------------------------------------
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;
with Debug;
with Osint; use Osint;
with Output; use Output;
@ -34,6 +31,9 @@ with Prj.Err; use Prj.Err;
with Snames; use Snames;
with Uintp; use Uintp;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Unchecked_Deallocation;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with System.Case_Util; use System.Case_Util;
@ -107,6 +107,7 @@ package body Prj is
Config_File_Temp => False,
Config_Checked => False,
Need_To_Build_Lib => False,
Has_Multi_Unit_Sources => False,
Depth => 0,
Unkept_Comments => False);

View File

@ -1207,6 +1207,9 @@ package Prj is
-- use this field directly outside of the project manager, use
-- Prj.Env.Ada_Include_Path instead.
Has_Multi_Unit_Sources : Boolean := False;
-- Whether there is at least one source file containing multiple units
-------------------
-- Miscellaneous --
-------------------