...in preparation for enabling 'Image for all types in Ada 2020, and
having it call 'Put_Image for nonscalar types, and for types with
user-defined 'Put_Image.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-15 Bob Duff <d...@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).--- gcc/ada/sem_attr.adb
+++ 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;
--- gcc/ada/sem_util.adb
+++ 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
