[Ada] Fixes for various wrong and missing error messages on ACATS B85100[567]

GNAT was missing errors as well as issuing messages on legal lines in
new ACATS tests for illegal renamings of discriminant-dependent
components. Cases that are fixed include object names involving
qualified expressions, dereference cases, and generic formal access and
formal derived types. Better implements the "known to be constrained"
rules in the Ada RM.

Tested by new ACATS tests B85100[567] that are soon to be released.

2018-12-03  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* sem_aux.adb (Object_Type_Has_Constrained_Partial_View): Return
	True for an untagged discriminated formal derived type when
	referenced within a generic body (augments existing test for
	formal private types).
	* sem_util.adb (Is_Dependent_Component_Of_Mutable_Type): If the
	prefix of the name is a qualified expression, retrieve the
	operand of that. Add a test of whether the (possible)
	dereference prefix is a variable, and also test whether that
	prefix might just be of an access type (occurs in some implicit
	dereference cases) rather than being an explicit dereference.
	Retrieve the Original_Node of the object name's main prefix and
	handle the possibility of that being a qualified expression.
	Remove special-case code for explicit dereferences that don't
	come from source. Add test for the renaming not being within a
	generic body for proper determination of whether a formal access
	type is known to be constrained (it is within a generic spec,
	but not in the body).  Fix an existing incorrect test for
	renaming of a discriminant-dependent component of a untagged
	generic formal type being within a generic body, adding test of
	taggedness and calling In_Generic_Body (now properly checks for
	cases where the renaming is in a nongeneric body nested within a
	generic).  Return False in cases where the selector is not a
	component (or discriminant), which can occur for
	prefixed-notation calls.

From-SVN: r266759

3 files changed, 92 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 15b5bcf..b48c757 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2018-12-03  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_aux.adb (Object_Type_Has_Constrained_Partial_View): Return
+	True for an untagged discriminated formal derived type when
+	referenced within a generic body (augments existing test for
+	formal private types).
+	* sem_util.adb (Is_Dependent_Component_Of_Mutable_Type): If the
+	prefix of the name is a qualified expression, retrieve the
+	operand of that. Add a test of whether the (possible)
+	dereference prefix is a variable, and also test whether that
+	prefix might just be of an access type (occurs in some implicit
+	dereference cases) rather than being an explicit dereference.
+	Retrieve the Original_Node of the object name's main prefix and
+	handle the possibility of that being a qualified expression.
+	Remove special-case code for explicit dereferences that don't
+	come from source. Add test for the renaming not being within a
+	generic body for proper determination of whether a formal access
+	type is known to be constrained (it is within a generic spec,
+	but not in the body).  Fix an existing incorrect test for
+	renaming of a discriminant-dependent component of a untagged
+	generic formal type being within a generic body, adding test of
+	taggedness and calling In_Generic_Body (now properly checks for
+	cases where the renaming is in a nongeneric body nested within a
+	generic).  Return False in cases where the selector is not a
+	component (or discriminant), which can occur for
+	prefixed-notation calls.
+
 2018-12-03  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_res.adb (Apply_Check): For array types, apply a length
diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb
index d82dced..80e82d2 100644
--- a/gcc/ada/sem_aux.adb
+++ b/gcc/ada/sem_aux.adb
@@ -1472,7 +1472,8 @@ package body Sem_Aux is
       return Has_Constrained_Partial_View (Typ)
         or else (In_Generic_Body (Scop)
                   and then Is_Generic_Type (Base_Type (Typ))
-                  and then Is_Private_Type (Base_Type (Typ))
+                  and then (Is_Private_Type (Base_Type (Typ))
+                             or else Is_Derived_Type (Base_Type (Typ)))
                   and then not Is_Tagged_Type (Typ)
                   and then not (Is_Array_Type (Typ)
                                  and then not Is_Constrained (Typ))
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 1d34d2ae..cf13c24 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14123,6 +14123,15 @@ package body Sem_Util is
          Deref := Prefix (Deref);
       end loop;
 
+      --  If the prefix is a qualified expression of a variable, then function
+      --  Is_Variable will return False for that because a qualified expression
+      --  denotes a constant view, so we need to get the name being qualified
+      --  so we can test below whether that's a variable (or a dereference).
+
+      if Nkind (Deref) = N_Qualified_Expression then
+         Deref := Expression (Deref);
+      end if;
+
       --  Ada 2005: If we have a component or slice of a dereference,
       --  something like X.all.Y (2), and the type of X is access-to-constant,
       --  Is_Variable will return False, because it is indeed a constant
@@ -14130,13 +14139,42 @@ package body Sem_Util is
       --  following condition to be True in that case.
 
       if Is_Variable (Object)
+        or else Is_Variable (Deref)
         or else (Ada_Version >= Ada_2005
-                  and then Nkind (Deref) = N_Explicit_Dereference)
+                  and then (Nkind (Deref) = N_Explicit_Dereference
+                             or else Is_Access_Type (Etype (Deref))))
       then
          if Nkind (Object) = N_Selected_Component then
