[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:
parent
828781519a
commit
43ccd04be7
|
@ -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
|
||||
|
|
|
@ -400,6 +400,7 @@ begin
|
|||
then
|
||||
Initialize_Scalars := True;
|
||||
end if;
|
||||
|
||||
Next (Item);
|
||||
end loop;
|
||||
end;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
||||
-----------------------
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 --
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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 --
|
||||
-------------------
|
||||
|
|
Loading…
Reference in New Issue