From: Samuel Tardieu Date: Wed, 28 Nov 2007 20:44:58 +0000 (+0000) Subject: re PR target/17317 (Match Constraints for *movdf_insn fails) X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9c5a3a8d78b8767ae6120216a55b39d9dc552b4b;p=platform%2Fupstream%2Fgcc.git 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 31f9d19..7b7383c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 PR 34081/C++ 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 ce66987..9821b6f 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/ChangeLog b/gcc/testsuite/ChangeLog index fc5de7d..692ca74 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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 PR tree-optimization/34140 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;