-            P := Prefix (Object);
+
+            --  If the selector is not a component, then we definitely return
+            --  False (it could be a function selector in a prefix form call
+            --  occurring in an iterator specification).
+
+            if not
+              Ekind_In
+                (Entity (Selector_Name (Object)), E_Component, E_Discriminant)
+            then
+               return False;
+            end if;
+
+            --  Get the original node of the prefix in case it has been
+            --  rewritten, which can occur, for example, in qualified
+            --  expression cases. Also, a discriminant check on a selected
+            --  component may be expanded into a dereference when removing
+            --  side effects, and the subtype of the original node may be
+            --  unconstrained.
+
+            P := Original_Node (Prefix (Object));
             Prefix_Type := Etype (P);
 
+            --  If the prefix is a qualified expression, we want to look at
+            --  its operand.
+
+            if Nkind (P) = N_Qualified_Expression then
+               P := Expression (P);
+               Prefix_Type := Etype (P);
+            end if;
+
             if Is_Entity_Name (P) then
                if Ekind (Entity (P)) = E_Generic_In_Out_Parameter then
                   Prefix_Type := Base_Type (Prefix_Type);
@@ -14146,14 +14184,13 @@ package body Sem_Util is
                   P_Aliased := True;
                end if;
 
-            --  A discriminant check on a selected component may be expanded
-            --  into a dereference when removing side effects. Recover the
-            --  original node and its type, which may be unconstrained.
+            --  For explicit dereferences we get the access prefix so we can
+            --  treat this similarly to implicit dereferences and examine the
+            --  kind of the access type and its designated subtype further
+            --  below.
 
-            elsif Nkind (P) = N_Explicit_Dereference
-              and then not (Comes_From_Source (P))
-            then
-               P := Original_Node (P);
+            elsif Nkind (P) = N_Explicit_Dereference then
+               P := Prefix (P);
                Prefix_Type := Etype (P);
 
             else
@@ -14186,12 +14223,23 @@ package body Sem_Util is
 
             else pragma Assert (Ada_Version >= Ada_2005);
                if Is_Access_Type (Prefix_Type) then
+                  --  We need to make sure we have the base subtype, in case
+                  --  this is actually an access subtype (whose Ekind will be
+                  --  E_Access_Subtype).
+
+                  Prefix_Type := Etype (Prefix_Type);
 
                   --  If the access type is pool-specific, and there is no
                   --  constrained partial view of the designated type, then the
-                  --  designated object is known to be constrained.
+                  --  designated object is known to be constrained. If it's a
+                  --  formal access type and the renaming is in the generic
+                  --  spec, we also treat it as pool-specific (known to be
+                  --  constrained), but assume the worst if in the generic body
+                  --  (see RM 3.3(23.3/3)).
 
                   if Ekind (Prefix_Type) = E_Access_Type
+                    and then (not Is_Generic_Type (Prefix_Type)
+                               or else not In_Generic_Body (Current_Scope))
                     and then not Object_Type_Has_Constrained_Partial_View
                                    (Typ  => Designated_Type (Prefix_Type),
                                     Scop => Current_Scope)
@@ -14212,16 +14260,17 @@ package body Sem_Util is
               Original_Record_Component (Entity (Selector_Name (Object)));
 
             --  As per AI-0017, the renaming is illegal in a generic body, even
-            --  if the subtype is indefinite.
+            --  if the subtype is indefinite (only applies to prefixes of an
+            --  untagged formal type, see RM 3.3 (23.11/3)).
 
             --  Ada 2005 (AI-363): In Ada 2005 an aliased object can be mutable
 
             if not Is_Constrained (Prefix_Type)
               and then (Is_Definite_Subtype (Prefix_Type)
                          or else
-                           (Is_Generic_Type (Prefix_Type)
-                             and then Ekind (Current_Scope) = E_Generic_Package
-                             and then In_Package_Body (Current_Scope)))
+                           (not Is_Tagged_Type (Prefix_Type)
+                             and then Is_Generic_Type (Prefix_Type)
+                             and then In_Generic_Body (Current_Scope)))
 
               and then (Is_Declared_Within_Variant (Comp)
                          or else Has_Discriminant_Dependent_Constraint (Comp))