2012-03-30 Hristian Kirtchev <kirtchev@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 30 Mar 2012 09:29:15 +0000 (09:29 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 30 Mar 2012 09:29:15 +0000 (09:29 +0000)
* exp_util.adb (Is_Secondary_Stack_BIP_Func_Call): Handle a case where
a build-in-place call appears as Prefix'Reference'Reference.

2012-03-30  Yannick Moy  <moy@adacore.com>

* lib-xref-alfa.adb: Minor refactoring to remove internal package.

2012-03-30  Hristian Kirtchev  <kirtchev@adacore.com>

* sem_ch5.adb (Analyze_Iteration_Scheme): Preanalyze the subtype
definition of a loop when the context is a quantified expression.

2012-03-30  Vincent Celier  <celier@adacore.com>

* prj.ads: Minor comment update.

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

gcc/ada/ChangeLog
gcc/ada/exp_util.adb
gcc/ada/lib-xref-alfa.adb
gcc/ada/prj.ads
gcc/ada/sem_ch5.adb

index 9c0d479..d3fb75a 100644 (file)
@@ -1,3 +1,21 @@
+2012-03-30  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_util.adb (Is_Secondary_Stack_BIP_Func_Call): Handle a case where
+       a build-in-place call appears as Prefix'Reference'Reference.
+
+2012-03-30  Yannick Moy  <moy@adacore.com>
+
+       * lib-xref-alfa.adb: Minor refactoring to remove internal package.
+
+2012-03-30  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_ch5.adb (Analyze_Iteration_Scheme): Preanalyze the subtype
+       definition of a loop when the context is a quantified expression.
+
+2012-03-30  Vincent Celier  <celier@adacore.com>
+
+       * prj.ads: Minor comment update.
+
 2012-03-30  Yannick Moy  <moy@adacore.com>
 
        * lib-xref-alfa.adb, alloc.ads, lib-xref.ads: Minor addition of
index f78442c..335ba10 100644 (file)
@@ -4889,11 +4889,13 @@ package body Exp_Util is
       Call : Node_Id := Expr;
 
    begin
-      --  Build-in-place calls usually appear in 'reference format
+      --  Build-in-place calls usually appear in 'reference format. Note that
+      --  the accessibility check machinery may add an extra 'reference due to
+      --  side effect removal.
 
-      if Nkind (Call) = N_Reference then
+      while Nkind (Call) = N_Reference loop
          Call := Prefix (Call);
-      end if;
+      end loop;
 
       if Nkind_In (Call, N_Qualified_Expression,
                          N_Unchecked_Type_Conversion)
index e3ef7b0..7ccacbb 100644 (file)
@@ -336,58 +336,31 @@ package body Alfa is
 
       package Sorting is new GNAT.Heap_Sort_G (Move, Lt);
 
-      --  Internal package to build a correspondance between entities and scope
+      function Get_Scope_Num (N : Entity_Id) return Nat;
+      --  Return the scope number associated to entity N
+
+      procedure Set_Scope_Num (N : Entity_Id; Num : Nat);
+      --  Associate entity N to scope number Num
+
+      No_Scope : constant Nat := 0;
+      --  Initial scope counter
+
+      type Scope_Rec is record
+         Num    : Nat;
+         Entity : Entity_Id;
+      end record;
+      --  Type used to relate an entity and a scope number
+
+      package Scopes is new GNAT.HTable.Simple_HTable
+        (Header_Num => Entity_Hashed_Range,
+         Element    => Scope_Rec,
+         No_Element => (Num => No_Scope, Entity => Empty),
+         Key        => Entity_Id,
+         Hash       => Entity_Hash,
+         Equal      => "=");
+      --  Package used to build a correspondance between entities and scope
       --  numbers used in Alfa cross references.
 
-      package Scopes is
-         No_Scope : constant Nat := 0;
-
-         function Get_Scope_Num (N : Entity_Id) return Nat;
-         --  Return the scope number associated to entity N
-
-         procedure Set_Scope_Num (N : Entity_Id; Num : Nat);
-         --  Associate entity N to scope number Num
-      end Scopes;
-
-      ------------
-      -- Scopes --
-      ------------
-
-      package body Scopes is
-         type Scope is record
-            Num    : Nat;
-            Entity : Entity_Id;
-         end record;
-
-         package Scopes is new GNAT.HTable.Simple_HTable
-           (Header_Num => Entity_Hashed_Range,
-            Element    => Scope,
-            No_Element => (Num => No_Scope, Entity => Empty),
-            Key        => Entity_Id,
-            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));
-         end Set_Scope_Num;
-      end Scopes;
-
-      use Scopes;
-
       Nrefs : Nat := Xrefs.Last;
       --  Number of references in table. This value may get reset (reduced)
       --  when we eliminate duplicate reference entries as well as references
