https://gcc.gnu.org/g:ed34ee07843e07932411ecf2d0582faa96b57380

commit r16-1149-ged34ee07843e07932411ecf2d0582faa96b57380
Author: Viljar Indus <in...@adacore.com>
Date:   Mon Jan 20 15:10:22 2025 +0200

    ada: Reject Valid_Value arguments originating from Standard
    
    The constraint for Valid_Value not applying to types from Standard
    should also apply to all types derived from those types.
    
    gcc/ada/ChangeLog:
    
            * doc/gnat_rm/implementation_defined_attributes.rst: Update the
            documentation for Valid_Value.
            * sem_attr.adb (Analyze_Attribute): Reject types where
            the root type originates from Standard.
            * gnat_rm.texi: Regenerate.
            * gnat_ugn.texi: Regenerate.

Diff:
---
 gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst | 6 +++---
 gcc/ada/gnat_rm.texi                                      | 6 +++---
 gcc/ada/gnat_ugn.texi                                     | 2 +-
 gcc/ada/sem_attr.adb                                      | 5 +++--
 4 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst 
b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
index f0518106853f..86d2a815e1e0 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst
@@ -1629,9 +1629,9 @@ Attribute Valid_Value
 .. index:: Valid_Value
 
 The ``'Valid_Value`` attribute is defined for enumeration types other than
-those in package Standard. This attribute is a function that takes
-a String, and returns Boolean. ``T'Valid_Value (S)`` returns True
-if and only if ``T'Value (S)`` would not raise Constraint_Error.
+those in package Standard or types derived from those types. This attribute is
+a function that takes a String, and returns Boolean. ``T'Valid_Value (S)``
+returns True if and only if ``T'Value (S)`` would not raise Constraint_Error.
 
 Attribute Valid_Scalars
 =======================
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 00236ee6c5ca..5719d0d3e62d 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -12360,9 +12360,9 @@ which changes element (1,2) to 20 and (3,4) to 30.
 @geindex Valid_Value
 
 The @code{'Valid_Value} attribute is defined for enumeration types other than
-those in package Standard. This attribute is a function that takes
-a String, and returns Boolean. @code{T'Valid_Value (S)} returns True
-if and only if @code{T'Value (S)} would not raise Constraint_Error.
+those in package Standard or types derived from those types. This attribute is
+a function that takes a String, and returns Boolean. @code{T'Valid_Value (S)}
+returns True if and only if @code{T'Value (S)} would not raise 
Constraint_Error.
 
 @node Attribute Valid_Scalars,Attribute VADS_Size,Attribute 
Valid_Value,Implementation Defined Attributes
 @anchor{gnat_rm/implementation_defined_attributes 
attribute-valid-scalars}@anchor{1c5}
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index ca1d7bcc1abf..5331a318c0d8 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -29833,8 +29833,8 @@ to permit their use in free software.
 
 @printindex ge
 
-@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{   
                           }
 @anchor{d2}@w{                              }
+@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{   
                           }
 
 @c %**end of body
 @bye
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index af08fdb2e33f..08da29a21984 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7511,13 +7511,14 @@ package body Sem_Attr is
          Set_Etype (N, Standard_Boolean);
          Validate_Non_Static_Attribute_Function_Call;
 
-         if P_Type in Standard_Boolean
+         if Root_Type (P_Type) in Standard_Boolean
                     | Standard_Character
                     | Standard_Wide_Character
                     | Standard_Wide_Wide_Character
          then
             Error_Attr_P
-              ("prefix of % attribute must not be a type in Standard");
+              ("prefix of % attribute must not be a type originating from " &
+               "Standard");
          end if;
 
          if Discard_Names (First_Subtype (P_Type)) then

Reply via email to