[PATCH] ada: Alter parsing for left parenthesis after some parameterless attributes
Samuel Tardieu
sam@rfc1149.net
Fri Nov 23 14:18:00 GMT 2007
Compiled and regtested on i686-pc-linux-gnu.
gcc/ada/
PR ada/17317
* par-ch4.adb (Is_Parameterless_Attribute): New map.
(P_Name, Scan_Apostrophe block): Parse left parenthesis following
attribute name or not depending on the new map.
* sem-attr.adb (Analyze_Attribute): Parameterless attributes
returning a string or a type will not be called with improper
arguments.
* sem-attr.ads (Attribute_Class_Array): Move to snames.ads.
* snames.ads (Attribute_Class_Array): Moved from sem-attr.ads.
gcc/testsuite/
PR ada/17317
* gnat.dg/specs/attribute_parsing.ads: New test.
---
gcc/ada/par-ch4.adb | 24 ++++++-
gcc/ada/sem_attr.adb | 88 ++-------------------
gcc/ada/sem_attr.ads | 3 -
gcc/ada/snames.ads | 7 ++
gcc/testsuite/gnat.dg/specs/attribute_parsing.ads | 5 +
5 files changed, 43 insertions(+), 84 deletions(-)
create mode 100644 gcc/testsuite/gnat.dg/specs/attribute_parsing.ads
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 89f3345..ee63c42 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -32,6 +32,25 @@ with Stringt; use Stringt;
separate (Par)
package body Ch4 is
+ ---------------
+ -- Local map --
+ ---------------
+
+ Is_Parameterless_Attribute : constant Attribute_Class_Array :=
+ (Attribute_Body_Version => True,
+ Attribute_External_Tag => True,
+ Attribute_Img => True,
+ Attribute_Version => True,
+ Attribute_Base => True,
+ Attribute_Class => True,
+ Attribute_Stub_Type => True,
+ others => False);
+ -- This map contains True for parameterless attributes that return a
+ -- string 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)).
+
-----------------------
-- Local Subprograms --
-----------------------
@@ -486,7 +505,10 @@ package body Ch4 is
-- Scan attribute arguments/designator
- if Token = Tok_Left_Paren then
+ if Token = Tok_Left_Paren
+ and then
+ not Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
+ then
Set_Expressions (Name_Node, New_List);
Scan; -- past left paren
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 6f1541f..9dddb32 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2188,7 +2188,7 @@ package body Sem_Attr is
Typ : Entity_Id;
begin
- Check_Either_E0_Or_E1;
+ Check_E0;
Find_Type (P);
Typ := Entity (P);
@@ -2207,37 +2207,9 @@ package body Sem_Attr is
end if;
Set_Etype (N, Base_Type (Entity (P)));
-
- -- If we have an expression present, then really this is a conversion
- -- and the tree must be reformed. Note that this is one of the cases
- -- in which we do a replace rather than a rewrite, because the
- -- original tree is junk.
-
- if Present (E1) then
- Replace (N,
- Make_Type_Conversion (Loc,
- Subtype_Mark =>
- Make_Attribute_Reference (Loc,
- Prefix => Prefix (N),
- Attribute_Name => Name_Base),
- Expression => Relocate_Node (E1)));
-
- -- E1 may be overloaded, and its interpretations preserved
-
- Save_Interps (E1, Expression (N));
- Analyze (N);
-
- -- For other cases, set the proper type as the entity of the
- -- attribute reference, and then rewrite the node to be an
- -- occurrence of the referenced base type. This way, no one
- -- else in the compiler has to worry about the base attribute.
-
- else
- Set_Entity (N, Base_Type (Entity (P)));
- Rewrite (N,
- New_Reference_To (Entity (N), Loc));
- Analyze (N);
- end if;
+ Set_Entity (N, Base_Type (Entity (P)));
+ Rewrite (N, New_Reference_To (Entity (N), Loc));
+ Analyze (N);
end Base;
---------
@@ -2377,55 +2349,10 @@ package body Sem_Attr is
-- Class --
-----------
- when Attribute_Class => Class : declare
- P : constant Entity_Id := Prefix (N);
-
- begin
+ when Attribute_Class =>
Check_Restriction (No_Dispatch, N);
- Check_Either_E0_Or_E1;
-
- -- If we have an expression present, then really this is a conversion
- -- and the tree must be reformed into a proper conversion. This is a
- -- Replace rather than a Rewrite, because the original tree is junk.
- -- If expression is overloaded, propagate interpretations to new one.
-
- if Present (E1) then
- Replace (N,
- Make_Type_Conversion (Loc,
- Subtype_Mark =>
- Make_Attribute_Reference (Loc,
- Prefix => P,
- Attribute_Name => Name_Class),
- Expression => Relocate_Node (E1)));
-
- Save_Interps (E1, Expression (N));
-
- -- Ada 2005 (AI-251): In case of abstract interfaces we have to
- -- analyze and resolve the type conversion to generate the code
- -- that displaces the reference to the base of the object.
-
- if Is_Interface (Etype (P))
- or else Is_Interface (Etype (E1))
- then
- Analyze_And_Resolve (N, Etype (P));
-
- -- However, the attribute is a name that occurs in a context
- -- that imposes its own type. Leave the result unanalyzed,
- -- so that type checking with the context type take place.
- -- on the new conversion node, otherwise Resolve is a noop.
-
- Set_Analyzed (N, False);
-
- else
- Analyze (N);
- end if;
-
- -- Otherwise we just need to find the proper type
-
- else
- Find_Type (N);
- end if;
- end Class;
+ Check_E0;
+ Find_Type (N);
------------------
-- Code_Address --
@@ -3018,6 +2945,7 @@ package body Sem_Attr is
when Attribute_Img => Img :
begin
+ Check_E0;
Set_Etype (N, Standard_String);
if not Is_Scalar_Type (P_Type)
diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads
index 1ca9039..45cb8e0 100644
--- a/gcc/ada/sem_attr.ads
+++ b/gcc/ada/sem_attr.ads
@@ -38,9 +38,6 @@ with Types; use Types;
package Sem_Attr is
- type Attribute_Class_Array is array (Attribute_Id) of Boolean;
- -- Type used to build attribute classification flag arrays
-
-----------------------------------------
-- Implementation Dependent Attributes --
-----------------------------------------
diff --git a/gcc/ada/snames.ads b/gcc/ada/snames.ads
index b7a7ab1..f2e7be9 100644
--- a/gcc/ada/snames.ads
+++ b/gcc/ada/snames.ads
@@ -1521,6 +1521,13 @@ package Snames is
Task_Dispatching_FIFO_Within_Priorities);
-- Id values used to identify task dispatching policies
+ ------------------
+ -- Helper types --
+ ------------------
+
+ type Attribute_Class_Array is array (Attribute_Id) of Boolean;
+ -- Type used to build attribute classification flag arrays
+
-----------------
-- Subprograms --
-----------------
diff --git a/gcc/testsuite/gnat.dg/specs/attribute_parsing.ads b/gcc/testsuite/gnat.dg/specs/attribute_parsing.ads
new file mode 100644
index 0000000..7722a9a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/attribute_parsing.ads
@@ -0,0 +1,5 @@
+-- { dg-do compile }
+package Attribute_Parsing is
+ I : constant Integer := 12345;
+ S : constant String := I'Img (1 .. 2);
+end Attribute_Parsing;
--
1.5.3.5
More information about the Gcc-patches
mailing list