@@ -426,6 +399,15 @@ package body Alfa is
          end case;
       end Get_Entity_Type;
 
+      -------------------
+      -- Get_Scope_Num --
+      -------------------
+
+      function Get_Scope_Num (N : Entity_Id) return Nat is
+      begin
+         return Scopes.Get (N).Num;
+      end Get_Scope_Num;
+
       -----------------------
       -- Is_Alfa_Reference --
       -----------------------
@@ -638,6 +620,15 @@ package body Alfa is
          Rnums (Nat (To)) := Rnums (Nat (From));
       end Move;
 
+      -------------------
+      -- Set_Scope_Num --
+      -------------------
+
+      procedure Set_Scope_Num (N : Entity_Id; Num : Nat) is
+      begin
+         Scopes.Set (K => N, E => Scope_Rec'(Num => Num, Entity => N));
+      end Set_Scope_Num;
+
       ------------------------
       -- Update_Scope_Range --
       ------------------------
index 867bf35..a95ac73 100644 (file)
@@ -298,9 +298,26 @@ package Prj is
    --  Type for the kind of language. All languages are file based, except Ada
    --  which is unit based.
 
-   type Dependency_File_Kind is (None, Makefile, ALI_File, ALI_Closure);
-   --  Type of dependency to be checked: no dependency file, Makefile fragment
-   --  or ALI file (for Ada). Please comment ALI_Closure ???
+   --  Type of dependency to be checked
+
+   type Dependency_File_Kind is
+     (None,
+      --  There is no dependency file, the source must always be recompiled
+
+      Makefile,
+      --  The dependency file is a Makefile fragment indicating all the files
+      --  the source depends on. If the object file or the dependency file is
+      --  more recent than any of these files, the source must be recompiled.
+
+      ALI_File,
+      --  The dependency file is an ALI file and the source must be recompiled
+      --  if the object or ALI file is more recent than any of the sources
+      --  listed in the D lines.
+
+      ALI_Closure);
+      --  The dependency file is an ALI file and the source must be recompiled
+      --  if the object or ALI file is more recent than any source in the full
+      --  closure.
 
    Makefile_Dependency_Suffix : constant String := ".d";
    ALI_Dependency_Suffix      : constant String := ".ali";
@@ -472,6 +489,11 @@ package Prj is
       --  are used to specify the object file. The object file name is appended
       --  to the last switch in the list. Example: ("-o", "").
 
+      Object_Path_Switches : Name_List_Index := No_Name_List;
+      --  List of switches to specify to the compiler the path name of a
+      --  temporary file containing the list of object directories in the
+      --  correct order.
+
       Compilation_PIC_Option : Name_List_Index := No_Name_List;
       --  The option(s) to compile a source in Position Independent Code for
       --  shared libraries. Specified in the configuration. When not specified,
@@ -602,6 +624,7 @@ package Prj is
                            Source_File_Switches         => No_Name_List,
                            Object_File_Suffix           => No_Name,
                            Object_File_Switches         => No_Name_List,
+                           Object_Path_Switches         => No_Name_List,
                            Compilation_PIC_Option       => No_Name_List,
                            Object_Generated             => True,
                            Objects_Linked               => True,
@@ -1233,6 +1256,10 @@ package Prj is
       --  The path name of the exec directory of this project file. Default is
       --  equal to Object_Directory.
 
+      Object_Path_File : Path_Name_Type := No_Path;
+      --  Store the name of the temporary file that contains the list of object
+      --  directories, when attribute Object_Path_Switches is declared.
+
       -------------
       -- Library --
       -------------
index 834d2f1..7155ba9 100644 (file)
@@ -1972,11 +1972,14 @@ package body Sem_Ch5 is
                      N);
                end if;
 
-               --  Now analyze the subtype definition. If it is a range, create
-               --  temporaries for bounds.
+               --  Analyze the subtype definition and create temporaries for
+               --  the bounds. Do not evaluate the range when preanalyzing a
+               --  quantified expression because bounds expressed as function
+               --  calls with side effects will be erroneously replicated.
 
                if Nkind (DS) = N_Range
                  and then Expander_Active
+                 and then Nkind (Parent (N)) /= N_Quantified_Expression
                then
                   Process_Bounds (DS);