From 7a489a2b56cea8932a11e82d3f38e4e3692c7ead Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 Aug 2011 11:57:33 +0200 Subject: [PATCH] [multiple changes] 2011-08-02 Yannick Moy * sem_attr.adb (Check_Formal_Restriction_On_Attribute): new procedure to issue an error in formal mode on attribute not supported in this mode (Analyze_Attribute): issue errors on standard attributes not supported in formal mode. * sem_ch3.adb (Modular_Type_Declaration): remove obsolete part of comment, and issue error in formal mode on modulus which is not a power of 2. (Process_Range_Expr_In_Decl): issue error in formal mode on non-static range. * sem_ch8.adb (Find_Type): issue error in formal mode on 'Base in subtype mark. * sem_res.adb (Resolve_Unary_Op): issue error in formal mode on unary operator on modular type (except 'not'). 2011-08-02 Robert Dewar * gnat_rm.texi: Minor reformatting. From-SVN: r177118 --- gcc/ada/ChangeLog | 20 +++++++++++++ gcc/ada/gnat_rm.texi | 2 +- gcc/ada/sem_attr.adb | 68 ++++++++++++++++++++++++++++++++++++++------ gcc/ada/sem_ch3.adb | 9 ++++-- gcc/ada/sem_ch8.adb | 4 +++ gcc/ada/sem_res.adb | 6 ++++ 6 files changed, 97 insertions(+), 12 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c10bc0abb12..81c84779a97 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2011-08-02 Yannick Moy + + * sem_attr.adb (Check_Formal_Restriction_On_Attribute): new procedure + to issue an error in formal mode on attribute not supported in this mode + (Analyze_Attribute): issue errors on standard attributes not supported + in formal mode. + * sem_ch3.adb (Modular_Type_Declaration): remove obsolete part of + comment, and issue error in formal mode on modulus which is not a power + of 2. + (Process_Range_Expr_In_Decl): issue error in formal mode on non-static + range. + * sem_ch8.adb (Find_Type): issue error in formal mode on 'Base in + subtype mark. + * sem_res.adb (Resolve_Unary_Op): issue error in formal mode on unary + operator on modular type (except 'not'). + +2011-08-02 Robert Dewar + + * gnat_rm.texi: Minor reformatting. + 2011-08-02 Arnaud Charlet * s-osinte-linux.ads: Minor comment update and reformatting. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 4ead06e0d30..ce6745750c8 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -9071,7 +9071,7 @@ passes the compiler in SPARK mode is rejected by the SPARK Examiner, e.g. due to the different visibility rules of the Examiner based on SPARK @code{inherit} annotations. -SPARK restriction can be useful in providing an initial filter for +This restriction can be useful in providing an initial filter for code developed using SPARK, or in examining legacy code to see how far it is from meeting SPARK restrictions. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 9e9cd19e30f..a767a25dbe5 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -289,6 +289,9 @@ package body Sem_Attr is -- Common processing for attributes Definite and Has_Discriminants. -- Checks that prefix is generic indefinite formal type. + procedure Check_Formal_Restriction_On_Attribute; + -- Issue an error in formal mode because attribute N is allowed + procedure Check_Integer_Type; -- Verify that prefix of attribute N is an integer type @@ -565,14 +568,7 @@ package body Sem_Attr is -- Start of processing for Analyze_Access_Attribute begin - -- Access attribute is not allowed in SPARK or ALFA - - if Formal_Verification_Mode and then Comes_From_Source (N) then - Error_Attr_P ("|~~% attribute is not allowed"); - end if; - - -- Proceed with analysis - + Check_Formal_Restriction_On_Attribute; Check_E0; if Nkind (P) = N_Character_Literal then @@ -1293,6 +1289,16 @@ package body Sem_Attr is Check_E2; end Check_Floating_Point_Type_2; + ------------------------------------------- + -- Check_Formal_Restriction_On_Attribute -- + ------------------------------------------- + + procedure Check_Formal_Restriction_On_Attribute is + begin + Error_Msg_Name_1 := Aname; + Check_Formal_Restriction ("attribute % is not allowed", P); + end Check_Formal_Restriction_On_Attribute; + ------------------------ -- Check_Integer_Type -- ------------------------ @@ -2454,6 +2460,12 @@ package body Sem_Attr is ("?redundant attribute, & is its own base type", N, Typ); end if; + if Nkind (Parent (N)) /= N_Attribute_Reference then + Error_Msg_Name_1 := Aname; + Check_Formal_Restriction + ("attribute% is only allowed as prefix of another attribute", P); + end if; + Set_Etype (N, Base_Type (Entity (P))); Set_Entity (N, Base_Type (Entity (P))); Rewrite (N, New_Reference_To (Entity (N), Loc)); @@ -3256,8 +3268,9 @@ package body Sem_Attr is when Attribute_Image => Image : begin - Set_Etype (N, Standard_String); + Check_Formal_Restriction_On_Attribute; 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 @@ -3862,6 +3875,14 @@ package body Sem_Attr is when Attribute_Pos => Check_Discrete_Type; Check_E1; + + if Is_Boolean_Type (P_Type) then + Error_Msg_Name_1 := Aname; + Error_Msg_Name_2 := Chars (P_Type); + Check_Formal_Restriction + ("attribute% is not allowed for type%", P); + end if; + Resolve (E1, P_Base_Type); Set_Etype (N, Universal_Integer); @@ -3880,6 +3901,14 @@ package body Sem_Attr is when Attribute_Pred => Check_Scalar_Type; Check_E1; + + if Is_Real_Type (P_Type) or else Is_Boolean_Type (P_Type) then + Error_Msg_Name_1 := Aname; + Error_Msg_Name_2 := Chars (P_Type); + Check_Formal_Restriction + ("attribute% is not allowed for type%", P); + end if; + Resolve (E1, P_Base_Type); Set_Etype (N, P_Base_Type); @@ -4414,6 +4443,14 @@ package body Sem_Attr is when Attribute_Succ => Check_Scalar_Type; Check_E1; + + if Is_Real_Type (P_Type) or else Is_Boolean_Type (P_Type) then + Error_Msg_Name_1 := Aname; + Error_Msg_Name_2 := Chars (P_Type); + Check_Formal_Restriction + ("attribute% is not allowed for type%", P); + end if; + Resolve (E1, P_Base_Type); Set_Etype (N, P_Base_Type); @@ -4731,6 +4768,14 @@ package body Sem_Attr is begin Check_E1; Check_Discrete_Type; + + if Is_Boolean_Type (P_Type) then + Error_Msg_Name_1 := Aname; + Error_Msg_Name_2 := Chars (P_Type); + Check_Formal_Restriction + ("attribute% is not allowed for type%", P); + end if; + Resolve (E1, Any_Integer); Set_Etype (N, P_Base_Type); @@ -4766,6 +4811,7 @@ package body Sem_Attr is when Attribute_Value => Value : begin + Check_Formal_Restriction_On_Attribute; Check_E1; Check_Scalar_Type; @@ -4828,6 +4874,7 @@ package body Sem_Attr is when Attribute_Wide_Image => Wide_Image : begin + Check_Formal_Restriction_On_Attribute; Check_Scalar_Type; Set_Etype (N, Standard_Wide_String); Check_E1; @@ -4854,6 +4901,7 @@ package body Sem_Attr is when Attribute_Wide_Value => Wide_Value : begin + Check_Formal_Restriction_On_Attribute; Check_E1; Check_Scalar_Type; @@ -4894,6 +4942,7 @@ package body Sem_Attr is ---------------- when Attribute_Wide_Width => + Check_Formal_Restriction_On_Attribute; Check_E0; Check_Scalar_Type; Set_Etype (N, Universal_Integer); @@ -4903,6 +4952,7 @@ package body Sem_Attr is ----------- when Attribute_Width => + Check_Formal_Restriction_On_Attribute; Check_E0; Check_Scalar_Type; Set_Etype (N, Universal_Integer); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 4e4ae9f01e5..fec4c900b70 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -584,8 +584,8 @@ package body Sem_Ch3 is -- given kind of type (index constraint to an array type, for example). procedure Modular_Type_Declaration (T : Entity_Id; Def : Node_Id); - -- Create new modular type. Verify that modulus is in bounds and is - -- a power of two (implementation restriction). + -- Create new modular type. Verify that modulus is in bounds + -- (implementation restriction). procedure New_Concatenation_Op (Typ : Entity_Id); -- Create an abbreviated declaration for an operator in order to @@ -16373,6 +16373,7 @@ package body Sem_Ch3 is -- Non-binary case elsif M_Val < 2 ** Bits then + Check_Formal_Restriction ("modulus should be a power of 2", T); Set_Non_Binary_Modulus (T); if Bits > System_Max_Nonbinary_Modulus_Power then @@ -17768,6 +17769,10 @@ package body Sem_Ch3 is begin Analyze_And_Resolve (R, Base_Type (T)); + if not Is_Static_Range (R) then + Check_Formal_Restriction ("range should be static", R); + end if; + if Nkind (R) = N_Range then Lo := Low_Bound (R); Hi := High_Bound (R); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 7c9f59be887..5915ed21b19 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -5827,6 +5827,10 @@ package body Sem_Ch8 is -- Base attribute, not allowed in Ada 83 elsif Attribute_Name (N) = Name_Base then + Error_Msg_Name_1 := Name_Base; + Check_Formal_Restriction + ("attribute% is only allowed as prefix of another attribute", N); + if Ada_Version = Ada_83 and then Comes_From_Source (N) then Error_Msg_N ("(Ada 83) Base attribute not allowed in subtype mark", N); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index a2dc2061376..34da37fa9f0 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9292,6 +9292,12 @@ package body Sem_Res is Hi : Uint; begin + if Is_Modular_Integer_Type (Typ) and then Nkind (N) /= N_Op_Not then + Error_Msg_Name_1 := Chars (Typ); + Check_Formal_Restriction + ("unary operator not defined for modular type%", N); + end if; + -- Deal with intrinsic unary operators if Comes_From_Source (N) -- 2.30.2