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> 2014-01-24 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Update): Analyze * sem_attr.adb (Analyze_Attribute, case 'Update): Analyze
......
...@@ -51,7 +51,7 @@ package body Back_End is ...@@ -51,7 +51,7 @@ package body Back_End is
flag_stack_check : Int; flag_stack_check : Int;
pragma Import (C, flag_stack_check); 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; save_argc : Nat;
pragma Import (C, save_argc); pragma Import (C, save_argc);
......
...@@ -5308,22 +5308,26 @@ package body Checks is ...@@ -5308,22 +5308,26 @@ package body Checks is
elsif Nkind_In (Expr, N_Type_Conversion, N_Qualified_Expression) then elsif Nkind_In (Expr, N_Type_Conversion, N_Qualified_Expression) then
return Expr_Known_Valid (Expression (Expr)); return Expr_Known_Valid (Expression (Expr));
-- The result of any operator is always considered valid, since we -- Case of expression is a non-floating-point operator. In this case we
-- assume the necessary checks are done by the operator. For operators -- can assume the result is valid the generated code for the operator
-- on floating-point operations, we must also check when the operation -- will include whatever checks are needed (e.g. range checks) to ensure
-- is the right-hand side of an assignment, or is an actual in a call. -- validity. This assumption does not hold for the floating-point case,
-- since floating-point operators can generate Infinite or NaN results
elsif Nkind (Expr) in N_Op then -- which are considered invalid.
if Is_Floating_Point_Type (Typ)
and then Validity_Check_Floating_Point -- Historical note: in older versions, the exemption of floating-point
and then (Nkind_In (Parent (Expr), N_Assignment_Statement, -- types from this assumption was done only in cases where the parent
N_Function_Call, -- was an assignment, function call or parameter association. Presumably
N_Parameter_Association)) -- the idea was that in other contexts, the result would be checked
then -- elsewhere, but this list of cases was missing tests (at least the
return False; -- N_Object_Declaration case, as shown by a reported missing validity
else -- check), and it is not clear why function calls but not procedure
return True; -- calls were tested for. It really seems more accurate and much
end if; -- 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 -- The result of a membership test is always valid, since it is true or
-- false, there are no other possibilities. -- false, there are no other possibilities.
......
...@@ -6097,6 +6097,52 @@ package body Sem_Attr is ...@@ -6097,6 +6097,52 @@ package body Sem_Attr is
Error_Attr Error_Attr
("others choice not allowed in attribute %", Comp); ("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 elsif Is_Record_Type (P_Type) then
Check_Component_Reference (Comp, P_Type); Check_Component_Reference (Comp, P_Type);
end if; end if;
......
...@@ -9684,18 +9684,17 @@ package body Sem_Ch3 is ...@@ -9684,18 +9684,17 @@ package body Sem_Ch3 is
elsif Is_Concurrent_Record_Type (T) elsif Is_Concurrent_Record_Type (T)
and then Present (Interfaces (T)) and then Present (Interfaces (T))
then then
-- The controlling formal of Subp must be of mode "out", -- If an inherited subprogram is implemented by a protected
-- "in out" or an access-to-variable to be overridden. -- 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 Ekind (Subp) /= E_Function
and then not Is_Predefined_Dispatching_Operation (Subp)
then then
if not Is_Predefined_Dispatching_Operation (Subp) Error_Msg_PT (T, Subp);
and then Is_Protected_Type
(Corresponding_Concurrent_Type (T))
then
Error_Msg_PT (T, Subp);
end if;
-- Some other kind of overriding failure -- 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