diff options
author | Bob Duff <duff@adacore.com> | 2020-03-30 10:20:33 -0400 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-06-15 04:04:24 -0400 |
commit | 6349cf36d8bb7fb83f67a7bc27fc67dca73b19dd (patch) | |
tree | 0812c36df6e46c61907a17b1bc377b3a79245b19 /gcc | |
parent | bfdb362c000c1502ca4757bb7e5ce5cb42a6a5ae (diff) | |
download | gcc-6349cf36d8bb7fb83f67a7bc27fc67dca73b19dd.zip gcc-6349cf36d8bb7fb83f67a7bc27fc67dca73b19dd.tar.gz gcc-6349cf36d8bb7fb83f67a7bc27fc67dca73b19dd.tar.bz2 |
[Ada] Clean up error handling of 'Image
2020-06-15 Bob Duff <duff@adacore.com>
gcc/ada/
* sem_attr.adb (Check_Image_Type): New procedure for checking
the type, depending on language version. Disable the Ada 2020
support until the corresponding expander work is done.
(Analyze_Image_Attribute): Call Check_Image_Type. Rearrange the
code to be simplier and more logical. When P_Type is modified,
modify P_Base_Type accordingly.
* sem_util.adb (Is_Object_Image): Do not return False if the
prefix is a type. X'Image should be considered an image of an
object iff X is an object (albeit illegal pre-2020 if
nonscalar).
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/sem_attr.adb | 69 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 7 |
2 files changed, 39 insertions, 37 deletions
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 2c3cd50..801c445 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -1414,56 +1414,65 @@ package body Sem_Attr is ----------------------------- procedure Analyze_Image_Attribute (Str_Typ : Entity_Id) is + procedure Check_Image_Type (Image_Type : Entity_Id); + -- Check that Image_Type is legal as the type of a prefix of 'Image. + -- Legality depends on the Ada language version. + + procedure Check_Image_Type (Image_Type : Entity_Id) is + begin + if False -- ???Disable 2020 feature until expander work is done + and then Ada_Version >= Ada_2020 + then + null; -- all types are OK + elsif not Is_Scalar_Type (Image_Type) then + if Ada_Version >= Ada_2012 then + Error_Attr_P + ("prefix of % attribute must be a scalar type or a scalar " + & "object name"); + else + Error_Attr_P ("prefix of % attribute must be a scalar type"); + end if; + end if; + end Check_Image_Type; + + -- Start of processing for Analyze_Image_Attribute + begin -- AI12-0124: The ARG has adopted the GNAT semantics of 'Img for -- scalar types, so that the prefix can be an object, a named value, -- or a type. If the prefix is an object, there is no argument. - if Attr_Id = Attribute_Img - or else (Ada_Version >= Ada_2012 and then Is_Object_Image (P)) - then + if Is_Object_Image (P) then Check_E0; Set_Etype (N, Str_Typ); + Check_Image_Type (Etype (P)); - if Attr_Id = Attribute_Img and then not Is_Object_Image (P) then - Error_Attr_P - ("prefix of % attribute must be a scalar object name"); + if Attr_Id /= Attribute_Img and then Ada_Version < Ada_2012 then + Error_Attr_P ("prefix of % attribute must be a scalar type"); end if; else Check_E1; Set_Etype (N, Str_Typ); - -- Check that the prefix type is scalar - much in the same way as - -- Check_Scalar_Type but with custom error messages to denote the - -- variants of 'Image attributes. + -- ???It's not clear why 'Img should behave any differently than + -- 'Image. - if Is_Entity_Name (P) - and then Is_Type (Entity (P)) - and then Ekind (Entity (P)) = E_Incomplete_Type + if Attr_Id = Attribute_Img then + Error_Attr_P + ("prefix of % attribute must be a scalar object name"); + end if; + + pragma Assert (Is_Entity_Name (P) and then Is_Type (Entity (P))); + + if Ekind (Entity (P)) = E_Incomplete_Type and then Present (Full_View (Entity (P))) then P_Type := Full_View (Entity (P)); + P_Base_Type := Base_Type (P_Type); Set_Entity (P, P_Type); end if; - if not Is_Entity_Name (P) - or else not Is_Type (Entity (P)) - or else not Is_Scalar_Type (P_Type) - then - if Ada_Version >= Ada_2012 then - Error_Attr_P - ("prefix of % attribute must be a scalar type or a scalar " - & "object name"); - else - Error_Attr_P ("prefix of % attribute must be a scalar type"); - end if; - - elsif Is_Protected_Self_Reference (P) then - Error_Attr_P - ("prefix of % attribute denotes current instance " - & "(RM 9.4(21/2))"); - end if; - + Check_Image_Type (P_Type); Resolve (E1, P_Base_Type); Validate_Non_Static_Attribute_Function_Call; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index d7d43c9..a1bf0ae 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -16797,13 +16797,6 @@ package body Sem_Util is function Is_Object_Image (Prefix : Node_Id) return Boolean is begin - -- When the type of the prefix is not scalar, then the prefix is not - -- valid in any scenario. - - if not Is_Scalar_Type (Etype (Prefix)) then - return False; - end if; - -- Here we test for the case that the prefix is not a type and assume -- if it is not then it must be a named value or an object reference. -- This is because the parser always checks that prefixes of attributes |