[multiple changes]

2017-09-18  Bob Duff  <duff@adacore.com>

	* sem_ch4.adb (Analyze_Qualified_Expression): Give an error if the type
	mark refers to the current instance. Set the type to Any_Type in that
	case, to avoid later crashes.

2017-09-18  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Replace_Discriminant_References): New procedure,
	subsidiary of Build_Assignment, used to handle the initialization code
	for a mutable record component whose default value is an aggregate that
	sets the values of the discriminants of the components.

2017-09-18  Ed Schonberg  <schonberg@adacore.com>

	* gnat.dg/default_variants.adb: New testcase.

2017-09-18  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Address>: Mark
	the entity as being volatile for an overlay that toggles the scalar
	storage order.

2017-09-18  Fedor Rybin  <frybin@adacore.com>

	* doc/gnat_ugn/gnat_utility_programs.rst: Document that gnattest
	options -U main and --harness-only are not compatible.

From-SVN: r252913

7 files changed, 143 insertions, 1 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a34f2f2..5dba677 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* sem_ch4.adb (Analyze_Qualified_Expression): Give an error if the type
+	mark refers to the current instance. Set the type to Any_Type in that
+	case, to avoid later crashes.
+
+2017-09-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch3.adb (Replace_Discriminant_References): New procedure,
+	subsidiary of Build_Assignment, used to handle the initialization code
+	for a mutable record component whose default value is an aggregate that
+	sets the values of the discriminants of the components.
+
+2017-09-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause) <Address>: Mark
+	the entity as being volatile for an overlay that toggles the scalar
+	storage order.
+
+2017-09-18  Fedor Rybin  <frybin@adacore.com>
+
+	* doc/gnat_ugn/gnat_utility_programs.rst: Document that gnattest
+	options -U main and --harness-only are not compatible.
+
 2017-09-18  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* freeze.adb, sem_ch6.adb, sem_res.adb: Minor reformatting.
diff --git a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst
index fe2125f..9136350 100644
--- a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst
+++ b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst
@@ -4314,7 +4314,8 @@ Alternatively, you may run the script using the following command line:
 
   :switch:`--harness-only`
     When this option is given, ``gnattest`` creates a harness for all
-    sources, treating them as test packages.
+    sources, treating them as test packages. This option is not compatible with
+    closure computation done by -U main.
 
 
     .. index:: --separate-drivers (gnattest)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 9ed8ea0..0fcf723 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -1782,6 +1782,42 @@ package body Exp_Ch3 is
          Lhs      : Node_Id;
          Res      : List_Id;
 
+         function Replace_Discr_Ref (N : Node_Id) return Traverse_Result;
+         --  Analysis of the aggregate has replaced discriminants by their
+         --  corresponding discriminals, but these are irrelevant when the
+         --  component has a mutable type and is initialized with an aggregate.
+         --  Instead, they must be replaced by the values supplied in the
+         --  aggregate, that will be assigned during the expansion of the
+         --  assignment.
+
+         -----------------------
+         -- Replace_Discr_Ref --
+         -----------------------
+
+         function Replace_Discr_Ref (N : Node_Id) return Traverse_Result is
+            Val : Node_Id;
+         begin
+            if Is_Entity_Name (N)
+              and then Present (Entity (N))
+              and then Is_Formal (Entity (N))
+              and then Present (Discriminal_Link (Entity (N)))
+            then
+               Val :=
+                  Make_Selected_Component (N_Loc,
+                    Prefix => New_Copy_Tree (Lhs),
+                    Selector_Name => New_Occurrence_Of
+                      (Discriminal_Link (Entity (N)), N_Loc));
+               if Present (Val) then
+                  Rewrite (N, New_Copy_Tree (Val));
+               end if;
+            end if;
+
+            return OK;
+         end Replace_Discr_Ref;
+
+         procedure Replace_Discriminant_References is
+           new Traverse_Proc (Replace_Discr_Ref);
+
       begin
          Lhs :=
            Make_Selected_Component (N_Loc,
@@ -1789,6 +1825,22 @@ package body Exp_Ch3 is
              Selector_Name => New_Occurrence_Of (Id, N_Loc));
          Set_Assignment_OK (Lhs);
 
