[multiple changes]
2012-10-01 Ed Schonberg <schonberg@adacore.com> * checks.adb (Apply_Predicate_Check): If the predicate is a static one and the operand is static, evaluate the predicate at compile time. * sem_eval.ads, sem_eval.adb (Eval_Static_Predicate_Check): new procedure, to evaluate a static predicate check whenever possible. * sem_res.adb (Resolve_Type_Conversion): Apply predicate check on the conversion if the target type has predicates. 2012-10-01 Vincent Pucci <pucci@adacore.com> * sem_dim.adb (Has_Symbols): Complain if parameter Symbol has been provided by the user in the dimension output call. From-SVN: r191921
This commit is contained in:
parent
a91e9ac73d
commit
804fc056d5
@ -1,3 +1,18 @@
|
||||
2012-10-01 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* checks.adb (Apply_Predicate_Check): If the predicate is a
|
||||
static one and the operand is static, evaluate the predicate at
|
||||
compile time.
|
||||
* sem_eval.ads, sem_eval.adb (Eval_Static_Predicate_Check): new
|
||||
procedure, to evaluate a static predicate check whenever possible.
|
||||
* sem_res.adb (Resolve_Type_Conversion): Apply predicate check
|
||||
on the conversion if the target type has predicates.
|
||||
|
||||
2012-10-01 Vincent Pucci <pucci@adacore.com>
|
||||
|
||||
* sem_dim.adb (Has_Symbols): Complain if parameter Symbol has been
|
||||
provided by the user in the dimension output call.
|
||||
|
||||
2012-10-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* checks.adb (Apply_Divide_Checks): New name for
|
||||
|
@ -2337,6 +2337,23 @@ package body Checks is
|
||||
(Sloc (N), Reason => SE_Infinite_Recursion));
|
||||
|
||||
else
|
||||
|
||||
-- If the predicate is a static predicate and the operand is
|
||||
-- static, the predicate must be evaluated statically. If the
|
||||
-- evaluation fails this is a static constraint error.
|
||||
|
||||
if Is_OK_Static_Expression (N) then
|
||||
if Present (Static_Predicate (Typ)) then
|
||||
if Eval_Static_Predicate_Check (N, Typ) then
|
||||
return;
|
||||
else
|
||||
Error_Msg_NE
|
||||
("static expression fails static predicate check on&",
|
||||
N, Typ);
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Insert_Action (N,
|
||||
Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
|
||||
end if;
|
||||
|
@ -2703,7 +2703,8 @@ package body Sem_Dim is
|
||||
-----------------
|
||||
|
||||
function Has_Symbols return Boolean is
|
||||
Actual : Node_Id;
|
||||
Actual : Node_Id;
|
||||
Actual_Str : Node_Id;
|
||||
|
||||
begin
|
||||
Actual := First (Actuals);
|
||||
@ -2711,16 +2712,49 @@ package body Sem_Dim is
|
||||
-- Look for a symbols parameter association in the list of actuals
|
||||
|
||||
while Present (Actual) loop
|
||||
if Nkind (Actual) = N_Parameter_Association
|
||||
-- Positional parameter association case when the actual is a
|
||||
-- string literal.
|
||||
|
||||
if Nkind (Actual) = N_String_Literal then
|
||||
Actual_Str := Actual;
|
||||
|
||||
-- Named parameter association case when the selector name is
|
||||
-- Symbol.
|
||||
|
||||
elsif Nkind (Actual) = N_Parameter_Association
|
||||
and then Chars (Selector_Name (Actual)) = Name_Symbol
|
||||
then
|
||||
Actual_Str := Explicit_Actual_Parameter (Actual);
|
||||
|
||||
-- Ignore all other cases
|
||||
|
||||
else
|
||||
Actual_Str := Empty;
|
||||
end if;
|
||||
|
||||
if Present (Actual_Str) then
|
||||
-- Return True if the actual comes from source or if the string
|
||||
-- of symbols doesn't have the default value (i.e. it is "").
|
||||
|
||||
return Comes_From_Source (Actual)
|
||||
or else
|
||||
String_Length
|
||||
(Strval (Explicit_Actual_Parameter (Actual))) /= 0;
|
||||
if Comes_From_Source (Actual)
|
||||
or else String_Length (Strval (Actual_Str)) /= 0
|
||||
then
|
||||
-- Complain only if the actual comes from source or if it
|
||||
-- hasn't been fully analyzed yet.
|
||||
|
||||
if Comes_From_Source (Actual)
|
||||
or else not Analyzed (Actual)
|
||||
then
|
||||
Error_Msg_N ("Symbol parameter should not be provided",
|
||||
Actual);
|
||||
Error_Msg_N ("\reserved for compiler use only", Actual);
|
||||
end if;
|
||||
|
||||
return True;
|
||||
|
||||
else
|
||||
return False;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
Next (Actual);
|
||||
|
@ -3249,6 +3249,37 @@ package body Sem_Eval is
|
||||
end if;
|
||||
end Eval_Slice;
|
||||
|
||||
---------------------------------
|
||||
-- Eval_Static_Predicate_Check --
|
||||
---------------------------------
|
||||
|
||||
function Eval_Static_Predicate_Check
|
||||
(N : Node_Id;
|
||||
Typ : Entity_Id) return Boolean
|
||||
is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Pred : constant List_Id := Static_Predicate (Typ);
|
||||
Test : Node_Id;
|
||||
begin
|
||||
if No (Pred) then
|
||||
return True;
|
||||
end if;
|
||||
|
||||
-- The static predicate is a list of alternatives in the proper format
|
||||
-- for an Ada 2012 membership test. If the argument is a literal, the
|
||||
-- membership test can be evaluated statically. The caller transforms
|
||||
-- a result of False into a static contraint error.
|
||||
|
||||
Test := Make_In (Loc,
|
||||
Left_Opnd => New_Copy_Tree (N),
|
||||
Right_Opnd => Empty,
|
||||
Alternatives => Pred);
|
||||
Analyze_And_Resolve (Test, Standard_Boolean);
|
||||
|
||||
return Nkind (Test) = N_Identifier
|
||||
and then Entity (Test) = Standard_True;
|
||||
end Eval_Static_Predicate_Check;
|
||||
|
||||
-------------------------
|
||||
-- Eval_String_Literal --
|
||||
-------------------------
|
||||
|
@ -317,6 +317,11 @@ package Sem_Eval is
|
||||
procedure Eval_Unary_Op (N : Node_Id);
|
||||
procedure Eval_Unchecked_Conversion (N : Node_Id);
|
||||
|
||||
function Eval_Static_Predicate_Check
|
||||
(N : Node_Id;
|
||||
Typ : Entity_Id) return Boolean;
|
||||
-- Evaluate a static predicate check applied to a scalar literal.
|
||||
|
||||
procedure Fold_Str (N : Node_Id; Val : String_Id; Static : Boolean);
|
||||
-- Rewrite N with a new N_String_Literal node as the result of the compile
|
||||
-- time evaluation of the node N. Val is the resulting string value from
|
||||
|
@ -9713,6 +9713,22 @@ package body Sem_Res is
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Ada 2012: if target type has predicates, the result requires a
|
||||
-- predicate check. If the context is a call to another predicate
|
||||
-- check we must prevent infinite recursion.
|
||||
|
||||
if Has_Predicates (Target_Typ) then
|
||||
if Nkind (Parent (N)) = N_Function_Call
|
||||
and then Present (Name (Parent (N)))
|
||||
and then Has_Predicates (Entity (Name (Parent (N))))
|
||||
then
|
||||
null;
|
||||
|
||||
else
|
||||
Apply_Predicate_Check (N, Target_Typ);
|
||||
end if;
|
||||
end if;
|
||||
end Resolve_Type_Conversion;
|
||||
|
||||
----------------------
|
||||
|
Loading…
x
Reference in New Issue
Block a user