[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 09:59:55 +0000 (11:59 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 3 Aug 2011 09:59:55 +0000 (11:59 +0200)
2011-08-03  Yannick Moy  <moy@adacore.com>

* alfa.ads Update format of ALFA section in ALI file in order to add a
mapping from bodies to specs when both are present
(ALFA_Scope_Record): add components for spec file/scope
* get_alfa.adb (Get_ALFA): read the new file/scope for spec when present
* lib-xref-alfa.adb
(Collect_ALFA): after all scopes have been collected, fill in the spec
 information when relevant
* put_alfa.adb (Put_ALFA): write the new file/scope for spec when
present.

2011-08-03  Eric Botcazou  <ebotcazou@adacore.com>

* inline.adb (Add_Inlined_Subprogram): Do not consider the enclosing
code unit to decide whether to add internally generated subprograms.

2011-08-03  Javier Miranda  <miranda@adacore.com>

* sem_aux.ads, sem_aux.adb (Is_VM_By_Copy_Actual): New subprogram.
* exp_ch9.adb
(Build_Simple_Entry_Call): Handle actuals that must be handled by copy
in VM targets.

2011-08-03  Emmanuel Briot  <briot@adacore.com>

* make.adb, makeutl.adb, makeutl.ads (Make.Switches_Of): now shares
code with Makeutl.Get_Switches.
* prj-tree.adb: Update comment.

From-SVN: r177256

13 files changed:
gcc/ada/ChangeLog
gcc/ada/alfa.ads
gcc/ada/exp_ch9.adb
gcc/ada/get_alfa.adb
gcc/ada/inline.adb
gcc/ada/lib-xref-alfa.adb
gcc/ada/make.adb
gcc/ada/makeutl.adb
gcc/ada/makeutl.ads
gcc/ada/prj-tree.adb
gcc/ada/put_alfa.adb
gcc/ada/sem_aux.adb
gcc/ada/sem_aux.ads

index 90df61211d48df86e94370f9978f873a5f9b5881..3090c3eeb7a2b6c74c9d9798938e9d27a1b3481e 100644 (file)
@@ -1,3 +1,33 @@
+2011-08-03  Yannick Moy  <moy@adacore.com>
+
+       * alfa.ads Update format of ALFA section in ALI file in order to add a
+       mapping from bodies to specs when both are present
+       (ALFA_Scope_Record): add components for spec file/scope
+       * get_alfa.adb (Get_ALFA): read the new file/scope for spec when present
+       * lib-xref-alfa.adb
+       (Collect_ALFA): after all scopes have been collected, fill in the spec
+        information when relevant
+       * put_alfa.adb (Put_ALFA): write the new file/scope for spec when
+       present.
+
+2011-08-03  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * inline.adb (Add_Inlined_Subprogram): Do not consider the enclosing
+       code unit to decide whether to add internally generated subprograms.
+       
+2011-08-03  Javier Miranda  <miranda@adacore.com>
+
+       * sem_aux.ads, sem_aux.adb (Is_VM_By_Copy_Actual): New subprogram.
+       * exp_ch9.adb
+       (Build_Simple_Entry_Call): Handle actuals that must be handled by copy
+       in VM targets.
+
+2011-08-03  Emmanuel Briot  <briot@adacore.com>
+
+       * make.adb, makeutl.adb, makeutl.ads (Make.Switches_Of): now shares
+       code with Makeutl.Get_Switches.
+       * prj-tree.adb: Update comment.
+
 2011-08-03  Thomas Quinot  <quinot@adacore.com>
 
        * sem_cat.adb (Validate_RCI_Subprogram_Declaration): Reject a remote
index cf0e43db143093ddfcf366021961c8267164df9b..8601a321f21c40886b198b3a5287d9ef724345a9 100644 (file)
@@ -89,7 +89,7 @@ package ALFA is
    --      reading of the ALFA information, and means that the ALFA information
    --      can stand on its own without needing other parts of the ALI file.
 
-   --    FS . scope line type col entity
+   --    FS . scope line type col entity (-> spec-file . spec-scope)?
 
    --      scope is the ones-origin scope number for the current file (e.g. 2 =
    --      reference to the second FS line in this FD block).
@@ -113,6 +113,9 @@ package ALFA is
    --      entity is the name of the scope entity, with casing in the canonical
    --      casing for the source file where it is defined.
 
+   --      spec-file and spec-scope are respectively the file and scope for the
+   --      spec corresponding to the current body scope, when they differ.
+
    --  ------------------
    --  -- Xref Section --
    --  ------------------
@@ -234,6 +237,14 @@ package ALFA is
       Scope_Num : Nat;
       --  Set to the scope number for the scope
 
+      Spec_File_Num : Nat;
+      --  Set to the file dependency number for the scope corresponding to the
+      --  spec of the current scope entity, if different, or else 0.
+
+      Spec_Scope_Num : Nat;
+      --  Set to the scope number for the scope corresponding to the spec of
+      --  the current scope entity, if different, or else 0.
+
       Line : Nat;
       --  Line number for the scope
 
index 0a0a28a1ee2113412a53e374f9f2d47d2e783ad2..1b2e7fd81d09d23df04b2898c414e754d91e8dd1 100644 (file)
@@ -3796,6 +3796,27 @@ package body Exp_Ch9 is
                       Attribute_Name => Name_Unchecked_Access,
                     Prefix =>
                       New_Reference_To (Defining_Identifier (N_Node), Loc)));
