Commit 162c21d9 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r207035
parent 08cd7c2f
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
......
......@@ -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);
......
......@@ -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.
......
......@@ -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;
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment