+2014-01-24 Robert Dewar <dewar@adacore.com>
+
+ * checks.adb (Expr_Known_Valid): Result of fpt operator never
+ considered valid.
+
+2014-01-24 Eric Botcazou <ebotcazou@adacore.com>
+
+ * back_end.adb: Minor fix in comment.
+
+2014-01-24 Javier Miranda <miranda@adacore.com>
+
+ * sem_ch3.adb (Check_Abstract_Overriding): Code reestructuration
+ required to report the error in case of task types.
+
+2014-01-24 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_attr.adb: Additional index checking.
+
2014-01-24 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Update): Analyze
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);
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.
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;
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