From: Arnaud Charlet Date: Wed, 6 Jul 2016 12:34:52 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=75e4e36dfe12f78efa61c071caf95ba9d5f4f722;p=gcc.git [multiple changes] 2016-07-06 Hristian Kirtchev * exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting. 2016-07-06 Arnaud Charlet * lib.adb (Check_Same_Extended_Unit): Prevent looping forever. * gnatbind.adb: Disable some consistency checks in codepeer mode, which are not needed. 2016-07-06 Ed Schonberg * sem_ch12.adb (Check_Fixed_Point_Actual): Add a warning when a formal fixed point type is instantiated with a type that has a user-defined arithmetic operations, but the generic has no corresponding formal functions. This is worth a warning because of the special semantics of fixed-point operators. From-SVN: r238043 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9a16f81a4ba..c52781752d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2016-07-06 Hristian Kirtchev + + * exp_attr.adb, sem_attr.adb, sem_ch13.adb: Minor reformatting. + +2016-07-06 Arnaud Charlet + + * lib.adb (Check_Same_Extended_Unit): Prevent looping forever. + * gnatbind.adb: Disable some consistency checks in codepeer mode, + which are not needed. + +2016-07-06 Ed Schonberg + + * sem_ch12.adb (Check_Fixed_Point_Actual): Add a warning when + a formal fixed point type is instantiated with a type that has + a user-defined arithmetic operations, but the generic has no + corresponding formal functions. This is worth a warning because + of the special semantics of fixed-point operators. + 2016-07-06 Bob Duff * sem_attr.adb (Analyze_Attribute): Allow any expression of diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 47cee2b6af2..04929b5aa57 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -3009,9 +3009,10 @@ package body Exp_Attr is when Attribute_Enum_Rep => Enum_Rep : declare Expr : Node_Id; + begin - -- Get the expression, which is X for Enum_Type'Enum_Rep (X) - -- or X'Enum_Rep. + -- Get the expression, which is X for Enum_Type'Enum_Rep (X) or + -- X'Enum_Rep. if Is_Non_Empty_List (Exprs) then Expr := First (Exprs); @@ -3019,8 +3020,8 @@ package body Exp_Attr is Expr := Pref; end if; - -- If the expression is an enumeration literal, it is - -- replaced by the literal value. + -- If the expression is an enumeration literal, it is replaced by the + -- literal value. if Nkind (Expr) in N_Has_Entity and then Ekind (Entity (Expr)) = E_Enumeration_Literal @@ -3029,8 +3030,8 @@ package body Exp_Attr is Make_Integer_Literal (Loc, Enumeration_Rep (Entity (Expr)))); -- If this is a renaming of a literal, recover the representation - -- of the original. If it renames an expression there is nothing - -- to fold. + -- of the original. If it renames an expression there is nothing to + -- fold. elsif Nkind (Expr) in N_Has_Entity and then Ekind (Entity (Expr)) = E_Constant @@ -3056,8 +3057,7 @@ package body Exp_Attr is -- might be an illegal conversion. else - Rewrite (N, - OK_Convert_To (Typ, Relocate_Node (Expr))); + Rewrite (N, OK_Convert_To (Typ, Relocate_Node (Expr))); end if; Set_Etype (N, Typ); diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb index 85f670716bd..51353773822 100644 --- a/gcc/ada/gnatbind.adb +++ b/gcc/ada/gnatbind.adb @@ -855,12 +855,15 @@ begin end; end if; - -- Perform consistency and correctness checks - - Check_Duplicated_Subunits; - Check_Versions; - Check_Consistency; - Check_Configuration_Consistency; + -- Perform consistency and correctness checks. Disable these in CodePeer + -- mode where we want to be more flexible. + + if not CodePeer_Mode then + Check_Duplicated_Subunits; + Check_Versions; + Check_Consistency; + Check_Configuration_Consistency; + end if; -- List restrictions that could be applied to this partition diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index b711c21f592..c4edc7f1ebb 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -38,6 +38,7 @@ with Csets; use Csets; with Einfo; use Einfo; with Fname; use Fname; with Nlists; use Nlists; +with Opt; use Opt; with Output; use Output; with Sinfo; use Sinfo; with Sinput; use Sinput; @@ -259,18 +260,22 @@ package body Lib is ------------------------------ function Check_Same_Extended_Unit (S1, S2 : Source_Ptr) return SEU_Result is - Sloc1 : Source_Ptr; - Sloc2 : Source_Ptr; - Sind1 : Source_File_Index; - Sind2 : Source_File_Index; - Inst1 : Source_Ptr; - Inst2 : Source_Ptr; - Unum1 : Unit_Number_Type; - Unum2 : Unit_Number_Type; - Unit1 : Node_Id; - Unit2 : Node_Id; - Depth1 : Nat; - Depth2 : Nat; + Max_Iterations : constant Nat := Maximum_Instantiations * 2; + -- Limit to prevent a potential infinite loop + + Counter : Nat := 0; + Depth1 : Nat; + Depth2 : Nat; + Inst1 : Source_Ptr; + Inst2 : Source_Ptr; + Sind1 : Source_File_Index; + Sind2 : Source_File_Index; + Sloc1 : Source_Ptr; + Sloc2 : Source_Ptr; + Unit1 : Node_Id; + Unit2 : Node_Id; + Unum1 : Unit_Number_Type; + Unum2 : Unit_Number_Type; begin if S1 = No_Location or else S2 = No_Location then @@ -435,7 +440,13 @@ package body Lib is return No; <> - null; + Counter := Counter + 1; + + -- Prevent looping forever + + if Counter > Max_Iterations then + raise Program_Error; + end if; end loop; end Check_Same_Extended_Unit; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index a05ad7e5532..3dec30ab0ed 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3742,6 +3742,7 @@ package body Sem_Attr is Check_E1; Check_Discrete_Type; Resolve (E1, P_Base_Type); + elsif not Is_Discrete_Type (Etype (P)) then Error_Attr_P ("prefix of % attribute must be of discrete type"); end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f21ebc52ba0..d600d277e21 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1105,6 +1105,12 @@ package body Sem_Ch12 is -- In Ada 2005, indicates partial parameterization of a formal -- package. As usual an other association must be last in the list. + procedure Check_Fixed_Point_Actual (Actual : Node_Id); + -- Warn if an actual fixed-point type has user-defined arithmetic + -- operations, but there is no corresponding formal in the generic, + -- in which case the predefined operations will be used. This merits + -- a warning because of the special semantics of fixed point ops. + procedure Check_Overloaded_Formal_Subprogram (Formal : Entity_Id); -- Apply RM 12.3(9): if a formal subprogram is overloaded, the instance -- cannot have a named association for it. AI05-0025 extends this rule @@ -1186,6 +1192,52 @@ package body Sem_Ch12 is end loop; end Check_Overloaded_Formal_Subprogram; + ------------------------------- + -- Check_Fixed_Point_Actual -- + ------------------------------- + + procedure Check_Fixed_Point_Actual (Actual : Node_Id) is + Typ : constant Entity_Id := Entity (Actual); + Prims : constant Elist_Id := Collect_Primitive_Operations (Typ); + Elem : Elmt_Id; + Formal : Node_Id; + + begin + -- Locate primitive operations of the type that are arithmetic + -- operations. + + Elem := First_Elmt (Prims); + while Present (Elem) loop + if Nkind (Node (Elem)) = N_Defining_Operator_Symbol then + + -- Check whether the generic unit has a formal subprogram of + -- the same name. This does not check types but is good enough + -- to justify a warning. + + Formal := First_Non_Pragma (Formals); + while Present (Formal) loop + if Nkind (Formal) = N_Formal_Concrete_Subprogram_Declaration + and then Chars (Defining_Entity (Formal)) = + Chars (Node (Elem)) + then + exit; + end if; + + Next (Formal); + end loop; + + if No (Formal) then + Error_Msg_Sloc := Sloc (Node (Elem)); + Error_Msg_NE + ("?instance does not use primitive operation&#", + Actual, Node (Elem)); + end if; + end if; + + Next_Elmt (Elem); + end loop; + end Check_Fixed_Point_Actual; + ------------------------------- -- Has_Fully_Defined_Profile -- ------------------------------- @@ -1613,6 +1665,10 @@ package body Sem_Ch12 is (Formal, Match, Analyzed_Formal, Assoc), Assoc); + if Is_Fixed_Point_Type (Entity (Match)) then + Check_Fixed_Point_Actual (Match); + end if; + -- An instantiation is a freeze point for the actuals, -- unless this is a rewritten formal package, or the -- formal is an Ada 2012 formal incomplete type. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index fc9c4c494bf..ccb323325f3 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1937,7 +1937,7 @@ package body Sem_Ch13 is if not Implementation_Defined_Aspect (A_Id) then Error_Msg_Name_1 := Nam; - -- Not allowed for renaming declarations. Examine original + -- Not allowed for renaming declarations. Examine the original -- node because a subprogram renaming may have been rewritten -- as a body.