* [Ada] Extension of 'Image in Ada2020.
@ 2017-09-06 9:34 Arnaud Charlet
0 siblings, 0 replies; 2+ messages in thread
From: Arnaud Charlet @ 2017-09-06 9:34 UTC (permalink / raw)
To: gcc-patches; +Cc: Ed Schonberg
[-- Attachment #1: Type: text/plain, Size: 1493 bytes --]
AI12-0124 adds the notation Object'Image to the language, following the
semantics of GNAT-defined attribute 'Img. This patch fixes an omission in
the characterization of objects, which must include function calls and thus
attribute references for attributes that are functions, as well as predefined
operators.
The following must compile and execute quietly:
gnatmake -q img
img
---
procedure Img is
type Enum is (A, BC, ABC, A_B_C, abcd, 'd');
type New_Enum is new Enum;
function Ident (X : Enum) return Enum is
begin
return X;
end Ident;
E1 : New_Enum := New_Enum (Ident (BC));
type Int is new Long_Integer;
type Der is new Int;
function Ident (X : Der) return Der is
begin
return X;
end Ident;
V : Der := Ident (123);
begin
if New_Enum'Pred (E1)'Img /= "A" then
raise Program_Error;
end if;
if New_Enum'Pred (E1)'Image /= "A" then
raise Program_Error;
end if;
if Der'(V - 23)'Image /= "100" then
raise Program_Error;
end if;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-06 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (Is_Object_Reference): A function call is an
object reference, and thus attribute references for attributes
that are functions (such as Pred and Succ) as well as predefined
operators are legal in contexts that require an object, such as
the prefix of attribute Img and the Ada2020 version of 'Image.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1411 bytes --]
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 251753)
+++ sem_util.adb (working copy)
@@ -14153,18 +14153,21 @@
-- In Ada 95, a function call is a constant object; a procedure
-- call is not.
- when N_Function_Call =>
+ -- Note that predefined operators are functions as well, and so
+ -- are attributes that are (can be renamed as) functions.
+
+ when N_Function_Call | N_Binary_Op | N_Unary_Op =>
return Etype (N) /= Standard_Void_Type;
- -- Attributes 'Input, 'Loop_Entry, 'Old, and 'Result produce
- -- objects.
+ -- Attributes references 'Loop_Entry, 'Old, and 'Result yield
+ -- objects, even though they are not functions.
when N_Attribute_Reference =>
return
- Nam_In (Attribute_Name (N), Name_Input,
- Name_Loop_Entry,
+ Nam_In (Attribute_Name (N), Name_Loop_Entry,
Name_Old,
- Name_Result);
+ Name_Result)
+ or else Is_Function_Attribute_Name (Attribute_Name (N));
when N_Selected_Component =>
return
^ permalink raw reply [flat|nested] 2+ messages in thread
* [Ada] Extension of 'Image in Ada2020
@ 2017-09-06 11:03 Arnaud Charlet
0 siblings, 0 replies; 2+ messages in thread
From: Arnaud Charlet @ 2017-09-06 11:03 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
[-- Attachment #1: Type: text/plain, Size: 1015 bytes --]
Refactor of all 'Image attributes for better error diagnostics and clarity.
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-06 Justin Squirek <squirek@adacore.com>
* exp_imgv.adb (Expand_Image_Attribute),
(Expand_Wide_Image_Attribute), (Expand_Wide_Wide_Image_Attribute):
Added case to handle new-style 'Image expansion
(Rewrite_Object_Image): Moved from exp_attr.adb
* exp_attr.adb (Expand_N_Attribute_Reference): Modified Image
attribute cases so that the relevant subprograms in exp_imgv.adb
handle all expansion.
(Rewrite_Object_Reference_Image): Moved to exp_imgv.adb
* sem_attr.adb (Analyze_Attribute): Modified Image attribute
cases to call common function Analyze_Image_Attribute.
(Analyze_Image_Attribute): Created as a common path for all
image attributes (Check_Object_Reference_Image): Removed
* sem_util.ads, sem_util.adb (Is_Image_Applied_To_Object):
Removed and refactored into Is_Object_Image (Is_Object_Image):
Created as a replacement for Is_Image_Applied_To_Object
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 22668 bytes --]
Index: exp_imgv.adb
===================================================================
--- exp_imgv.adb (revision 251753)
+++ exp_imgv.adb (working copy)
@@ -36,6 +36,7 @@
with Rtsfind; use Rtsfind;
with Sem_Aux; use Sem_Aux;
with Sem_Res; use Sem_Res;
+with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
with Snames; use Snames;
with Stand; use Stand;
@@ -52,6 +53,17 @@
-- Ordinary_Fixed_Point_Type with a small that is a negative power of ten.
-- Shouldn't this be in einfo.adb or sem_aux.adb???
+ procedure Rewrite_Object_Image
+ (N : Node_Id;
+ Pref : Entity_Id;
+ Attr_Name : Name_Id;
+ Str_Typ : Entity_Id);
+ -- AI12-00124: Rewrite attribute 'Image when it is applied to an object
+ -- reference as an attribute applied to a type. N denotes the node to be
+ -- rewritten, Pref denotes the prefix of the 'Image attribute, and Name
+ -- and Str_Typ specify which specific string type and 'Image attribute to
+ -- apply (e.g. Name_Wide_Image and Standard_Wide_String).
+
------------------------------------
-- Build_Enumeration_Image_Tables --
------------------------------------
@@ -254,10 +266,10 @@
Loc : constant Source_Ptr := Sloc (N);
Exprs : constant List_Id := Expressions (N);
Pref : constant Node_Id := Prefix (N);
- Ptyp : constant Entity_Id := Entity (Pref);
- Rtyp : constant Entity_Id := Root_Type (Ptyp);
Expr : constant Node_Id := Relocate_Node (First (Exprs));
Imid : RE_Id;
+ Ptyp : Entity_Id;
+ Rtyp : Entity_Id;
Tent : Entity_Id;
Ttyp : Entity_Id;
Proc_Ent : Entity_Id;
@@ -273,6 +285,14 @@
Pnn : constant Entity_Id := Make_Temporary (Loc, 'P');
begin
+ if Is_Object_Image (Pref) then
+ Rewrite_Object_Image (N, Pref, Name_Image, Standard_String);
+ return;
+ end if;
+
+ Ptyp := Entity (Pref);
+ Rtyp := Root_Type (Ptyp);
+
-- Build declarations of Snn and Pnn to be inserted
Ins_List := New_List (
@@ -791,11 +811,19 @@
procedure Expand_Wide_Image_Attribute (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
- Rtyp : constant Entity_Id := Root_Type (Entity (Prefix (N)));
- Rnn : constant Entity_Id := Make_Temporary (Loc, 'S');
- Lnn : constant Entity_Id := Make_Temporary (Loc, 'P');
+ Pref : constant Entity_Id := Prefix (N);
+ Rnn : constant Entity_Id := Make_Temporary (Loc, 'S');
+ Lnn : constant Entity_Id := Make_Temporary (Loc, 'P');
+ Rtyp : Entity_Id;
begin
+ if Is_Object_Image (Pref) then
+ Rewrite_Object_Image (N, Pref, Name_Wide_Image, Standard_Wide_String);
+ return;
+ end if;
+
+ Rtyp := Root_Type (Entity (Pref));
+
Insert_Actions (N, New_List (
-- Rnn : Wide_String (1 .. base_typ'Width);
@@ -882,12 +910,20 @@
procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N);
- Rtyp : constant Entity_Id := Root_Type (Entity (Prefix (N)));
+ Pref : constant Entity_Id := Prefix (N);
+ Rnn : constant Entity_Id := Make_Temporary (Loc, 'S');
+ Lnn : constant Entity_Id := Make_Temporary (Loc, 'P');
+ Rtyp : Entity_Id;
- Rnn : constant Entity_Id := Make_Temporary (Loc, 'S');
- Lnn : constant Entity_Id := Make_Temporary (Loc, 'P');
+ begin
+ if Is_Object_Image (Pref) then
+ Rewrite_Object_Image
+ (N, Pref, Name_Wide_Wide_Image, Standard_Wide_Wide_String);
+ return;
+ end if;
- begin
+ Rtyp := Root_Type (Entity (Pref));
+
Insert_Actions (N, New_List (
-- Rnn : Wide_Wide_String (1 .. rt'Wide_Wide_Width);
@@ -1373,4 +1409,23 @@
and then Ureal_10**Aft_Value (E) * Small_Value (E) = Ureal_1);
end Has_Decimal_Small;
+ --------------------------
+ -- Rewrite_Object_Image --
+ --------------------------
+
+ procedure Rewrite_Object_Image
+ (N : Node_Id;
+ Pref : Entity_Id;
+ Attr_Name : Name_Id;
+ Str_Typ : Entity_Id)
+ is
+ begin
+ Rewrite (N,
+ Make_Attribute_Reference (Sloc (N),
+ Prefix => New_Occurrence_Of (Etype (Pref), Sloc (N)),
+ Attribute_Name => Attr_Name,
+ Expressions => New_List (Relocate_Node (Pref))));
+
+ Analyze_And_Resolve (N, Str_Typ);
+ end Rewrite_Object_Image;
end Exp_Imgv;
Index: exp_imgv.ads
===================================================================
--- exp_imgv.ads (revision 251753)
+++ exp_imgv.ads (working copy)
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2017, 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- --
@@ -70,20 +70,20 @@
-- declarations are not constructed, and the fields remain Empty.
procedure Expand_Image_Attribute (N : Node_Id);
- -- This procedure is called from Exp_Attr to expand an occurrence
- -- of the attribute Image.
+ -- This procedure is called from Exp_Attr to expand an occurrence of the
+ -- attribute Image.
procedure Expand_Wide_Image_Attribute (N : Node_Id);
- -- This procedure is called from Exp_Attr to expand an occurrence
- -- of the attribute Wide_Image.
+ -- This procedure is called from Exp_Attr to expand an occurrence of the
+ -- attribute Wide_Image.
procedure Expand_Wide_Wide_Image_Attribute (N : Node_Id);
- -- This procedure is called from Exp_Attr to expand an occurrence
- -- of the attribute Wide_Wide_Image.
+ -- This procedure is called from Exp_Attr to expand an occurrence of the
+ -- attribute Wide_Wide_Image.
procedure Expand_Value_Attribute (N : Node_Id);
- -- This procedure is called from Exp_Attr to expand an occurrence
- -- of the attribute Value.
+ -- This procedure is called from Exp_Attr to expand an occurrence of the
+ -- attribute Value.
type Atype is (Normal, Wide, Wide_Wide);
-- Type of attribute in call to Expand_Width_Attribute
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 251772)
+++ exp_attr.adb (working copy)
@@ -1594,34 +1594,10 @@
Exprs : constant List_Id := Expressions (N);
Id : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N));
- procedure Rewrite_Object_Reference_Image
- (Name : Name_Id;
- Str_Typ : Entity_Id);
- -- AI12-00124: Rewrite attribute 'Image when it is applied to an object
- -- reference as an attribute applied to a type.
-
procedure Rewrite_Stream_Proc_Call (Pname : Entity_Id);
-- Rewrites a stream attribute for Read, Write or Output with the
-- procedure call. Pname is the entity for the procedure to call.
- ------------------------------------
- -- Rewrite_Object_Reference_Image --
- ------------------------------------
-
- procedure Rewrite_Object_Reference_Image
- (Name : Name_Id;
- Str_Typ : Entity_Id)
- is
- begin
- Rewrite (N,
- Make_Attribute_Reference (Loc,
- Prefix => New_Occurrence_Of (Ptyp, Loc),
- Attribute_Name => Name,
- Expressions => New_List (Relocate_Node (Pref))));
-
- Analyze_And_Resolve (N, Str_Typ);
- end Rewrite_Object_Reference_Image;
-
------------------------------
-- Rewrite_Stream_Proc_Call --
------------------------------
@@ -3637,11 +3613,6 @@
-- Image attribute is handled in separate unit Exp_Imgv
when Attribute_Image =>
- if Is_Image_Applied_To_Object (Pref, Ptyp) then
- Rewrite_Object_Reference_Image (Name_Image, Standard_String);
- return;
- end if;
-
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
-- back-end knows how to handle this attribute directly.
@@ -3658,7 +3629,7 @@
-- X'Img is expanded to typ'Image (X), where typ is the type of X
when Attribute_Img =>
- Rewrite_Object_Reference_Image (Name_Image, Standard_String);
+ Exp_Imgv.Expand_Image_Attribute (N);
-----------
-- Input --
@@ -7004,12 +6975,6 @@
-- Wide_Image attribute is handled in separate unit Exp_Imgv
when Attribute_Wide_Image =>
- if Is_Image_Applied_To_Object (Pref, Ptyp) then
- Rewrite_Object_Reference_Image
- (Name_Wide_Image, Standard_Wide_String);
- return;
- end if;
-
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
-- back-end knows how to handle this attribute directly.
@@ -7026,12 +6991,6 @@
-- Wide_Wide_Image attribute is handled in separate unit Exp_Imgv
when Attribute_Wide_Wide_Image =>
- if Is_Image_Applied_To_Object (Pref, Ptyp) then
- Rewrite_Object_Reference_Image
- (Name_Wide_Wide_Image, Standard_Wide_Wide_String);
- return;
- end if;
-
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
-- back-end knows how to handle this attribute directly.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 251778)
+++ sem_util.adb (working copy)
@@ -13773,21 +13773,6 @@
N_Generic_Subprogram_Declaration);
end Is_Generic_Declaration_Or_Body;
- --------------------------------
- -- Is_Image_Applied_To_Object --
- --------------------------------
-
- function Is_Image_Applied_To_Object
- (Prefix : Node_Id;
- P_Typ : Entity_Id) return Boolean
- is
- begin
- return
- Ada_Version > Ada_2005
- and then Is_Object_Reference (Prefix)
- and then Is_Scalar_Type (P_Typ);
- end Is_Image_Applied_To_Object;
-
----------------------------
-- Is_Inherited_Operation --
----------------------------
@@ -14139,6 +14124,27 @@
or else Null_Present (Component_List (Type_Definition (Decl))));
end Is_Null_Record_Type;
+ ---------------------
+ -- Is_Object_Image --
+ ---------------------
+
+ 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 senario.
+
+ 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 prefix's of attributes
+ -- are named.
+
+ return not (Is_Entity_Name (Prefix) and then Is_Type (Entity (Prefix)));
+ end Is_Object_Image;
+
-------------------------
-- Is_Object_Reference --
-------------------------
@@ -14222,9 +14228,9 @@
return not Nkind_In (Original_Node (N), N_Case_Expression,
N_If_Expression);
- -- A view conversion of a tagged object is an object reference
+ when N_Type_Conversion =>
+ -- A view conversion of a tagged object is an object reference
- when N_Type_Conversion =>
return Is_Tagged_Type (Etype (Subtype_Mark (N)))
and then Is_Tagged_Type (Etype (Expression (N)))
and then Is_Object_Reference (Expression (N));
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 251778)
+++ sem_util.ads (working copy)
@@ -1598,18 +1598,6 @@
-- Determine whether arbitrary declaration Decl denotes a generic package,
-- a generic subprogram or a generic body.
- function Is_Image_Applied_To_Object
- (Prefix : Node_Id;
- P_Typ : Entity_Id) return Boolean;
- -- Returns true if an 'Image, 'Wide_Image, or 'Wide_Wide_Image attribute
- -- can be applied to a given object-reference prefix (see AI12-00124).
-
- -- AI12-00124: The ARG has adopted the GNAT semantics of 'Img for scalar
- -- types, so that the prefix can be an object and not a type, and there is
- -- no need for an argument. Given the vote of confidence from the ARG,
- -- simplest is to transform this new usage of 'Image into a reference to
- -- 'Img.
-
function Is_Inherited_Operation (E : Entity_Id) return Boolean;
-- E is a subprogram. Return True is E is an implicit operation inherited
-- by a derived type declaration.
@@ -1683,6 +1671,15 @@
-- Determine whether T is declared with a null record definition or a
-- null component list.
+ function Is_Object_Image (Prefix : Node_Id) return Boolean;
+ -- Returns true if an 'Image, 'Wide_Image, or 'Wide_Wide_Image attribute
+ -- is applied to a given object or named value prefix (see below).
+
+ -- AI12-00124: The ARG has adopted the GNAT semantics of 'Img for scalar
+ -- types, so that the prefix of any 'Image attribute can be an object, a
+ -- named value, or a type, and there is no need for an argument in the
+ -- case it is an object reference.
+
function Is_Object_Reference (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents an object. Both
-- variable and constant objects return True (compare Is_Variable).
Index: sem_attr.adb
===================================================================
--- sem_attr.adb (revision 251772)
+++ sem_attr.adb (working copy)
@@ -261,6 +261,12 @@
-- when the above criteria are met. Spec_Id denotes the entity of the
-- subprogram [body] or Empty if the attribute is illegal.
+ procedure Analyze_Image_Attribute (Str_Typ : Entity_Id);
+ -- Common processing for attributes 'Img, 'Image, 'Wide_Image, and
+ -- 'Wide_Wide_Image. The routine checks that the prefix is valid and
+ -- sets the entity type to the one specified by Str_Typ (e.g.
+ -- Standard_String for 'Image and Standard_Wide_String for 'Wide_Image).
+
procedure Bad_Attribute_For_Predicate;
-- Output error message for use of a predicate (First, Last, Range) not
-- allowed with a type that has predicates. If the type is a generic
@@ -363,10 +369,6 @@
procedure Check_Object_Reference (P : Node_Id);
-- Check that P is an object reference
- procedure Check_Object_Reference_Image (Str_Typ : Entity_Id);
- -- Verify that the prefix of attribute 'Image is an object reference and
- -- set the type of the prefix to Str_Typ.
-
procedure Check_PolyORB_Attribute;
-- Validity checking for PolyORB/DSA attribute
@@ -1427,6 +1429,82 @@
end if;
end Analyze_Attribute_Old_Result;
+ -----------------------------
+ -- Analyze_Image_Attribute --
+ -----------------------------
+
+ procedure Analyze_Image_Attribute (Str_Typ : Entity_Id) is
+ begin
+ Check_SPARK_05_Restriction_On_Attribute;
+
+ -- AI12-00124: 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, and there is no need for an argument in this case.
+
+ if Attr_Id = Attribute_Img
+ or else (Ada_Version > Ada_2005 and then Is_Object_Image (P))
+ then
+ Check_E0;
+ Set_Etype (N, Str_Typ);
+
+ 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");
+ 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.
+
+ if Is_Entity_Name (P)
+ and then Is_Type (Entity (P))
+ and then Ekind (Entity (P)) = E_Incomplete_Type
+ and then Present (Full_View (Entity (P)))
+ then
+ P_Type := Full_View (Entity (P));
+ 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_2005 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;
+
+ Resolve (E1, P_Base_Type);
+ Validate_Non_Static_Attribute_Function_Call;
+ end if;
+
+ Check_Enum_Image;
+
+ -- Check restriction No_Fixed_IO. Note the check of Comes_From_Source
+ -- to avoid giving a duplicate message for when Image attributes
+ -- applied to object references get expanded into type-based Image
+ -- attributes.
+
+ if Restriction_Check_Required (No_Fixed_IO)
+ and then Comes_From_Source (N)
+ and then Is_Fixed_Point_Type (P_Type)
+ then
+ Check_Restriction (No_Fixed_IO, P);
+ end if;
+ end Analyze_Image_Attribute;
+
---------------------------------
-- Bad_Attribute_For_Predicate --
---------------------------------
@@ -2164,33 +2242,6 @@
end if;
end Check_Object_Reference;
- ----------------------------------
- -- Check_Object_Reference_Image --
- ----------------------------------
-
- procedure Check_Object_Reference_Image (Str_Typ : Entity_Id) is
- begin
- Check_E0;
- Set_Etype (N, Str_Typ);
-
- if not Is_Scalar_Type (P_Type)
- or else (Is_Entity_Name (P) and then Is_Type (Entity (P)))
- then
- Error_Attr_P
- ("prefix of % attribute must be scalar object name");
- end if;
-
- Check_Enum_Image;
-
- -- Check restriction No_Fixed_IO
-
- if Restriction_Check_Required (No_Fixed_IO)
- and then Is_Fixed_Point_Type (P_Type)
- then
- Check_Restriction (No_Fixed_IO, P);
- end if;
- end Check_Object_Reference_Image;
-
----------------------------
-- Check_PolyORB_Attribute --
----------------------------
@@ -4073,16 +4124,6 @@
-----------
when Attribute_Image =>
- Check_SPARK_05_Restriction_On_Attribute;
-
- if Is_Image_Applied_To_Object (P, P_Type) then
- Check_Object_Reference_Image (Standard_String);
- return;
- end if;
-
- Check_Scalar_Type;
- Set_Etype (N, Standard_String);
-
if Is_Real_Type (P_Type) then
if Ada_Version = Ada_83 and then Comes_From_Source (N) then
Error_Msg_Name_1 := Aname;
@@ -4091,31 +4132,14 @@
end if;
end if;
- if Is_Enumeration_Type (P_Type) then
- Check_Restriction (No_Enumeration_Maps, N);
- end if;
+ Analyze_Image_Attribute (Standard_String);
- Check_E1;
- Resolve (E1, P_Base_Type);
- Check_Enum_Image;
- Validate_Non_Static_Attribute_Function_Call;
-
- -- Check restriction No_Fixed_IO. Note the check of Comes_From_Source
- -- to avoid giving a duplicate message for Img expanded into Image.
-
- if Restriction_Check_Required (No_Fixed_IO)
- and then Comes_From_Source (N)
- and then Is_Fixed_Point_Type (P_Type)
- then
- Check_Restriction (No_Fixed_IO, P);
- end if;
-
---------
-- Img --
---------
when Attribute_Img =>
- Check_Object_Reference_Image (Standard_String);
+ Analyze_Image_Attribute (Standard_String);
-----------
-- Input --
@@ -6995,51 +7019,15 @@
----------------
when Attribute_Wide_Image =>
- Check_SPARK_05_Restriction_On_Attribute;
+ Analyze_Image_Attribute (Standard_Wide_String);
- if Is_Image_Applied_To_Object (P, P_Type) then
- Check_Object_Reference_Image (Standard_Wide_String);
- return;
- end if;
-
- Check_Scalar_Type;
- Set_Etype (N, Standard_Wide_String);
- Check_E1;
- Resolve (E1, P_Base_Type);
- Validate_Non_Static_Attribute_Function_Call;
-
- -- Check restriction No_Fixed_IO
-
- if Restriction_Check_Required (No_Fixed_IO)
- and then Is_Fixed_Point_Type (P_Type)
- then
- Check_Restriction (No_Fixed_IO, P);
- end if;
-
---------------------
-- Wide_Wide_Image --
---------------------
when Attribute_Wide_Wide_Image =>
- if Is_Image_Applied_To_Object (P, P_Type) then
- Check_Object_Reference_Image (Standard_Wide_Wide_String);
- return;
- end if;
+ Analyze_Image_Attribute (Standard_Wide_Wide_String);
- Check_Scalar_Type;
- Set_Etype (N, Standard_Wide_Wide_String);
- Check_E1;
- Resolve (E1, P_Base_Type);
- Validate_Non_Static_Attribute_Function_Call;
-
- -- Check restriction No_Fixed_IO
-
- if Restriction_Check_Required (No_Fixed_IO)
- and then Is_Fixed_Point_Type (P_Type)
- then
- Check_Restriction (No_Fixed_IO, P);
- end if;
-
----------------
-- Wide_Value --
----------------
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2017-09-06 11:03 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-06 9:34 [Ada] Extension of 'Image in Ada2020 Arnaud Charlet
2017-09-06 11:03 Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).