+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
then
Initialize_Scalars := True;
end if;
+
Next (Item);
end loop;
end;
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;
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;
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;
-----------------------
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;
Value => Create_Literal_String (Expr, Project_Tree));
end Create_Attribute;
+ -- Local variables
+
Name : Name_Id;
Naming : Project_Node_Id;
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;
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;
(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
-- 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;
(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 --
-- --
------------------------------------------------------------------------------
-with Ada.Characters.Handling; use Ada.Characters.Handling;
-with Ada.Unchecked_Deallocation;
-
with Debug;
with Osint; use Osint;
with Output; use Output;
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;
Config_File_Temp => False,
Config_Checked => False,
Need_To_Build_Lib => False,
+ Has_Multi_Unit_Sources => False,
Depth => 0,
Unkept_Comments => False);
-- 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 --
-------------------
projects / thirdparty / gcc.git / commitdiff
