diff options
Diffstat (limited to 'gcc/ada/sem_attr.adb')
| -rw-r--r-- | gcc/ada/sem_attr.adb | 430 |
1 files changed, 250 insertions, 180 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index e4537e4..d1a91d8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -25,61 +25,65 @@ with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; -with Aspects; use Aspects; -with Atree; use Atree; -with Casing; use Casing; -with Checks; use Checks; -with Debug; use Debug; -with Einfo; use Einfo; -with Elists; use Elists; -with Errout; use Errout; +with Aspects; use Aspects; +with Atree; use Atree; +with Casing; use Casing; +with Checks; use Checks; +with Debug; use Debug; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; +with Elists; use Elists; +with Errout; use Errout; with Eval_Fat; -with Exp_Dist; use Exp_Dist; -with Exp_Util; use Exp_Util; -with Expander; use Expander; -with Freeze; use Freeze; -with Gnatvsn; use Gnatvsn; -with Itypes; use Itypes; -with Lib; use Lib; -with Lib.Xref; use Lib.Xref; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Opt; use Opt; -with Restrict; use Restrict; -with Rident; use Rident; -with Rtsfind; use Rtsfind; +with Exp_Dist; use Exp_Dist; +with Exp_Util; use Exp_Util; +with Expander; use Expander; +with Freeze; use Freeze; +with Gnatvsn; use Gnatvsn; +with Itypes; use Itypes; +with Lib; use Lib; +with Lib.Xref; use Lib.Xref; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Opt; use Opt; +with Restrict; use Restrict; +with Rident; use Rident; +with Rtsfind; use Rtsfind; with Sdefault; -with Sem; use Sem; -with Sem_Aux; use Sem_Aux; -with Sem_Cat; use Sem_Cat; -with Sem_Ch6; use Sem_Ch6; -with Sem_Ch8; use Sem_Ch8; -with Sem_Ch10; use Sem_Ch10; -with Sem_Dim; use Sem_Dim; -with Sem_Dist; use Sem_Dist; -with Sem_Elab; use Sem_Elab; -with Sem_Elim; use Sem_Elim; -with Sem_Eval; use Sem_Eval; -with Sem_Prag; use Sem_Prag; -with Sem_Res; use Sem_Res; -with Sem_Type; use Sem_Type; -with Sem_Util; use Sem_Util; +with Sem; use Sem; +with Sem_Aux; use Sem_Aux; +with Sem_Cat; use Sem_Cat; +with Sem_Ch6; use Sem_Ch6; +with Sem_Ch8; use Sem_Ch8; +with Sem_Ch10; use Sem_Ch10; +with Sem_Dim; use Sem_Dim; +with Sem_Dist; use Sem_Dist; +with Sem_Elab; use Sem_Elab; +with Sem_Elim; use Sem_Elim; +with Sem_Eval; use Sem_Eval; +with Sem_Prag; use Sem_Prag; +with Sem_Res; use Sem_Res; +with Sem_Type; use Sem_Type; +with Sem_Util; use Sem_Util; with Sem_Warn; -with Stand; use Stand; -with Sinfo; use Sinfo; -with Sinput; use Sinput; +with Stand; use Stand; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; +with Sinput; use Sinput; with System; -with Stringt; use Stringt; +with Stringt; use Stringt; with Style; -with Stylesw; use Stylesw; -with Targparm; use Targparm; -with Ttypes; use Ttypes; -with Tbuild; use Tbuild; -with Uintp; use Uintp; -with Uname; use Uname; -with Urealp; use Urealp; +with Stylesw; use Stylesw; +with Targparm; use Targparm; +with Ttypes; use Ttypes; +with Tbuild; use Tbuild; +with Uintp; use Uintp; +with Uname; use Uname; +with Urealp; use Urealp; -with System.CRC32; use System.CRC32; +with System.CRC32; use System.CRC32; package body Sem_Attr is @@ -164,11 +168,11 @@ package body Sem_Attr is Attribute_Max_Alignment_For_Allocation => True, others => False); - -- The following array is the list of attributes defined in the Ada 2020 + -- The following array is the list of attributes defined in the Ada 2022 -- RM which are not defined in Ada 2012. These are recognized in Ada -- 95/2005/2012 modes, but are considered to be implementation defined. - Attribute_20 : constant Attribute_Class_Array := Attribute_Class_Array'( + Attribute_22 : constant Attribute_Class_Array := Attribute_Class_Array'( Attribute_Enum_Rep | Attribute_Enum_Val => True, others => False); @@ -318,14 +322,21 @@ package body Sem_Attr is procedure Check_E2; -- Check that two attribute arguments are present - procedure Check_Enum_Image; - -- If the prefix type of 'Image is an enumeration type, set all its - -- literals as referenced, since the image function could possibly end - -- up referencing any of the literals indirectly. Same for Enum_Val. - -- Set the flag only if the reference is in the main code unit. Same - -- restriction when resolving 'Value; otherwise an improperly set - -- reference when analyzing an inlined body will lose a proper - -- warning on a useless with_clause. + procedure Check_Enum_Image (Check_Enumeration_Maps : Boolean := False); + -- Common processing for the Image and Value family of attributes, + -- including their Wide and Wide_Wide versions, Enum_Val, Img, + -- and Valid_Value. + -- + -- If the prefix type of an attribute is an enumeration type, set all + -- its literals as referenced, since the attribute function can + -- indirectly reference any of the literals. Set the referenced flag + -- only if the attribute is in the main code unit; otherwise an + -- improperly set reference when analyzing an inlined body will lose a + -- proper warning on a useless with_clause. + -- + -- If Check_Enumeration_Maps is True, then the attribute expansion + -- requires enumeration maps, so check whether restriction + -- No_Enumeration_Maps is active. procedure Check_First_Last_Valid; -- Perform all checks for First_Valid and Last_Valid attributes @@ -378,6 +389,9 @@ package body Sem_Attr is procedure Check_Real_Type; -- Verify that prefix of attribute N is fixed or float type + procedure Check_Enumeration_Type; + -- Verify that prefix of attribute N is an enumeration type + procedure Check_Scalar_Type; -- Verify that prefix of attribute N is a scalar type @@ -834,10 +848,13 @@ package body Sem_Attr is begin -- Access and Unchecked_Access are illegal in declare_expressions, - -- according to the RM. We also make the GNAT-specific - -- Unrestricted_Access attribute illegal. + -- according to the RM. We also make the GNAT Unrestricted_Access + -- attribute illegal if it comes from source. - if In_Declare_Expr > 0 then + if In_Declare_Expr > 0 + and then (Attr_Id /= Attribute_Unrestricted_Access + or else Comes_From_Source (N)) + then Error_Attr ("% attribute cannot occur in a declare_expression", N); end if; @@ -905,9 +922,9 @@ package body Sem_Attr is -- a tagged type cleans constant indications from its scope). elsif Nkind (Parent (N)) = N_Unchecked_Type_Conversion - and then (Etype (Parent (N)) = RTE (RE_Prim_Ptr) + and then (Is_RTE (Etype (Parent (N)), RE_Prim_Ptr) or else - Etype (Parent (N)) = RTE (RE_Size_Ptr)) + Is_RTE (Etype (Parent (N)), RE_Size_Ptr)) and then Is_Dispatching_Operation (Directly_Designated_Type (Etype (N))) then @@ -1464,12 +1481,20 @@ package body Sem_Attr is -- Check that Image_Type is legal as the type of a prefix of 'Image. -- Legality depends on the Ada language version. + ---------------------- + -- Check_Image_Type -- + ---------------------- + procedure Check_Image_Type (Image_Type : Entity_Id) is begin - if Ada_Version < Ada_2020 + -- Image_Type may be empty in case of another error detected, + -- or if an N_Raise_xxx_Error node is a parent of N. + + if Ada_Version < Ada_2022 + and then Present (Image_Type) and then not Is_Scalar_Type (Image_Type) then - Error_Msg_Ada_2020_Feature ("nonscalar ''Image", Sloc (P)); + Error_Msg_Ada_2022_Feature ("nonscalar ''Image", Sloc (P)); Error_Attr; end if; end Check_Image_Type; @@ -1486,7 +1511,7 @@ package body Sem_Attr is Set_Etype (N, Str_Typ); Check_Image_Type (Etype (P)); - if Attr_Id /= Attribute_Img and then Ada_Version < Ada_2012 then + if Attr_Id /= Attribute_Img then Error_Msg_Ada_2012_Feature ("|Object''Image", Sloc (P)); end if; else @@ -1516,7 +1541,7 @@ package body Sem_Attr is Validate_Non_Static_Attribute_Function_Call; end if; - Check_Enum_Image; + Check_Enum_Image (Check_Enumeration_Maps => True); -- Check restriction No_Fixed_IO. Note the check of Comes_From_Source -- to avoid giving a duplicate message for when Image attributes @@ -1582,7 +1607,6 @@ package body Sem_Attr is -- Local variables - Dims : Int; Index : Entity_Id; -- Start of processing for Check_Array_Or_Scalar_Type @@ -1646,14 +1670,16 @@ package body Sem_Attr is Set_Etype (N, Base_Type (Etype (Index))); else - Dims := UI_To_Int (Intval (E1)); - - for J in 1 .. Dims - 1 loop - Next_Index (Index); - end loop; + declare + Udims : constant Uint := Expr_Value (E1); + Dims : constant Int := UI_To_Int (Udims); + begin + for J in 1 .. Dims - 1 loop + Next_Index (Index); + end loop; + end; Set_Etype (N, Base_Type (Etype (Index))); - Set_Etype (E1, Standard_Integer); end if; end if; end Check_Array_Or_Scalar_Type; @@ -1951,10 +1977,23 @@ package body Sem_Attr is -- Check_Enum_Image -- ---------------------- - procedure Check_Enum_Image is + procedure Check_Enum_Image (Check_Enumeration_Maps : Boolean := False) is Lit : Entity_Id; begin + -- Ensure that Check_Enumeration_Maps parameter is set precisely for + -- attributes whose implementation requires enumeration maps. + + pragma Assert + (Check_Enumeration_Maps = (Attr_Id in Attribute_Image + | Attribute_Img + | Attribute_Valid_Value + | Attribute_Value + | Attribute_Wide_Image + | Attribute_Wide_Value + | Attribute_Wide_Wide_Image + | Attribute_Wide_Wide_Value)); + -- When an enumeration type appears in an attribute reference, all -- literals of the type are marked as referenced. This must only be -- done if the attribute reference appears in the current source. @@ -1964,6 +2003,10 @@ package body Sem_Attr is if Is_Enumeration_Type (P_Base_Type) and then In_Extended_Main_Code_Unit (N) then + if Check_Enumeration_Maps then + Check_Restriction (No_Enumeration_Maps, N); + end if; + Lit := First_Literal (P_Base_Type); while Present (Lit) loop Set_Referenced (Lit); @@ -2294,20 +2337,15 @@ package body Sem_Attr is begin if Is_Entity_Name (P) then declare - K : constant Entity_Kind := Ekind (Entity (P)); - T : constant Entity_Id := Etype (Entity (P)); - + E : constant Entity_Id := Entity (P); begin - if K in Subprogram_Kind - or else K in Task_Kind - or else K in Protected_Kind - or else K = E_Package - or else K in Generic_Unit_Kind - or else (K = E_Variable - and then - (Is_Task_Type (T) - or else - Is_Protected_Type (T))) + if Ekind (E) in E_Protected_Type + | E_Task_Type + | Entry_Kind + | Generic_Unit_Kind + | Subprogram_Kind + | E_Package + or else Is_Single_Concurrent_Object (E) then return; end if; @@ -2330,6 +2368,19 @@ package body Sem_Attr is end if; end Check_Real_Type; + ---------------------------- + -- Check_Enumeration_Type -- + ---------------------------- + + procedure Check_Enumeration_Type is + begin + Check_Type; + + if not Is_Enumeration_Type (P_Type) then + Error_Attr_P ("prefix of % attribute must be enumeration type"); + end if; + end Check_Enumeration_Type; + ----------------------- -- Check_Scalar_Type -- ----------------------- @@ -2381,15 +2432,18 @@ package body Sem_Attr is Analyze_And_Resolve (E1); -- Check that the first argument is - -- Ada.Strings.Text_Output.Sink'Class. + -- Ada.Strings.Text_Buffers.Root_Buffer_Type'Class. -- Note: the double call to Root_Type here is needed because the -- root type of a class-wide type is the corresponding type (e.g. -- X for X'Class, and we really want to go to the root.) - if Root_Type (Root_Type (Etype (E1))) /= RTE (RE_Sink) then + if not Is_RTE (Root_Type (Root_Type (Etype (E1))), + RE_Root_Buffer_Type) + then Error_Attr - ("expected Ada.Strings.Text_Output.Sink''Class", E1); + ("expected Ada.Strings.Text_Buffers.Root_Buffer_Type''Class", + E1); end if; -- Check that the second argument is of the right type @@ -2557,8 +2611,8 @@ package body Sem_Attr is -- X for X'Class, and we really want to go to the root.) if not Is_Access_Type (Etyp) - or else Root_Type (Root_Type (Designated_Type (Etyp))) /= - RTE (RE_Root_Stream_Type) + or else not Is_RTE (Root_Type (Root_Type (Designated_Type (Etyp))), + RE_Root_Stream_Type) then Error_Attr ("expected access to Ada.Streams.Root_Stream_Type''Class", E1); @@ -2838,17 +2892,17 @@ package body Sem_Attr is case Uneval_Old_Setting is when 'E' => - -- ??? In the case where Ada_Version is < Ada_2020 and - -- an illegal 'Old prefix would be legal in Ada_2020, - -- we'd like to call Error_Msg_Ada_2020_Feature. + -- ??? In the case where Ada_Version is < Ada_2022 and + -- an illegal 'Old prefix would be legal in Ada_2022, + -- we'd like to call Error_Msg_Ada_2022_Feature. -- Identifying that case involves some work. Error_Attr_P ("prefix of attribute % that is potentially " & "unevaluated must statically name an entity" - -- further text needed for accuracy if Ada_2020 - & (if Ada_Version >= Ada_2020 + -- further text needed for accuracy if Ada_2022 + & (if Ada_Version >= Ada_2022 and then Attr_Id = Attribute_Old then " or be eligible for conditional evaluation" & " (RM 6.1.1 (27))" @@ -2925,13 +2979,13 @@ package body Sem_Attr is -- Deal with Ada 2005 attributes that are implementation attributes -- because they appear in a version of Ada before Ada 2005, ditto for - -- Ada 2012 and Ada 2020 attributes appearing in an earlier version. + -- Ada 2012 and Ada 2022 attributes appearing in an earlier version. if (Attribute_05 (Attr_Id) and then Ada_Version < Ada_2005) or else (Attribute_12 (Attr_Id) and then Ada_Version < Ada_2012) or else - (Attribute_20 (Attr_Id) and then Ada_Version < Ada_2020) + (Attribute_22 (Attr_Id) and then Ada_Version < Ada_2022) then Check_Restriction (No_Implementation_Attributes, N); end if; @@ -5170,7 +5224,7 @@ package body Sem_Attr is else -- Ensure that the prefix of attribute 'Old is an entity when it -- is potentially unevaluated (6.1.1 (27/3)). This rule is - -- relaxed in Ada2020 - this relaxation is reflected in the + -- relaxed in Ada 2022 - this relaxation is reflected in the -- call (below) to Eligible_For_Conditional_Evaluation. if Is_Potentially_Unevaluated (N) @@ -5377,7 +5431,7 @@ package body Sem_Attr is or else (Is_Access_Type (Etype (P)) and then Is_Protected_Type (Designated_Type (Etype (P)))) then - Resolve (P, Etype (P)); + Resolve (P); else Error_Attr_P ("prefix of % attribute must be a protected object"); end if; @@ -5678,7 +5732,7 @@ package body Sem_Attr is null; else Error_Msg_NE - ("cannot apply Reduce to object of type$", N, Typ); + ("cannot apply Reduce to object of type&", N, Typ); end if; elsif Present (Expressions (Stream)) @@ -7041,6 +7095,31 @@ package body Sem_Attr is Set_Etype (N, Standard_Boolean); end Valid; + ----------------- + -- Valid_Value -- + ----------------- + + when Attribute_Valid_Value => + Check_E1; + Check_Enumeration_Type; + Check_Enum_Image (Check_Enumeration_Maps => True); + Set_Etype (N, Standard_Boolean); + Validate_Non_Static_Attribute_Function_Call; + + if 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"); + end if; + + if Discard_Names (First_Subtype (P_Type)) then + Error_Attr_P + ("prefix of % attribute must not have Discard_Names"); + end if; + ------------------- -- Valid_Scalars -- ------------------- @@ -7110,33 +7189,7 @@ package body Sem_Attr is => Check_E1; Check_Scalar_Type; - - -- Case of enumeration type - - -- When an enumeration type appears in an attribute reference, all - -- literals of the type are marked as referenced. This must only be - -- done if the attribute reference appears in the current source. - -- Otherwise the information on references may differ between a - -- normal compilation and one that performs inlining. - - if Is_Enumeration_Type (P_Type) - and then In_Extended_Main_Code_Unit (N) - then - Check_Restriction (No_Enumeration_Maps, N); - - -- Mark all enumeration literals as referenced, since the use of - -- the Value attribute can implicitly reference any of the - -- literals of the enumeration base type. - - declare - Ent : Entity_Id := First_Literal (P_Base_Type); - begin - while Present (Ent) loop - Set_Referenced (Ent); - Next_Literal (Ent); - end loop; - end; - end if; + Check_Enum_Image (Check_Enumeration_Maps => True); -- Set Etype before resolving expression because expansion of -- expression may require enclosing type. Note that the type @@ -7976,14 +8029,27 @@ package body Sem_Attr is end if; end; - -- For Size, give size of object if available, otherwise we - -- cannot fold Size. - elsif Id = Attribute_Size then + -- For Enum_Lit'Size, use Enum_Type'Object_Size. Taking the 'Size + -- of a literal is kind of a strange thing to do, so we don't want + -- to pass this oddity on to the back end. Note that Etype of an + -- enumeration literal is always a (base) type, never a + -- constrained subtype, so the Esize is always known. + if Is_Entity_Name (P) - and then Known_Static_Esize (Entity (P)) + and then Ekind (Entity (P)) = E_Enumeration_Literal + then + pragma Assert (Known_Static_Esize (Etype (P))); + Compile_Time_Known_Attribute (N, Esize (Etype (P))); + + -- Otherwise, if Size is available, use that + + elsif Is_Entity_Name (P) and then Known_Static_Esize (Entity (P)) then Compile_Time_Known_Attribute (N, Esize (Entity (P))); + + -- Otherwise, we cannot fold + else Check_Expressions; end if; @@ -9103,11 +9169,13 @@ package body Sem_Attr is -- Machine -- ------------- + -- We use the same rounding mode as the one used for RM 4.9(38) + when Attribute_Machine => Fold_Ureal (N, Eval_Fat.Machine - (P_Base_Type, Expr_Value_R (E1), Eval_Fat.Round, N), + (P_Base_Type, Expr_Value_R (E1), Eval_Fat.Round_Even, N), Static); ------------------ @@ -10457,6 +10525,7 @@ package body Sem_Attr is | Attribute_Unrestricted_Access | Attribute_Valid | Attribute_Valid_Scalars + | Attribute_Valid_Value | Attribute_Value | Attribute_Wchar_T_Size | Attribute_Wide_Value @@ -10714,9 +10783,7 @@ package body Sem_Attr is -- If attribute was universal type, reset to actual type - if Etype (N) = Universal_Integer - or else Etype (N) = Universal_Real - then + if Is_Universal_Numeric_Type (Etype (N)) then Set_Etype (N, Typ); end if; @@ -10745,10 +10812,11 @@ package body Sem_Attr is Nm : Node_Id; Note : Boolean := True; - -- Skip this for the case of Unrestricted_Access occuring in - -- the context of a Valid check, since this otherwise leads - -- to a missed warning (the Valid check does not really - -- modify!) If this case, Note will be reset to False. + -- Skip this for the case of Unrestricted_Access occurring + -- in the context of a Valid check, since this otherwise + -- leads to a missed warning (the Valid check does not + -- really modify!) If this case, Note will be reset to + -- False. -- Skip it as well if the type is an Access_To_Constant, -- given that no use of the value can modify the prefix. @@ -10881,34 +10949,10 @@ package body Sem_Attr is if Convention (Designated_Type (Btyp)) /= Convention (Entity (P)) then - -- The rule in 6.3.1 (8) deserves a special error - -- message. - - if Convention (Btyp) = Convention_Intrinsic - and then Nkind (Parent (N)) = N_Procedure_Call_Statement - and then Is_Entity_Name (Name (Parent (N))) - and then Inside_A_Generic - then - declare - Subp : constant Entity_Id := - Entity (Name (Parent (N))); - begin - if Convention (Subp) = Convention_Intrinsic then - Error_Msg_FE - ("?subprogram and its formal access " - & "parameters have convention Intrinsic", - Parent (N), Subp); - Error_Msg_N - ("actual cannot be access attribute", N); - end if; - end; - - else - Error_Msg_FE - ("subprogram & has wrong convention", P, Entity (P)); - Error_Msg_Sloc := Sloc (Btyp); - Error_Msg_FE ("\does not match & declared#", P, Btyp); - end if; + Error_Msg_FE + ("subprogram & has wrong convention", P, Entity (P)); + Error_Msg_Sloc := Sloc (Btyp); + Error_Msg_FE ("\does not match & declared#", P, Btyp); if not Is_Itype (Btyp) and then not Has_Convention_Pragma (Btyp) @@ -11246,7 +11290,11 @@ package body Sem_Attr is -- this kind of warning is an error in SPARK mode. if In_Instance_Body then - Error_Msg_Warn := SPARK_Mode /= On; + Error_Msg_Warn := + SPARK_Mode /= On + and then + not No_Dynamic_Accessibility_Checks_Enabled (P); + Error_Msg_F ("non-local pointer cannot point to local object<<", P); Error_Msg_F ("\Program_Error [<<", P); @@ -11378,10 +11426,13 @@ package body Sem_Attr is -- Check the static accessibility rule of 3.10.2(28). Note that -- this check is not performed for the case of an anonymous -- access type, since the access attribute is always legal - -- in such a context. + -- in such a context - unless the restriction + -- No_Dynamic_Accessibility_Checks is active. if Attr_Id /= Attribute_Unchecked_Access - and then Ekind (Btyp) = E_General_Access_Type + and then + (Ekind (Btyp) = E_General_Access_Type + or else No_Dynamic_Accessibility_Checks_Enabled (Btyp)) -- Call Accessibility_Level directly to avoid returning zero -- on cases where the prefix is an explicitly aliased @@ -11448,6 +11499,25 @@ package body Sem_Attr is Error_Msg_F ("context requires a non-protected subprogram", P); end if; + -- AI12-0412: The rule in RM 6.1.1(18.2/5) disallows applying + -- attribute Access to a primitive of an abstract type when the + -- primitive has any Pre'Class or Post'Class aspects specified + -- with nonstatic expressions. + + if Attr_Id = Attribute_Access + and then Ekind (Btyp) in E_Access_Subprogram_Type + | E_Anonymous_Access_Subprogram_Type + and then Is_Entity_Name (P) + and then Is_Dispatching_Operation (Entity (P)) + and then + Is_Prim_Of_Abst_Type_With_Nonstatic_CW_Pre_Post (Entity (P)) + then + Error_Msg_N + ("attribute not allowed for primitive of abstract type with " + & "nonstatic class-wide pre/postconditions", + N); + end if; + -- The context cannot be a pool-specific type, but this is a -- legality rule, not a resolution rule, so it must be checked -- separately, after possibly disambiguation (see AI-245). @@ -11475,14 +11545,14 @@ package body Sem_Attr is ("access to atomic object cannot yield access-to-" & "non-atomic type", P); - elsif Is_Volatile_Object (P) + elsif Is_Volatile_Object_Ref (P) and then not Is_Volatile (Designated_Type (Typ)) then Error_Msg_F ("access to volatile object cannot yield access-to-" & "non-volatile type", P); - elsif Is_Volatile_Full_Access_Object (P) + elsif Is_Volatile_Full_Access_Object_Ref (P) and then not Is_Volatile_Full_Access (Designated_Type (Typ)) then Error_Msg_F @@ -11491,9 +11561,9 @@ package body Sem_Attr is end if; -- Check for nonatomic subcomponent of a full access object - -- in Ada 2020 (RM C.6 (12)). + -- in Ada 2022 (RM C.6 (12)). - if Ada_Version >= Ada_2020 + if Ada_Version >= Ada_2022 and then Is_Subcomponent_Of_Full_Access_Object (P) and then not Is_Atomic_Object (P) then @@ -12274,7 +12344,7 @@ package body Sem_Attr is -- reference is resolved. case Attr_Id is - when Attribute_Value => + when Attribute_Valid_Value | Attribute_Value => Resolve (First (Expressions (N)), Standard_String); when Attribute_Wide_Value => |