+         if Nkind (Exp) = N_Aggregate
+           and then Has_Discriminants (Typ)
+           and then not Is_Constrained (Base_Type (Typ))
+         then
+            --  The aggregate may provide new values for the discriminants
+            --  of the component, and other components may depend on those
+            --  discriminants. Previous analysis of those expressions have
+            --  replaced the discriminants by the formals of the initialization
+            --  procedure for the type, but these are irrelevant in the
+            --  enclosing initialization procedure: those discriminant
+            --  references must be replaced by the values provided in the
+            --  aggregate.
+
+            Replace_Discriminant_References (Exp);
+         end if;
+
          --  Case of an access attribute applied to the current instance.
          --  Replace the reference to the type by a reference to the actual
          --  object. (Note that this handles the case of the top level of
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 1fc5c15..7a5c85d 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -5084,6 +5084,22 @@ package body Sem_Ch13 is
                         Register_Address_Clause_Check
                           (N, U_Ent, No_Uint, O_Ent, Off);
                      end if;
+
+                     --  If the overlay changes the storage order, mark the
+                     --  entity as being volatile to block any optimization
+                     --  for it since the construct is not really supported
+                     --  by the back end.
+
+                     if (Is_Record_Type (Etype (U_Ent))
+                          or else Is_Array_Type (Etype (U_Ent)))
+                       and then (Is_Record_Type (Etype (O_Ent))
+                                  or else Is_Array_Type (Etype (O_Ent)))
+                       and then Reverse_Storage_Order (Etype (U_Ent))
+                                      /= Reverse_Storage_Order (Etype (O_Ent))
+                     then
+                        Set_Treat_As_Volatile (U_Ent);
+                     end if;
+
                   else
                      --  If this is not an overlay, mark a variable as being
                      --  volatile to prevent unwanted optimizations. It's a
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 4f7016d..01f5f5e 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -3930,6 +3930,23 @@ package body Sem_Ch4 is
       Set_Etype (N, Any_Type);
       Find_Type (Mark);
       T := Entity (Mark);
+
+      if Nkind_In
+        (Enclosing_Declaration (N),
+         N_Formal_Type_Declaration,
+         N_Full_Type_Declaration,
+         N_Incomplete_Type_Declaration,
+         N_Protected_Type_Declaration,
+         N_Private_Extension_Declaration,
+         N_Private_Type_Declaration,
+         N_Subtype_Declaration,
+         N_Task_Type_Declaration)
+        and then T = Defining_Identifier (Enclosing_Declaration (N))
+      then
+         Error_Msg_N ("current instance not allowed", Mark);
+         T := Any_Type;
+      end if;
+
       Set_Etype (N, T);
 
       if T = Any_Type then
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9b1e19a..d7e95dc 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2017-09-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/default_variants.adb: New testcase.
+
 2017-09-18  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 	PR target/81736
diff --git a/gcc/testsuite/gnat.dg/default_variants.adb b/gcc/testsuite/gnat.dg/default_variants.adb
new file mode 100644
index 0000000..2a8257e
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/default_variants.adb
@@ -0,0 +1,28 @@
+--  { dg-do compile }
+
+procedure Default_Variants is
+
+   type Variant_Kind is (A, B);
+
+   function Get_Default_Value (Kind : in Variant_Kind) return Natural is (10);
+
+   type Variant_Type (Kind : Variant_Kind := A) is
+      record
+         Common : Natural := Get_Default_Value (Kind);
+         case Kind is
+            when A =>
+               A_Value : Integer := Integer'First;
+            when B =>
+               B_Value : Natural := Natural'First;
+         end case;
+      end record;
+
+   type Containing_Type is tagged
+      record
+         Variant_Data : Variant_Type :=
+               (Kind => B, Common => <>, B_Value => 1);
+      end record;
+
+begin
+    null;
+end Default_Variants;