+
+               --  If it is a vm_by_copy_actual, copy it to a new variable
+
+               elsif Is_VM_By_Copy_Actual (Actual) then
+                  N_Node :=
+                    Make_Object_Declaration (Loc,
+                      Defining_Identifier => Make_Temporary (Loc, 'J'),
+                      Aliased_Present     => True,
+                      Object_Definition   =>
+                        New_Reference_To (Etype (Formal), Loc),
+                      Expression => New_Copy_Tree (Actual));
+                  Set_Assignment_OK (N_Node);
+
+                  Append (N_Node, Decls);
+
+                  Append_To (Plist,
+                    Make_Attribute_Reference (Loc,
+                      Attribute_Name => Name_Unchecked_Access,
+                    Prefix =>
+                      New_Reference_To (Defining_Identifier (N_Node), Loc)));
+
                else
                   --  Interface class-wide formal
 
@@ -3947,7 +3968,8 @@ package body Exp_Ch9 is
 
             Set_Assignment_OK (Actual);
             while Present (Actual) loop
-               if Is_By_Copy_Type (Etype (Actual))
+               if (Is_By_Copy_Type (Etype (Actual))
+                     or else Is_VM_By_Copy_Actual (Actual))
                  and then Ekind (Formal) /= E_In_Parameter
                then
                   N_Node :=
index 94d5d9f4680b34831545ac7f141551bd64804326..d9565b19b1b2d38f5b024eaf244203527e8351c4 100644 (file)
@@ -254,10 +254,12 @@ begin
 
          when 'S' =>
             declare
-               Scope : Nat;
-               Line  : Nat;
-               Col   : Nat;
-               Typ   : Character;
+               Spec_File  : Nat;
+               Spec_Scope : Nat;
+               Scope      : Nat;
+               Line       : Nat;
+               Col        : Nat;
+               Typ        : Character;
 
             begin
                --  Scan out location
@@ -279,21 +281,36 @@ begin
 
                Skip_Spaces;
                Get_Name;
+               Skip_Spaces;
+
+               if Nextc = '-' then
+                  Skipc;
+                  Check ('>');
+                  Skip_Spaces;
+                  Spec_File := Get_Nat;
+                  Check ('.');
+                  Spec_Scope := Get_Nat;
+               else
+                  Spec_File  := 0;
+                  Spec_Scope := 0;
+               end if;
 
                --  Make new scope table entry (will fill in From_Xref and
                --  To_Xref later). Initial range (From_Xref .. To_Xref) is
                --  empty for scopes without entities.
 
                ALFA_Scope_Table.Append (
-                 (Scope_Entity => Empty,
-                  Scope_Name   => new String'(Name_Str (1 .. Name_Len)),
-                  File_Num     => Cur_File,
-                  Scope_Num    => Cur_Scope,
-                  Line         => Line,
-                  Stype        => Typ,
-                  Col          => Col,
-                  From_Xref    => 1,
-                  To_Xref      => 0));
+                 (Scope_Entity   => Empty,
+                  Scope_Name     => new String'(Name_Str (1 .. Name_Len)),
+                  File_Num       => Cur_File,
+                  Scope_Num      => Cur_Scope,
+                  Spec_File_Num  => Spec_File,
+                  Spec_Scope_Num => Spec_Scope,
+                  Line           => Line,
+                  Stype          => Typ,
+                  Col            => Col,
+                  From_Xref      => 1,
+                  To_Xref        => 0));
             end;
 
             --  Update counter for scopes
