@@ -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))
@@ -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))