[multiple changes]

2017-09-08  Yannick Moy  <moy@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Issue more precise error messages on
	Loop_Variant.

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

	* exp_attr.adb (Build_Record_VS_Func): If the record is an
	unchecked union, do not emit checks for its (non-existent)
	discriminants, or for variant parts that depend on them.

2017-09-08  Justin Squirek  <squirek@adacore.com>

	* sem_ch4.adb (Find_Equality_Types.Try_One_Interp,
	Find_Comparison_Type.Try_One_Interp): Add check for generic
	instances.

From-SVN: r251878

4 files changed, 77 insertions, 7 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ce59b4..97a59e4 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2017-09-08  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Issue more precise error messages on
+	Loop_Variant.
+
+2017-09-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_attr.adb (Build_Record_VS_Func): If the record is an
+	unchecked union, do not emit checks for its (non-existent)
+	discriminants, or for variant parts that depend on them.
+
+2017-09-08  Justin Squirek  <squirek@adacore.com>
+
+	* sem_ch4.adb (Find_Equality_Types.Try_One_Interp,
+	Find_Comparison_Type.Try_One_Interp): Add check for generic
+	instances.
+
 2017-09-08  Arnaud Charlet  <charlet@adacore.com>
 
 	* sem_ch3.adb, layout.adb, layout.ads, exp_attr.adb, debug.adb,
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 76b99e8..ebd55d8 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -423,6 +423,10 @@ package body Exp_Attr is
    --       return True;
    --    end _Valid_Scalars;
 
+   --  If the record type is an unchecked union, we can only check components
+   --  in the invariant part, given that there are no discriminant values to
+   --  select a variant.
+
    function Build_Record_VS_Func
      (R_Type : Entity_Id;
       Nod    : Node_Id) return Entity_Id
@@ -475,7 +479,9 @@ package body Exp_Attr is
       begin
          Append_To (Result, Make_VS_If (E, Component_Items (CL)));
 
-         if No (Variant_Part (CL)) then
+         if No (Variant_Part (CL))
+           or else Is_Unchecked_Union (R_Type)
+         then
             return Result;
          end if;
 
@@ -564,6 +570,11 @@ package body Exp_Attr is
                elsif Field_Name = Name_uTag then
                   null;
 
+               elsif Ekind (Def_Id) = E_Discriminant
+                 and then Is_Unchecked_Union (R_Type)
+               then
+                  null;
+
                --  Don't bother with component with no scalar components
 
                elsif not Scalar_Part_Present (Etype (Def_Id)) then
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index b02d72bc..7cdf9e8 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6287,10 +6287,16 @@ package body Sem_Ch4 is
 
          --  If the operator is an expanded name, then the type of the operand
          --  must be defined in the corresponding scope. If the type is
-         --  universal, the context will impose the correct type.
+         --  universal, the context will impose the correct type. Note that we
+         --  also avoid returning if we are currently within a generic instance
+         --  due to the fact that the generic package declaration has already
+         --  been successfully analyzed and Defined_In_Scope expects the base
+         --  type to be defined within the instance which will never be the
+         --  case.
 
          if Present (Scop)
            and then not Defined_In_Scope (T1, Scop)
+           and then not In_Instance
            and then T1 /= Universal_Integer
            and then T1 /= Universal_Real
            and then T1 /= Any_String
@@ -6311,7 +6317,6 @@ package body Sem_Ch4 is
                else
                   T_F := It.Typ;
                end if;
-
             else
                Found := True;
                T_F   := T1;
@@ -6320,7 +6325,6 @@ package body Sem_Ch4 is
 
             Set_Etype (L, T_F);
             Find_Non_Universal_Interpretations (N, R, Op_Id, T1);
-
          end if;
       end Try_One_Interp;
 
@@ -6472,7 +6476,15 @@ package body Sem_Ch4 is
          --  is declared in Standard, and preference rules apply to it.
 
          if Present (Scop) then
+
+            --  Note that we avoid returning if we are currently within a
+            --  generic instance due to the fact that the generic package
+            --  declaration has already been successfully analyzed and
+            --  Defined_In_Scope expects the base type to be defined within the
+            --  instance which will never be the case.
+
             if Defined_In_Scope (T1, Scop)
+              or else In_Instance
               or else T1 = Universal_Integer
               or else T1 = Universal_Real
               or else T1 = Any_Access
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 4d1e2b0..373fcda 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -17916,10 +17916,40 @@ package body Sem_Prag is
 
             Variant := First (Pragma_Argument_Associations (N));
             while Present (Variant) loop
-               if not Nam_In (Chars (Variant), Name_Decreases,
-                                               Name_Increases)
+               if Chars (Variant) = No_Name then
+                  Error_Pragma_Arg ("expect name `Increases`", Variant);
+
+               elsif not Nam_In (Chars (Variant), Name_Decreases,
+                                                  Name_Increases)
                then
-                  Error_Pragma_Arg ("wrong change modifier", Variant);
+                  declare
+                     Name : constant String :=
+                       Get_Name_String (Chars (Variant));
+                  begin
+                     --  It is a common mistake to write "Increasing" for
+                     --  "Increases" or "Decreasing" for "Decreases". Recognize
+                     --  specially names starting with "Incr" or "Decr" to
+                     --  suggest the corresponding name.
+
+                     if Name'Length >= 4
+                       and then (Name (1 .. 4) = "Incr"
+                                   or else Name (1 .. 4) = "incr")
+                     then
+                        Error_Pragma_Arg_Ident
+                          ("expect name `Increases`", Variant);
+
+                     elsif Name'Length >= 4
+                       and then (Name (1 .. 4) = "Decr"
+                                   or else Name (1 .. 4) = "decr")
+                     then
+                        Error_Pragma_Arg_Ident
+                          ("expect name `Decreases`", Variant);
+
+                     else
+                        Error_Pragma_Arg_Ident
+                          ("expect name `Increases` or `Decreases`", Variant);
+                     end if;
+                  end;
                end if;
 
                Preanalyze_Assert_Expression