OSDN Git Service

2009-11-30 Emmanuel Briot <briot@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 12:02:49 +0000 (12:02 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 30 Nov 2009 12:02:49 +0000 (12:02 +0000)
* 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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@154793 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/frontend.adb
gcc/ada/gnatlink.adb
gcc/ada/osint.adb
gcc/ada/prj-conf.adb
gcc/ada/prj-nmsc.adb
gcc/ada/prj-tree.adb
gcc/ada/prj-tree.ads
gcc/ada/prj.adb
gcc/ada/prj.ads

index 3808ff7..5b55b1c 100644 (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
index 5832a2c..89746b8 100644 (file)
@@ -400,6 +400,7 @@ begin
          then
             Initialize_Scalars := True;
          end if;
+
          Next (Item);
       end loop;
    end;
index 201e11d..708e179 100644 (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;
index 523852a..1fcff59 100644 (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;
 
    -----------------------
index 233f6db..30823a3 100644 (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;
 
index e3d84d3..b56d05f 100644 (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;
index 0129f1d..be8f5fc 100644 (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;
index d3b86e6..fa8c132 100644 (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 --
index 1d87d19..0bae53c 100644 (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);
 
index c19dd8d..88f1ecd 100644 (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 --
       -------------------