Misc cleanup in preparation for further work on Put_Image and Image.
Mostly removal of redundant or obvious comments.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-05 Bob Duff <d...@adacore.com>
gcc/ada/
* exp_attr.adb, exp_ch11.adb, exp_imgv.adb, exp_tss.ads,
par-ch4.adb, sem_attr.adb, sem_util.ads: Misc cleanup.--- gcc/ada/exp_attr.adb
+++ gcc/ada/exp_attr.adb
@@ -3732,8 +3732,6 @@ package body Exp_Attr is
-- Image --
-----------
- -- Image attribute is handled in separate unit Exp_Imgv
-
when Attribute_Image =>
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
@@ -3743,7 +3741,7 @@ package body Exp_Attr is
return;
end if;
- Expand_Image_Attribute (N);
+ Exp_Imgv.Expand_Image_Attribute (N);
---------
-- Img --
@@ -3752,7 +3750,7 @@ package body Exp_Attr is
-- X'Img is expanded to typ'Image (X), where typ is the type of X
when Attribute_Img =>
- Expand_Image_Attribute (N);
+ Exp_Imgv.Expand_Image_Attribute (N);
-----------
-- Input --
@@ -7243,8 +7241,6 @@ package body Exp_Attr is
-- Value --
-----------
- -- Value attribute is handled in separate unit Exp_Imgv
-
when Attribute_Value =>
Exp_Imgv.Expand_Value_Attribute (N);
@@ -7264,8 +7260,6 @@ package body Exp_Attr is
-- Wide_Image --
----------------
- -- Wide_Image attribute is handled in separate unit Exp_Imgv
-
when Attribute_Wide_Image =>
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
-- back-end knows how to handle this attribute directly.
@@ -7280,8 +7274,6 @@ package body Exp_Attr is
-- Wide_Wide_Image --
---------------------
- -- Wide_Wide_Image attribute is handled in separate unit Exp_Imgv
-
when Attribute_Wide_Wide_Image =>
-- Leave attribute unexpanded in CodePeer mode: the gnat2scil
-- back-end knows how to handle this attribute directly.
@@ -7374,8 +7366,6 @@ package body Exp_Attr is
-- Wide_Wide_Width --
---------------------
- -- Wide_Wide_Width attribute is handled in separate unit Exp_Imgv
-
when Attribute_Wide_Wide_Width =>
Exp_Imgv.Expand_Width_Attribute (N, Wide_Wide);
@@ -7383,8 +7373,6 @@ package body Exp_Attr is
-- Wide_Width --
----------------
- -- Wide_Width attribute is handled in separate unit Exp_Imgv
-
when Attribute_Wide_Width =>
Exp_Imgv.Expand_Width_Attribute (N, Wide);
@@ -7392,8 +7380,6 @@ package body Exp_Attr is
-- Width --
-----------
- -- Width attribute is handled in separate unit Exp_Imgv
-
when Attribute_Width =>
Exp_Imgv.Expand_Width_Attribute (N, Normal);
--- gcc/ada/exp_ch11.adb
+++ gcc/ada/exp_ch11.adb
@@ -1505,7 +1505,7 @@ package body Exp_Ch11 is
Actions => New_List (
Make_Simple_Return_Statement (Loc,
Expression => New_Occurrence_Of (Standard_False, Loc))),
- Expression => RCE));
+ Expression => RCE));
else
Rewrite (N,
@@ -1514,7 +1514,7 @@ package body Exp_Ch11 is
Make_Raise_Statement (Loc,
Name => Name (N),
Expression => Expression (N))),
- Expression => RCE));
+ Expression => RCE));
end if;
Analyze_And_Resolve (N, Typ);
--- gcc/ada/exp_imgv.adb
+++ gcc/ada/exp_imgv.adb
@@ -58,7 +58,7 @@ package body Exp_Imgv is
Pref : Entity_Id;
Attr_Name : Name_Id;
Str_Typ : Entity_Id);
- -- AI12-00124: Rewrite attribute 'Image when it is applied to an object
+ -- AI12-0124: 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
@@ -263,7 +263,7 @@ package body Exp_Imgv is
-- tv = Long_Long_Integer?(Expr) [convert with no scaling]
-- pm = typ'Scale (typ = subtype of expression)
- -- For enumeration types other than those declared packages Standard
+ -- For enumeration types other than those declared in package Standard
-- or System, Snn, Pnn, are expanded as above, but the call looks like:
-- Image_Enumeration_NN (rt'Pos (X), Snn, Pnn, typS, typI'Address)
@@ -474,23 +474,24 @@ package body Exp_Imgv is
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);
-- Enable speed-optimized expansion of user-defined enumeration types
-- if we are compiling with optimizations enabled and enumeration type
-- literals are generated. Otherwise the call will be expanded into a
-- call to the runtime library.
- elsif Optimization_Level > 0
+ if Optimization_Level > 0
and then not Global_Discard_Names
- and then Is_User_Defined_Enumeration_Type (Root_Type (Entity (Pref)))
+ and then Is_User_Defined_Enumeration_Type (Rtyp)
then
Expand_User_Defined_Enumeration_Image;
return;
end if;
- Ptyp := Entity (Pref);
- Rtyp := Root_Type (Ptyp);
-
-- Build declarations of Snn and Pnn to be inserted
Ins_List := New_List (
--- gcc/ada/exp_tss.ads
+++ gcc/ada/exp_tss.ads
@@ -170,12 +170,9 @@ package Exp_Tss is
-- be explicitly frozen, so the N_Freeze_Entity node always exists).
function TSS (Typ : Entity_Id; Nam : TSS_Name_Type) return Entity_Id;
- -- Finds the TSS with the given name associated with the given type
- -- If no such TSS exists, then Empty is returned;
-
function TSS (Typ : Entity_Id; Nam : Name_Id) return Entity_Id;
- -- Finds the TSS with the given name associated with the given type. If
- -- no such TSS exists, then Empty is returned.
+ -- Finds the TSS with the given name associated with the given type.
+ -- If no such TSS exists, then Empty is returned.
function Same_TSS (E1, E2 : Entity_Id) return Boolean;
-- Returns True if E1 and E2 are the same kind of TSS, even if the names
--- gcc/ada/par-ch4.adb
+++ gcc/ada/par-ch4.adb
@@ -51,7 +51,7 @@ package body Ch4 is
-- or a type. For those attributes, a left parenthesis after the attribute
-- should not be analyzed as the beginning of a parameters list because it
-- may denote a slice operation (X'Img (1 .. 2)) or a type conversion
- -- (X'Class (Y)). The Ada 2012 attribute 'Old is in this category.
+ -- (X'Class (Y)).
-- Note: Loop_Entry is in this list because, although it can take an
-- optional argument (the loop name), we can't distinguish that at parse
--- gcc/ada/sem_attr.adb
+++ gcc/ada/sem_attr.adb
@@ -1430,12 +1430,12 @@ package body Sem_Attr is
begin
Check_SPARK_05_Restriction_On_Attribute;
- -- AI12-00124: The ARG has adopted the GNAT semantics of 'Img for
+ -- 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, and there is no need for an argument in this case.
+ -- or a type. If the prefix is an object, there is no argument.
if Attr_Id = Attribute_Img
- or else (Ada_Version > Ada_2005 and then Is_Object_Image (P))
+ or else (Ada_Version >= Ada_2012 and then Is_Object_Image (P))
then
Check_E0;
Set_Etype (N, Str_Typ);
@@ -1465,7 +1465,7 @@ package body Sem_Attr is
or else not Is_Type (Entity (P))
or else not Is_Scalar_Type (P_Type)
then
- if Ada_Version > Ada_2005 then
+ if Ada_Version >= Ada_2012 then
Error_Attr_P
("prefix of % attribute must be a scalar type or a scalar "
& "object name");
--- gcc/ada/sem_util.ads
+++ gcc/ada/sem_util.ads
@@ -1836,13 +1836,8 @@ package Sem_Util is
-- 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.
+ -- Returns True if an 'Img, 'Image, 'Wide_Image, or 'Wide_Wide_Image
+ -- attribute is applied to an object.
function Is_Object_Reference (N : Node_Id) return Boolean;
-- Determines if the tree referenced by N represents an object. Both
