[multiple changes]

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Generalized_Indexing): In ASIS mode, when
	restoring original node, remove Generalized_Indexing operation
	so that it is recreated during re- analysis.

2015-10-26  Javier Miranda  <miranda@adacore.com>

	* exp_unst.adb: (Unnest_Subprogram):
	Replace absolute references to 1 and 0 by their counterpart
	relative references through Subps_First.

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* par-ch3.adb (P_Declarative_Items): In case of misplaced
	aspect specifications, ensure that flag Done is properly set to
	continue parse.
	* sem_prag.adb, sem_prag.ads: Remove Build_Generic_Class_Condition,
	unused.

From-SVN: r229362

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4f63dfe074ef2d083272ac40ffd73dd5a9fe8224..4806519dd2b221402d78ec602383062ec37abc75 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_res.adb (Resolve_Generalized_Indexing): In ASIS mode, when
+       restoring original node, remove Generalized_Indexing operation
+       so that it is recreated during re- analysis.
+
+2015-10-26  Javier Miranda  <miranda@adacore.com>
+
+       * exp_unst.adb: (Unnest_Subprogram):
+       Replace absolute references to 1 and 0 by their counterpart
+       relative references through Subps_First.
+
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * par-ch3.adb (P_Declarative_Items): In case of misplaced
+       aspect specifications, ensure that flag Done is properly set to
+       continue parse.
+       * sem_prag.adb, sem_prag.ads: Remove Build_Generic_Class_Condition,
+       unused.
+
 2015-10-26  Emmanuel Briot  <briot@adacore.com>
 
        * s-os_lib.adb (Argument_String_To_List): Remove backslashes in

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 99d546fab9e19ee3ea38880a5488419c455c3aa2..93fbf6cf5622948dbac1247589387b5750d40a61 100644 (file)
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -275,9 +275,9 @@ package body Exp_Unst is
 
       --  First step, we must mark all nested subprograms that require a static
       --  link (activation record) because either they contain explicit uplevel
-      --  references (as indicated by ??? being set at this
-      --  point), or they make calls to other subprograms in the same nest that
-      --  require a static link (in which case we set this flag).
+      --  references (as indicated by Is_Uplevel_Referenced_Entity being set at
+      --  this point), or they make calls to other subprograms in the same nest
+      --  that require a static link (in which case we set this flag).
 
       --  This is a recursive definition, and to implement this, we have to
       --  build a call graph for the set of nested subprograms, and then go
@@ -684,7 +684,7 @@ package body Exp_Unst is
          Modified : Boolean;
 
       begin
