From: Arnaud Charlet Date: Fri, 24 Jan 2014 14:35:45 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=162c21d9985ea765ff74de0a465a6119363f1dcd;p=gcc.git [multiple changes] 2014-01-24 Robert Dewar * checks.adb (Expr_Known_Valid): Result of fpt operator never considered valid. 2014-01-24 Eric Botcazou * back_end.adb: Minor fix in comment. 2014-01-24 Javier Miranda * sem_ch3.adb (Check_Abstract_Overriding): Code reestructuration required to report the error in case of task types. 2014-01-24 Ed Schonberg * sem_attr.adb: Additional index checking. From-SVN: r207035 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 03c982d08cd..c56b138767d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2014-01-24 Robert Dewar + + * checks.adb (Expr_Known_Valid): Result of fpt operator never + considered valid. + +2014-01-24 Eric Botcazou + + * back_end.adb: Minor fix in comment. + +2014-01-24 Javier Miranda + + * sem_ch3.adb (Check_Abstract_Overriding): Code reestructuration + required to report the error in case of task types. + +2014-01-24 Ed Schonberg + + * sem_attr.adb: Additional index checking. + 2014-01-24 Ed Schonberg * sem_attr.adb (Analyze_Attribute, case 'Update): Analyze diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index 0b8920db0b3..c2275df5970 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -51,7 +51,7 @@ package body Back_End is flag_stack_check : Int; pragma Import (C, flag_stack_check); - -- Indicates if stack checking is enabled, imported from decl.c + -- Indicates if stack checking is enabled, imported from misc.c save_argc : Nat; pragma Import (C, save_argc); diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index cdbe34e3a90..51acd293a91 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -5308,22 +5308,26 @@ package body Checks is elsif Nkind_In (Expr, N_Type_Conversion, N_Qualified_Expression) then return Expr_Known_Valid (Expression (Expr)); - -- The result of any operator is always considered valid, since we - -- assume the necessary checks are done by the operator. For operators - -- on floating-point operations, we must also check when the operation - -- is the right-hand side of an assignment, or is an actual in a call. - - elsif Nkind (Expr) in N_Op then - if Is_Floating_Point_Type (Typ) - and then Validity_Check_Floating_Point - and then (Nkind_In (Parent (Expr), N_Assignment_Statement, - N_Function_Call, - N_Parameter_Association)) - then - return False; - else - return True; - end if; + -- Case of expression is a non-floating-point operator. In this case we + -- can assume the result is valid the generated code for the operator + -- will include whatever checks are needed (e.g. range checks) to ensure + -- validity. This assumption does not hold for the floating-point case, + -- since floating-point operators can generate Infinite or NaN results + -- which are considered invalid. + + -- Historical note: in older versions, the exemption of floating-point + -- types from this assumption was done only in cases where the parent + -- was an assignment, function call or parameter association. Presumably + -- the idea was that in other contexts, the result would be checked + -- elsewhere, but this list of cases was missing tests (at least the + -- N_Object_Declaration case, as shown by a reported missing validity + -- check), and it is not clear why function calls but not procedure + -- calls were tested for. It really seems more accurate and much + -- safer to recognize that expressions which are the result of a + -- floating-point operator can never be assumed to be valid. + + elsif Nkind (Expr) in N_Op and then not Is_Floating_Point_Type (Typ) then + return True; -- The result of a membership test is always valid, since it is true or -- false, there are no other possibilities. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index b73749390bc..f880fe6138a 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6097,6 +6097,52 @@ package body Sem_Attr is Error_Attr ("others choice not allowed in attribute %", Comp); + elsif Is_Array_Type (P_Type) then + declare + Index : Node_Id; + Index_Type : Entity_Id; + + begin + if Nkind (First (Choices (Assoc))) /= N_Aggregate then + + -- Choices denote separate components of one- + -- dimensional array. + + Index_Type := First_Index (P_Type); + Index := First (Choices (Assoc)); + while Present (Index) loop + if Nkind (Index) = N_Range then + Analyze_And_Resolve ( + Low_Bound (Index), Etype (Index_Type)); + Analyze_And_Resolve ( + High_Bound (Index), Etype (Index_Type)); + + else + Analyze_And_Resolve (Index, Etype (Index_Type)); + end if; + Next (Index); + end loop; + + else + -- Choice is a sequence of indices for each dimension + + Index_Type := First_Index (P_Type); + Index := First (Expressions (First (Choices (Assoc)))); + while Present (Index_Type) + and then Present (Index) + loop + Analyze_And_Resolve (Index, Etype (Index_Type)); + Next_Index (Index_Type); + Next (Index); + end loop; + + if Present (Index) or else Present (Index_Type) then + Error_Msg_N ( + "dimension mismatch in index list", Assoc); + end if; + end if; + end; + elsif Is_Record_Type (P_Type) then Check_Component_Reference (Comp, P_Type); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0796fb4a2ac..da315deea41 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9684,18 +9684,17 @@ package body Sem_Ch3 is elsif Is_Concurrent_Record_Type (T) and then Present (Interfaces (T)) then - -- The controlling formal of Subp must be of mode "out", - -- "in out" or an access-to-variable to be overridden. + -- If an inherited subprogram is implemented by a protected + -- procedure or an entry, then the first parameter of the + -- inherited subprogram shall be of mode out or in out, or + -- an access-to-variable parameter (RM 9.4(11.9/3)) - if Ekind (First_Formal (Subp)) = E_In_Parameter + if Is_Protected_Type (Corresponding_Concurrent_Type (T)) + and then Ekind (First_Formal (Subp)) = E_In_Parameter and then Ekind (Subp) /= E_Function + and then not Is_Predefined_Dispatching_Operation (Subp) then - if not Is_Predefined_Dispatching_Operation (Subp) - and then Is_Protected_Type - (Corresponding_Concurrent_Type (T)) - then - Error_Msg_PT (T, Subp); - end if; + Error_Msg_PT (T, Subp); -- Some other kind of overriding failure