From: Eric Botcazou <[email protected]>
This just generalizes a trick already used for discriminant checks.
gcc/ada/ChangeLog:
* doc/gnat_rm/implementation_defined_attributes.rst (Valid_Scalars):
Remove reference to private tagged types.
* exp_attr.adb (Expand_N_Attribute_Reference) <Valid_Scalars>: Do
not bail out for private tagged types.
* sem_attr.adb (Analyze_Attribute) <Valid_Scalars>: Do not warn for
for private tagged types.
* sem_ch3.adb (Is_Visible_Component): Accept any component reference
whose prefix is a type conversion that does not come from source.
* gnat_rm.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
.../implementation_defined_attributes.rst | 4 ++--
gcc/ada/exp_attr.adb | 17 +-------------
gcc/ada/gnat_rm.texi | 4 ++--
gcc/ada/sem_attr.adb | 22 +------------------
gcc/ada/sem_ch3.adb | 21 +++++++++++-------
5 files changed, 19 insertions(+), 49 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
index ce568c48f6e..75ecfb7ea86 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
@@ -1687,8 +1687,8 @@ Attribute Valid_Scalars
The ``'Valid_Scalars`` attribute is intended to make it easier to check the
validity of scalar subcomponents of composite objects. The attribute is defined
for any prefix ``P`` which denotes an object. Prefix ``P`` can be any type
-except for tagged private or ``Unchecked_Union`` types. The value of the
-attribute is of type ``Boolean``.
+except for ``Unchecked_Union`` types. The value of the attribute is of type
+``Boolean``.
``P'Valid_Scalars`` yields ``True`` if and only if the evaluation of
``C'Valid`` yields ``True`` for every scalar subcomponent ``C`` of ``P``, or if
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 8021a591c67..32b8297cd58 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -8636,25 +8636,10 @@ package body Exp_Attr is
Expr := Empty;
- -- Attribute 'Valid_Scalars is not supported on private tagged types;
- -- see a detailed explanation where this attribute is analyzed.
-
- if Is_Private_Type (Ptyp)
- and then (Is_Tagged_Type (Ptyp)
- or else (Present (Full_View (Ptyp))
- and then Is_Tagged_Type (Full_View (Ptyp))))
- then
- null;
-
- elsif Is_Class_Wide_Type (Ptyp)
- and then Is_Private_Type (Root_Type (Ptyp))
- then
- null;
-
-- Attribute 'Valid_Scalars evaluates to True when the type lacks
-- scalars.
- elsif not Scalar_Part_Present (Val_Typ) then
+ if not Scalar_Part_Present (Val_Typ) then
null;
-- Attribute 'Valid_Scalars is the same as attribute 'Valid when the
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index da0fa654e7d..bfaa204114f 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -12768,8 +12768,8 @@ returns True if and only if @code{T'Value (S)} would
not raise Constraint_Error.
The @code{'Valid_Scalars} attribute is intended to make it easier to check the
validity of scalar subcomponents of composite objects. The attribute is defined
for any prefix @code{P} which denotes an object. Prefix @code{P} can be any
type
-except for tagged private or @code{Unchecked_Union} types. The value of the
-attribute is of type @code{Boolean}.
+except for @code{Unchecked_Union} types. The value of the attribute is of type
+@code{Boolean}.
@code{P'Valid_Scalars} yields @code{True} if and only if the evaluation of
@code{C'Valid} yields @code{True} for every scalar subcomponent @code{C} of
@code{P}, or if
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 74ad6dac29b..d40ee73ade3 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7981,27 +7981,7 @@ package body Sem_Attr is
or else (Is_Class_Wide_Type (P_Type)
and then Is_Private_Type (Root_Type (P_Type)))
then
- -- Attribute 'Valid_Scalars is not supported on private tagged
- -- types due to a code generation issue. Is_Visible_Component
- -- does not allow for a component of a private tagged type to
- -- be successfully retrieved.
- -- ??? This attribute should simply ignore type privacy
- -- (see Validated_View). It should examine components of the
- -- tagged type extensions (if any) and recursively examine
- -- 'Valid_Scalars of the parent's type (if any).
-
- -- Do not use Error_Attr_P because this bypasses any subsequent
- -- processing and leaves the attribute with type Any_Type. This
- -- in turn prevents the proper expansion of the attribute into
- -- True.
-
- if Is_Tagged_Type (P_Type)
- or else (Present (Full_View (P_Type))
- and then Is_Tagged_Type (Full_View (P_Type)))
- then
- Error_Msg_Name_1 := Aname;
- Error_Msg_N ("??effects of attribute % are ignored", N);
- end if;
+ null;
-- Otherwise the type is not private
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f8aeb9410f0..d54a13b39c2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -20303,17 +20303,22 @@ package body Sem_Ch3 is
elsif not Comes_From_Source (Original_Comp) then
return True;
+ -- If the component reference is inserted for a discriminant check or
+ -- a validity check on a full view, then it is also visible.
+
+ elsif Present (N)
+ and then Nkind (N) = N_Selected_Component
+ and then
+ Nkind (Prefix (N)) in N_Type_Conversion | N_Unchecked_Type_Conversion
+ and then not Comes_From_Source (Prefix (N))
+ then
+ return True;
+
-- Discriminants are visible unless the (private) type has unknown
- -- discriminants. If the discriminant reference is inserted for a
- -- discriminant check on a full view it is also visible.
+ -- discriminants.
elsif Ekind (Original_Comp) = E_Discriminant
- and then
- (not Has_Unknown_Discriminants (Original_Typ)
- or else (Present (N)
- and then Nkind (N) = N_Selected_Component
- and then Nkind (Prefix (N)) = N_Type_Conversion
- and then not Comes_From_Source (Prefix (N))))
+ and then not Has_Unknown_Discriminants (Original_Typ)
then
return True;
--
2.53.0