-         Subps.Table (1).Reachable := True;
+         Subps.Table (Subps_First).Reachable := True;
 
          --  We use a simple minded algorithm as follows (obviously this can
          --  be done more efficiently, using one of the standard algorithms
@@ -822,13 +822,13 @@ package body Exp_Unst is
 
       --  Remove unreachable subprograms from Subps table. Note that we do
       --  this after eliminating entries from the other two tables, since
-      --  thos elimination steps depend on referencing the Subps table.
+      --  those elimination steps depend on referencing the Subps table.
 
       declare
          New_SI : SI_Type;
 
       begin
-         New_SI := 0;
+         New_SI := Subps_First - 1;
          for J in Subps_First .. Subps.Last loop
             declare
                STJ  : Subp_Entry renames Subps.Table (J);

diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 82c33fe6c9feb6e2366f3b158f9c31292867256d..5859bcea05b8ffae1d9a17f2bbf171a4dfb66d3b 100644 (file)
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -4560,6 +4560,11 @@ package body Ch3 is
                Scan; -- past RECORD
                TF_Semicolon;
 
+               --  This might happen because of misplaced aspect specification.
+               --  After discarding the misplaced aspects we can continue the
+               --  scan.
+
+               Done := False;
             else
                Restore_Scan_State (Scan_State); -- to END
                Done := True;

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index cd5f9d03bddfd68c0dd4a1544d94638daf6ef7e3..912d75ecaf7a021449d3c47ad85b6159f6b79f32 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -22932,10 +22932,6 @@ package body Sem_Prag is
          end if;
       end if;
 
-      if Class_Present (N) then
-         Build_Generic_Class_Condition (Spec_Id, N);
-      end if;
-
       Preanalyze_Assert_Expression (Expr, Standard_Boolean);
 
       --  For a class-wide condition, a reference to a controlling formal must
@@ -25727,251 +25723,6 @@ package body Sem_Prag is
       return False;
    end Appears_In;
 
-   -----------------------------------
-   -- Build_Generic_Class_Condition --
-   -----------------------------------
-
-   procedure Build_Generic_Class_Condition
-     (Subp : Entity_Id;
-      Prag : Node_Id)
-   is
-      Expr     : constant Node_Id :=
-                   Get_Pragma_Arg
-                     (First (Pragma_Argument_Associations (Prag)));
-      Loc      : constant Source_Ptr := Sloc (Prag);
-      Map      : constant Elist_Id   := New_Elmt_List;
-      New_Expr : constant Node_Id    := New_Copy_Tree (Expr);
-      New_Pred : constant Entity_Id  :=
-                   Make_Defining_Identifier (Loc,
-                     New_External_Name (Chars (Subp), "Pre", -1));
-      Typ      : constant Entity_Id  := Find_Dispatching_Type (Subp);
-
-      function Replace_Formal (N : Node_Id) return Traverse_Result;
-      --  Replace occurrence of a formal parameter of the original expression
-      --  in the precondition, with the formal of the generic function created
-      --  for it.
-
-      --------------------
-      -- Replace_Formal --
-      --------------------
-
-      function Replace_Formal (N : Node_Id) return Traverse_Result is
-         Loc   : constant Source_Ptr := Sloc (N);
-         El    : Elmt_Id;
-         F     : Entity_Id;
-         New_F : Entity_Id;
-
-      begin
-         if Nkind (N) = N_Identifier
-           and then (Nkind (Parent (N)) /= N_Parameter_Association
-             or else N /= Selector_Name (Parent (N)))
-           and then Present (Entity (N))
-           and then Is_Formal (Entity (N))
-         then
-            El := First_Elmt (Map);
-            while Present (El) loop
-               F := Node (El);
-               if Chars (F) = Chars (N) then
-                  New_F := Node (Next_Elmt (El));
-
-                  --  If this is a controlling formal, in the generic it
-                  --  becomes a conversion to the controlling formal of the
-                  --  operation with the class-wide precondition. If the formal
-                  --  is an access parameter, a reference to F becomes
-                  --  Root (New_F.all)'access.
-
-                  if Is_Controlling_Formal (F) then
-                     if Is_Access_Type (Etype (F)) then
-                        Rewrite (N,
-                          Make_Attribute_Reference (Loc,
-                            Prefix         =>
-                              Unchecked_Convert_To (
-                                Designated_Type (Etype (F)),
-                                  Make_Explicit_Dereference (Loc,
-                                    Prefix => New_Occurrence_Of (New_F, Loc))),
-                            Attribute_Name => Name_Access));
-
-                     else
-                        Rewrite (N,
-                          Unchecked_Convert_To
-                            (Etype (F), New_Occurrence_Of (New_F, Sloc (N))));
-                     end if;
-
-                  --  Noncontrolling formals retain their original type
-
-                  else
-                     Rewrite (N, New_Occurrence_Of (New_F, Sloc (N)));
-                  end if;
-
-                  return OK;
-               end if;
-
-               Next_Elmt (El);
-               Next_Elmt (El);
-            end loop;
-
-         elsif Nkind (N) = N_Parameter_Association then
-            Set_Next_Named_Actual (N, Empty);
-
-         elsif Nkind (N) = N_Function_Call then
-            Set_First_Named_Actual (N, Empty);
-         end if;
-
-         return OK;
-      end Replace_Formal;
-
-      procedure Map_Formals is new Traverse_Proc (Replace_Formal);
-
-      --  Local variables
-
-      Bod      : Node_Id;
-      Decl     : Node_Id;
-      F        : Entity_Id;
-      New_F    : Entity_Id;
-      New_Form : List_Id;
-      New_Typ  : Entity_Id;
-      Par_Typ  : Entity_Id;
-      Root_Typ : Entity_Id;
-      Spec     : Node_Id;
-
-   --  Start of processing for Build_Generic_Class_Pre
-
-   begin
-      --  Nothing to do if previous error or expansion disabled.
-
-      if not Expander_Active then
-         return;
-      end if;
-
-      if Chars (Pragma_Identifier (Prag)) = Name_Postcondition then
-         return;
-      end if;
-
-      --  Build list of controlling formals and their renamings in the new
-      --  generic operation.
-
-      New_Form := New_List;
-      New_Typ  := Empty;
-
-      F := First_Formal (Subp);
-      while Present (F) loop
-         New_F :=
-           Make_Defining_Identifier (Loc, New_External_Name (Chars (F), "GF"));
-         Set_Ekind (New_F, Ekind (F));
-         Append_Elmt (F, Map);
-         Append_Elmt (New_F, Map);
-
-         if Is_Controlling_Formal (F) then
-            Root_Typ := Etype (F);
-
-            if Is_Access_Type (Etype (F)) then
-               Root_Typ := Designated_Type (Root_Typ);
-               New_Typ :=
-                 Make_Defining_Identifier (Loc,
-                   Chars =>
-                     New_External_Name
-                       (Chars (Designated_Type (Etype (F))), "GT"));
-               Par_Typ :=
-                 Make_Access_Definition (Loc,
-                   Subtype_Mark => New_Occurrence_Of (New_Typ, Loc));
-            else
-               New_Typ :=
-                 Make_Defining_Identifier (Loc,
-                   Chars => New_External_Name (Chars (Etype (F)), "GT"));
-               Par_Typ := New_Occurrence_Of (New_Typ, Loc);
-            end if;
-
-            Append_To (New_Form,
-              Make_Parameter_Specification (Loc,
-                Defining_Identifier => New_F,
-                Parameter_Type      => Par_Typ));
-         else
-            --  If formal has a class-wide type, build same attribute for new
-            --  formal.
-
-            if Is_Class_Wide_Type (Etype (F)) then
-               Append_To (New_Form,
-                 Make_Parameter_Specification (Loc,
-                   Defining_Identifier => New_F,
-                   Parameter_Type      =>
-                     Make_Attribute_Reference (Loc,
-                       Prefix         =>
-                         New_Occurrence_Of (Etype (Etype (F)), Loc),
-                       Attribute_Name => Name_Class)));
-            else
-               --  If it is an anonymous access type, create a similar type
-               --  definition.
-
-               if Ekind (Etype (F)) = E_Anonymous_Access_Type then
-                  Par_Typ := New_Copy_Tree (Parameter_Type (Parent (F)));
-               else
-                  Par_Typ := New_Occurrence_Of (Etype (F), Loc);
-               end if;
-
-               Append_To (New_Form,
-                 Make_Parameter_Specification (Loc,
-                   Defining_Identifier => New_F,
-                   Parameter_Type      => Par_Typ));
-            end if;
-         end if;
-
-         Next_Formal (F);
-      end loop;
-
-      --  If no controlling formal found, pre/postcondition is incorrect.
-
-      if No (New_Typ) then
-         return;
-      end if;
-
-      Spec :=
-        Make_Function_Specification (Loc,
-          Defining_Unit_Name       => New_Pred,
-          Parameter_Specifications => New_Form,
-          Result_Definition        =>
-            New_Occurrence_Of (Standard_Boolean, Loc));
-
-      Decl :=
-        Make_Generic_Subprogram_Declaration (Loc,
-          Specification               => Spec,
-          Generic_Formal_Declarations => New_List (
-            Make_Formal_Type_Declaration (Loc,
-              Defining_Identifier    => New_Typ,
-              Formal_Type_Definition =>
-                Make_Formal_Derived_Type_Definition (Loc,
-                  Subtype_Mark    => New_Occurrence_Of (Root_Typ, Loc),
-                  Private_Present => True))));
-
-      Preanalyze (New_Expr);
-      Map_Formals (New_Expr);
-
-      Bod :=
-        Make_Subprogram_Body (Loc,
-          Specification              => New_Copy_Tree (Spec),
-          Declarations               => New_List,
-          Handled_Statement_Sequence =>
-            Make_Handled_Sequence_Of_Statements (Loc,
-              Statements => New_List (
-                Make_Simple_Return_Statement (Loc,
-                  Expression => New_Expr))));
-
-      --  Generic function must be analyzed after type is frozen, and will be
-      --  instantiated when subprogram contract for operation or any of its
-      --  overridings is expanded.
-
-      Append_Freeze_Actions (Typ, New_List (Decl, Bod));
-
-      --  We need to convey the existence of the generic to the point at which
-      --  we expand the contract. We replace the expression in the pragma with
-      --  name of the generic function, to be instantiated when expanding the
-      --  contract for the subprogram or some overriding of it. See
-      --  Exp_ch6.Expand_Subprogram_Contract.Build_Pragma_Check_Equivalent.
-      --  (TBD)
-
-      Set_Ekind (New_Pred, E_Generic_Function);
-      Set_Scope (New_Pred, Current_Scope);
-   end Build_Generic_Class_Condition;
-
    -----------------------------
    -- Check_Applicable_Policy --
    -----------------------------

diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
index 7ec4ebb31e00070abe17f0cd8608dab2b0efeb17..784578a4da0e642ac27a84d062bc35fb8853e8cc 100644 (file)
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -231,17 +231,6 @@ package Sem_Prag is
    procedure Analyze_Test_Case_In_Decl_Part (N : Node_Id);
    --  Perform preanalysis of pragma Test_Case
 
-   procedure Build_Generic_Class_Condition
-     (Subp : Entity_Id;
-      Prag : Node_Id);
-   --  AI12-113 modifies the semantics of classwide pre- and postconditions,
-   --  as well as type invariants, so that the expression used in an inherited
-   --  operation uses the actual type and is statically bound, rather than
-   --  using T'Class and dispatching. This new semantics is implemented by
-   --  building a generic function for the corresponding condition and
-   --  instantiating it for each descendant type. Checking the condition is
-   --  implemented as a call to that instantiation.
-
    procedure Check_Applicable_Policy (N : Node_Id);
    --  N is either an N_Aspect or an N_Pragma node. There are two cases. If
    --  the name of the aspect or pragma is not one of those recognized as

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 3ecc33b9dc7044c2c4b5f5cb48b7fa040809aa17..d2963f73e7cf6edc223b1dc25e2f9ebffc8cee8e 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8110,6 +8110,7 @@ package body Sem_Res is
       end if;
 
       Analyze_Dimension (N);
+
       --  Note: No Eval processing is required for an explicit dereference,
       --  because such a name can never be static.
 
@@ -8166,6 +8167,7 @@ package body Sem_Res is
             Indexes := Parameter_Associations (Call);
             Pref := Remove_Head (Indexes);
             Set_Expressions (N, Indexes);
+            Set_Generalized_Indexing (N, Empty);
             Set_Prefix (N, Pref);
          end if;