index d85e0866a48bda7796e3f4a9b47a8556d16d7900..5f5a4a01b05e664d1999b265950da8b9b7318438 100644 (file)
@@ -428,13 +428,17 @@ package body Inline is
    --  Start of processing for Add_Inlined_Subprogram
 
    begin
-      --  Insert the current subprogram in the list of inlined subprograms, if
-      --  it can actually be inlined by the back-end, and if its unit is known
-      --  to be inlined, or is an instance whose body will be analyzed anyway.
-
-      if (Is_Inlined (Pack) or else Is_Generic_Instance (Pack))
+      --  If the subprogram is to be inlined, and if its unit is known to be
+      --  inlined or is an instance whose body will be analyzed anyway or the
+      --  subprogram has been generated by the compiler, and if it is declared
+      --  at the library level not in the main unit, and if it can be inlined
+      --  by the back-end, then insert it in the list of inlined subprograms.
+
+      if Is_Inlined (E)
+        and then (Is_Inlined (Pack)
+                    or else Is_Generic_Instance (Pack)
+                    or else Is_Internal (E))
         and then not Scope_In_Main_Unit (E)
-        and then Is_Inlined (E)
         and then not Is_Nested (E)
         and then not Has_Initialized_Type (E)
       then
index 5e0edbc3e48dee66c9ee3267fcb16cfafa25380f..860e80eb90a38b0b39049e7ffe1ddd9fa211a0fa 100644 (file)
@@ -140,6 +140,9 @@ package body ALFA is
       's' => True,
       others => False);
 
+   type Entity_Hashed_Range is range 0 .. 255;
+   --  Size of hash table headers
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -155,6 +158,9 @@ package body ALFA is
    --  Filter table Xrefs to add all references used in ALFA to the table
    --  ALFA_Xref_Table.
 
+   function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range;
+   --  Hash function for hash table
+
    procedure Traverse_Declarations_Or_Statements  (L : List_Id);
    procedure Traverse_Handled_Statement_Sequence  (N : Node_Id);
    procedure Traverse_Package_Body                (N : Node_Id);
@@ -339,15 +345,17 @@ package body ALFA is
       --  filled even later, but are initialized to represent an empty range.
 
       ALFA_Scope_Table.Append (
-        (Scope_Name   => new String'(Exact_Source_Name (Sloc (E))),
-         File_Num     => 0,
-         Scope_Num    => 0,
-         Line         => Nat (Get_Logical_Line_Number (Loc)),
-         Stype        => Typ,
-         Col          => Nat (Get_Column_Number (Loc)),
-         From_Xref    => 1,
-         To_Xref      => 0,
-         Scope_Entity => E));
+        (Scope_Name     => new String'(Exact_Source_Name (Sloc (E))),
+         File_Num       => 0,
+         Scope_Num      => 0,
+         Spec_File_Num  => 0,
+         Spec_Scope_Num => 0,
+         Line           => Nat (Get_Logical_Line_Number (Loc)),
+         Stype          => Typ,
+         Col            => Nat (Get_Column_Number (Loc)),
+         From_Xref      => 1,
+         To_Xref        => 0,
+         Scope_Entity   => E));
    end Add_ALFA_Scope;
 
    --------------------
@@ -367,36 +375,37 @@ package body ALFA is
          procedure Set_Scope_Num (N : Entity_Id; Num : Nat);
       end Scopes;
 
