re PR target/17317 (Match Constraints for *movdf_insn fails)
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.
From-SVN: r130496
This commit is contained in:
Samuel Tardieu
Samuel Tardieu
parent
39a974168f
commit
9c5a3a8d78
7 changed files with 59 additions and 84 deletions
|
|
@ -4,6 +4,19 @@
|
|||
* par-ch3.adb (P_Variant_Part): Signal an error when anything other
|
||||
than an identifier is used after "case" in a variant_part.
|
||||
|
||||
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.
|
||||
|
||||
2007-11-26 Andreas Krebbel <krebbel1@de.ibm.com>
|
||||
|
||||
PR 34081/C++
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
-----------------------------------------
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
-----------------
|
||||
|
|
|
|||
|
|
@ -3,6 +3,9 @@
|
|||
PR ada/15803
|
||||
* gnat.dg/specs/variant_part.ads: New test.
|
||||
|
||||
PR ada/17317
|
||||
* gnat.dg/specs/attribute_parsing.ads: New test.
|
||||
|
||||
2007-11-28 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
PR tree-optimization/34140
|
||||
|
|
|
|||
5
gcc/testsuite/gnat.dg/specs/attribute_parsing.ads
Normal file
5
gcc/testsuite/gnat.dg/specs/attribute_parsing.ads
Normal file
|
|
@ -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;
|
||||
Loading…
Add table
Add a link
Reference in a new issue