+      ------------
+      -- Scopes --
+      ------------
+
       package body Scopes is
          type Scope is record
             Num    : Nat;
             Entity : Entity_Id;
          end record;
 
-         type Scope_Hashed is range 0 .. 255;
-
-         function Scope_Hash (E : Entity_Id) return Scope_Hashed;
-
-         function Scope_Hash (E : Entity_Id) return Scope_Hashed is
-            Value  : constant Int := Int (E);
-            Modulo : constant Int := Int (Scope_Hashed'Last) + 1;
-         begin
-            return Scope_Hashed (Value - (Value / Modulo) * Modulo);
-         end Scope_Hash;
-
          package Scopes is new GNAT.HTable.Simple_HTable
-           (Header_Num => Scope_Hashed,
+           (Header_Num => Entity_Hashed_Range,
             Element    => Scope,
             No_Element => (Num => No_Scope, Entity => Empty),
             Key        => Entity_Id,
-            Hash       => Scope_Hash,
+            Hash       => Entity_Hash,
             Equal      => "=");
 
+         -------------------
+         -- Get_Scope_Num --
+         -------------------
+
          function Get_Scope_Num (N : Entity_Id) return Nat is
          begin
             return Scopes.Get (N).Num;
          end Get_Scope_Num;
 
+         -------------------
+         -- Set_Scope_Num --
+         -------------------
+
          procedure Set_Scope_Num (N : Entity_Id; Num : Nat) is
          begin
             Scopes.Set (K => N, E => Scope'(Num => Num, Entity => N));
@@ -782,11 +791,83 @@ package body ALFA is
          end if;
       end loop;
 
+      --  Fill in the spec information when relevant
+
+      declare
+         package Entity_Hash_Table is new
+           GNAT.HTable.Simple_HTable
+             (Header_Num => Entity_Hashed_Range,
+              Element    => Scope_Index,
+              No_Element => 0,
+              Key        => Entity_Id,
+              Hash       => Entity_Hash,
+              Equal      => "=");
+
+      begin
+         --  Fill in the hash-table
+
+         for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop
+            declare
+               Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S);
+            begin
+               Entity_Hash_Table.Set (Srec.Scope_Entity, S);
+            end;
+         end loop;
+
+         --  Use the hash-table to locate spec entities
+
+         for S in ALFA_Scope_Table.First .. ALFA_Scope_Table.Last loop
+            declare
+               Srec : ALFA_Scope_Record renames ALFA_Scope_Table.Table (S);
+               Body_Entity : Entity_Id;
+               Spec_Entity : Entity_Id;
+               Spec_Scope  : Scope_Index;
+            begin
+               if Ekind (Srec.Scope_Entity) = E_Subprogram_Body then
+                  Body_Entity := Parent (Parent (Srec.Scope_Entity));
+               elsif Ekind (Srec.Scope_Entity) = E_Package_Body then
+                  Body_Entity := Parent (Srec.Scope_Entity);
+               else
+                  Body_Entity := Empty;
+               end if;
+
+               if Present (Body_Entity) then
+                  if Nkind (Body_Entity) = N_Defining_Program_Unit_Name then
+                     Body_Entity := Parent (Body_Entity);
+                  end if;
+
+                  Spec_Entity := Corresponding_Spec (Body_Entity);
+                  Spec_Scope := Entity_Hash_Table.Get (Spec_Entity);
+
+                  --  Spec of generic may be missing
+
+                  if Spec_Scope /= 0 then
+                     Srec.Spec_File_Num :=
+                       ALFA_Scope_Table.Table (Spec_Scope).File_Num;
+                     Srec.Spec_Scope_Num :=
+                       ALFA_Scope_Table.Table (Spec_Scope).Scope_Num;
+                  end if;
+               end if;
+            end;
+         end loop;
+
+      end;
+
       --  Generate cross reference ALFA information
 
       Add_ALFA_Xrefs;
    end Collect_ALFA;
 
+   -----------------
+   -- Entity_Hash --
+   -----------------
+
+   function Entity_Hash (E : Entity_Id) return Entity_Hashed_Range is
+   begin
+      return Entity_Hashed_Range
+        (E mod (Entity_Id (Entity_Hashed_Range'Last) + 1));
+   end Entity_Hash;
+
    -----------------------------------------
    -- Traverse_Declarations_Or_Statements --
    -----------------------------------------
index 73f022e9d5e09ed48c0d91bf88bf6432472f3e59..534795a14dbb030246d380e5ab9304bc8cb78a36 100644 (file)
@@ -625,8 +625,6 @@ package body Make is
 
    function Switches_Of
      (Source_File      : File_Name_Type;
-      Source_File_Name : String;
-      Source_Index     : Int;
       Project          : Project_Id;
       In_Package       : Package_Id;
       Allow_ALI        : Boolean) return Variable_Value;
@@ -780,7 +778,6 @@ package body Make is
 
    procedure Collect_Arguments
      (Source_File    : File_Name_Type;
-      Source_Index   : Int;
       Is_Main_Source : Boolean;
       Args           : Argument_List);
    --  Collect all arguments for a source to be compiled, including those
@@ -1282,8 +1279,6 @@ package body Make is
          Switches :=
            Switches_Of
              (Source_File      => Name_Find,
-              Source_File_Name => File_Name,
-              Source_Index     => Index,
               Project          => Main_Project,
               In_Package       => The_Package,
               Allow_ALI        => Program = Binder or else Program = Linker);
@@ -1707,8 +1702,7 @@ package body Make is
 
             --  First, collect all the switches
 
-            Collect_Arguments
-              (Source_File, Source_Index, Is_Main_Source, The_Args);
+            Collect_Arguments (Source_File, Is_Main_Source, The_Args);
 
             Prev_Switch := Dummy_Switch;
 
@@ -2246,7 +2240,6 @@ package body Make is
 
    procedure Collect_Arguments
      (Source_File    : File_Name_Type;
-      Source_Index   : Int;
       Is_Main_Source : Boolean;
       Args           : Argument_List)
    is
@@ -2319,8 +2312,6 @@ package body Make is
                   Switches :=
                     Switches_Of
                       (Source_File      => Source_File,
-                       Source_File_Name => Source_File_Name,
-                       Source_Index     => Source_Index,
                        Project          => Arguments_Project,
                        In_Package       => Compiler_Package,
                        Allow_ALI        => False);
@@ -3429,8 +3420,8 @@ package body Make is
                --  The source file that we are checking can be located
 
             else
-               Collect_Arguments (Source_File, Source_Index,
-                                  Source_File = Main_Source, Args);
+               Collect_Arguments
+                  (Source_File, Source_File = Main_Source, Args);
 
                --  Do nothing if project of source is externally built
 
@@ -8454,153 +8445,24 @@ package body Make is
 
    function Switches_Of
      (Source_File      : File_Name_Type;
-      Source_File_Name : String;
-      Source_Index     : Int;
       Project          : Project_Id;
       In_Package       : Package_Id;
       Allow_ALI        : Boolean) return Variable_Value
    is
-      Lang : constant Language_Ptr := Get_Language_From_Name (Project, "ada");
-
       Switches : Variable_Value;
-
-      Defaults : constant Array_Element_Id :=
-                   Prj.Util.Value_Of
-                     (Name      => Name_Default_Switches,
-                      In_Arrays =>
-                        Project_Tree.Packages.Table
-                          (In_Package).Decl.Arrays,
-                      In_Tree   => Project_Tree);
-
-      Switches_Array : constant Array_Element_Id :=
-                         Prj.Util.Value_Of
-                           (Name      => Name_Switches,
-                            In_Arrays =>
-                              Project_Tree.Packages.Table
-                                (In_Package).Decl.Arrays,
-                            In_Tree   => Project_Tree);
+      Is_Default : Boolean;
 
    begin
-      --  First, try Switches (<file name>)
-
-      Switches :=
-        Prj.Util.Value_Of
-          (Index           => Name_Id (Source_File),
-           Src_Index       => Source_Index,
-           In_Array        => Switches_Array,
-           In_Tree         => Project_Tree,
-           Allow_Wildcards => True);
-
-      --  Check also without the suffix
-
-      if Switches = Nil_Variable_Value
-        and then Lang /= null
-      then
-         declare
-            Naming      : Lang_Naming_Data renames Lang.Config.Naming_Data;
-            Name        : String (1 .. Source_File_Name'Length + 3);
-            Last        : Positive := Source_File_Name'Length;
-            Spec_Suffix : String   := Get_Name_String (Naming.Spec_Suffix);
-            Body_Suffix : String   := Get_Name_String (Naming.Body_Suffix);
-            Truncated   : Boolean  := False;
-
-         begin
-            Canonical_Case_File_Name (Spec_Suffix);
-            Canonical_Case_File_Name (Body_Suffix);
-            Name (1 .. Last) := Source_File_Name;
-
-            if Last > Body_Suffix'Length
-               and then Name (Last - Body_Suffix'Length + 1 .. Last) =
-                                                                  Body_Suffix
-            then
-               Truncated := True;
-               Last := Last - Body_Suffix'Length;
-            end if;
-
-            if not Truncated
-              and then Last > Spec_Suffix'Length
-              and then Name (Last - Spec_Suffix'Length + 1 .. Last) =
-                                                                 Spec_Suffix
-            then
-               Truncated := True;
-               Last := Last - Spec_Suffix'Length;
-            end if;
-
-            if Truncated then
-               Name_Len := 0;
-               Add_Str_To_Name_Buffer (Name (1 .. Last));
-               Switches :=
-                 Prj.Util.Value_Of
-                   (Index           => Name_Find,
-                    Src_Index       => 0,
-                    In_Array        => Switches_Array,
-                    In_Tree         => Project_Tree,
-                    Allow_Wildcards => True);
-
-               if Switches = Nil_Variable_Value and then Allow_ALI then
-                  Last := Source_File_Name'Length;
-
-                  while Name (Last) /= '.' loop
-                     Last := Last - 1;
-                  end loop;
-
-                  Name_Len := 0;
-                  Add_Str_To_Name_Buffer (Name (1 .. Last));
-                  Add_Str_To_Name_Buffer ("ali");
-
-                  Switches :=
-                    Prj.Util.Value_Of
-                      (Index     => Name_Find,
-                       Src_Index => 0,
-                       In_Array  => Switches_Array,
-                       In_Tree   => Project_Tree);
-               end if;
-            end if;
-         end;
-      end if;
-
-      --  Next, try Switches ("Ada")
-
-      if Switches = Nil_Variable_Value then
-         Switches :=
-           Prj.Util.Value_Of
-             (Index                  => Name_Ada,
-              Src_Index              => 0,
-              In_Array               => Switches_Array,
-              In_Tree                => Project_Tree,
-              Force_Lower_Case_Index => True);
-
-         if Switches /= Nil_Variable_Value then
-            Switch_May_Be_Passed_To_The_Compiler := False;
-         end if;
-      end if;
-
-      --  Next, try Switches (others)
-
-      if Switches = Nil_Variable_Value then
-         Switches :=
-           Prj.Util.Value_Of
-             (Index     => All_Other_Names,
-              Src_Index => 0,
-              In_Array  => Switches_Array,
-              In_Tree   => Project_Tree);
-
-         if Switches /= Nil_Variable_Value then
-            Switch_May_Be_Passed_To_The_Compiler := False;
-         end if;
-      end if;
-
-      --  And finally, Default_Switches ("Ada")
-
-      if Switches = Nil_Variable_Value then
-         Switches :=
-           Prj.Util.Value_Of
-             (Index     => Name_Ada,
-              Src_Index => 0,
-              In_Array  => Defaults,
-              In_Tree   => Project_Tree);
-      end if;
-
+      Makeutl.Get_Switches
+        (Source_File  => Source_File,
+         Source_Lang  => Name_Ada,
+         Source_Prj   => Project,
+         Pkg_Name     => Project_Tree.Packages.Table (In_Package).Name,
+         Project_Tree => Project_Tree,
+         Value        => Switches,
+         Is_Default   => Is_Default,
+         Test_Without_Suffix => True,
+         Check_ALI_Suffix => Allow_ALI);
       return Switches;
    end Switches_Of;
 
index a8c54e640e099b7f42e60a79a1b03abae49535e9..5afb62923a5ab2e3b3e37241f5f44f8aa1fbd434 100644 (file)
@@ -685,7 +685,9 @@ package body Makeutl is
       Pkg_Name     : Name_Id;
       Project_Tree : Project_Tree_Ref;
       Value        : out Variable_Value;
-      Is_Default   : out Boolean)
+      Is_Default   : out Boolean;
+      Test_Without_Suffix : Boolean := False;
+      Check_ALI_Suffix    : Boolean := False)
    is
       Project : constant Project_Id :=
                   Ultimate_Extending_Project_Of (Source_Prj);
@@ -694,6 +696,7 @@ package body Makeutl is
                     (Name        => Pkg_Name,
                      In_Packages => Project.Decl.Packages,
                      In_Tree     => Project_Tree);
+      Lang : Language_Ptr;
    begin
       Is_Default := False;
 
@@ -706,8 +709,79 @@ package body Makeutl is
             Allow_Wildcards         => True);
       end if;
 
+      if Value = Nil_Variable_Value
+        and then Test_Without_Suffix
+      then
+         Lang :=
+           Get_Language_From_Name (Project, Get_Name_String (Source_Lang));
+
+         if Lang /= null then
+            declare
+               Naming      : Lang_Naming_Data renames Lang.Config.Naming_Data;
+               SF_Name     : constant String := Get_Name_String (Source_File);
+               Last        : Positive := SF_Name'Length;
+               Name        : String (1 .. Last + 3);
+               Spec_Suffix : String   := Get_Name_String (Naming.Spec_Suffix);
+               Body_Suffix : String   := Get_Name_String (Naming.Body_Suffix);
+               Truncated   : Boolean  := False;
+            begin
+               Canonical_Case_File_Name (Spec_Suffix);
+               Canonical_Case_File_Name (Body_Suffix);
+               Name (1 .. Last) := SF_Name;
+
+               if Last > Body_Suffix'Length
+                 and then Name (Last - Body_Suffix'Length + 1 .. Last) =
+                   Body_Suffix
+               then
+                  Truncated := True;
+                  Last := Last - Body_Suffix'Length;
+               end if;
+
+               if not Truncated
+                 and then Last > Spec_Suffix'Length
+                 and then Name (Last - Spec_Suffix'Length + 1 .. Last) =
+                   Spec_Suffix
+               then
+                  Truncated := True;
+                  Last := Last - Spec_Suffix'Length;
+               end if;
+
+               if Truncated then
+                  Name_Len := 0;
+                  Add_Str_To_Name_Buffer (Name (1 .. Last));
+
+                  Value := Prj.Util.Value_Of
+                    (Name                    => Name_Find,
+                     Attribute_Or_Array_Name => Name_Switches,
+                     In_Package              => Pkg,
+                     In_Tree                 => Project_Tree,
+                     Allow_Wildcards         => True);
+               end if;
+
+               if Value = Nil_Variable_Value
+                 and then Check_ALI_Suffix
+               then
+                  Last := SF_Name'Length;
+                  while Name (Last) /= '.' loop
+                     Last := Last - 1;
+                  end loop;
+
+                  Name_Len := 0;
+                  Add_Str_To_Name_Buffer (Name (1 .. Last));
+                  Add_Str_To_Name_Buffer ("ali");
+
+                  Value := Prj.Util.Value_Of
+                    (Name                    => Name_Find,
+                     Attribute_Or_Array_Name => Name_Switches,
+                     In_Package              => Pkg,
+                     In_Tree                 => Project_Tree,
+                     Allow_Wildcards         => True);
+               end if;
+            end;
+         end if;
+      end if;
+
       if Value = Nil_Variable_Value then
-         Is_Default := True;
          Is_Default := True;
          Value :=
            Prj.Util.Value_Of
index 28b59c57ca49dc76e4d8717c76bf207ef8465b47..31a456213cef8247042296edf86b4b17c857d7c2 100644 (file)
@@ -161,13 +161,20 @@ package Makeutl is
       Pkg_Name     : Name_Id;
       Project_Tree : Project_Tree_Ref;
       Value        : out Variable_Value;
-      Is_Default   : out Boolean);
+      Is_Default   : out Boolean;
+      Test_Without_Suffix : Boolean := False;
+      Check_ALI_Suffix    : Boolean := False);
    --  Compute the switches (Compilation switches for instance) for the given
    --  file. This checks various attributes to see if there are file specific
    --  switches, or else defaults on the switches for the corresponding
    --  language. Is_Default is set to False if there were file-specific
    --  switches Source_File can be set to No_File to force retrieval of
    --  the default switches.
+   --  If Test_Without_Suffix is True, and there is no
+   --  " for Switches(Source_File) use", then this procedure also tests without
+   --  the extension of the filename.
+   --  If Test_Without_Suffix is True and Check_ALI_Suffix is True, then we
+   --  also replace the file extension with ".ali" when testing.
 
    function Linker_Options_Switches
      (Project  : Project_Id;
index 3dda4714dd86034a28f960b412c772fb52e98bfb..3ac6a889f837f3c3db0cb1dddb96fba31eee38c8 100644 (file)
@@ -1011,12 +1011,10 @@ package body Prj.Tree is
       --  project, since we want to preserve the current environment. But we
       --  still need to ensure that the external references are properly
       --  initialized.
+      --  Prj.Ext.Reset (Tree.External);
 
       Prj.Ext.Initialize (Self.External);
 
-      --  Why is this line commented out ???
-      --  Prj.Ext.Reset (Tree.External);
-
       Self.Flags := Flags;
    end Initialize;
 
index d8819200e21c152fddce8a9787c2b902992754a8..bf35cbbabf5dafd0edd2b10f8b4655d50f181142 100644 (file)
@@ -78,6 +78,16 @@ begin
                   Write_Info_Char (S.Scope_Name (N));
                end loop;
 
+               if S.Spec_File_Num /= 0 then
+                  Write_Info_Char (' ');
+                  Write_Info_Char ('-');
+                  Write_Info_Char ('>');
+                  Write_Info_Char (' ');
+                  Write_Info_Nat (S.Spec_File_Num);
+                  Write_Info_Char ('.');
+                  Write_Info_Nat (S.Spec_Scope_Num);
+               end if;
+
                Write_Info_Terminate;
             end;
 
index 0e5c3db3cf0028e359db523438766a6c5636940a..5b7de452037bcc412c464f7bfb30e1d9eeb991b0 100755 (executable)
@@ -33,6 +33,7 @@
 with Atree;  use Atree;
 with Einfo;  use Einfo;
 with Namet;  use Namet;
+with Opt;    use Opt;
 with Sinfo;  use Sinfo;
 with Snames; use Snames;
 with Stand;  use Stand;
@@ -784,6 +785,18 @@ package body Sem_Aux is
       end if;
    end Is_Limited_Type;
 
+   --------------------------
+   -- Is_VM_By_Copy_Actual --
+   --------------------------
+
+   function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean is
+   begin
+      return not Tagged_Type_Expansion
+        and then Nkind (N) = N_Identifier
+        and then Present (Renamed_Object (Entity (N)))
+        and then Nkind (Renamed_Object (Entity (N))) = N_Slice;
+   end Is_VM_By_Copy_Actual;
+
    ----------------------
    -- Nearest_Ancestor --
    ----------------------
index 3903f583fe944f6e461f33111f3c08f460dfa67c..acf37e6450b97eb0bd3d2b93b38bd1d236a11c51 100755 (executable)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -186,6 +186,10 @@ package Sem_Aux is
    --  composite containing a limited component, or a subtype of any of
    --  these types).
 
+   function Is_VM_By_Copy_Actual (N : Node_Id) return Boolean;
+   --  Returns True if we are compiling on VM targets and N is a node that
+   --  requires to be passed by copy in these targets.
+
    function Nearest_Ancestor (Typ : Entity_Id) return Entity_Id;
    --  Given a subtype Typ, this function finds out the nearest ancestor from
    --  which constraints and predicates are inherited. There is no simple link