diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-11-06 10:22:42 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-11-06 10:22:42 +0000 |
commit | aae8e59257dcb23d8c0935883ae8d6123242e318 (patch) | |
tree | b41ad66af2ac765d8c0d188a4f2e96c2fe27d1f4 | |
parent | f6aa36b95e2607c6fbeccb22230fc5dd9d8486d4 (diff) | |
download | gcc-upstream-aae8e59257dcb23d8c0935883ae8d6123242e318.tar.gz |
2012-11-06 Gary Dismukes <dismukes@adacore.com>
* exp_attr.adb (Expand_N_Attribute_Reference): Apply a predicate
check when evaluating the attribute Valid, and issue a warning
about infinite recursion when the check occurs within the
predicate function of the prefix's subtype.
* exp_ch4.adb (Expand_N_In): Remove test for Is_Discrete_Type
when we're checking that there's no predicate check function as a
condition for substituting a Valid check for a scalar membership
test (substitution should be suppressed for any kind of scalar
subtype with a predicate check). Also, don't emit a predicate
check when the right operand is a range.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@193228 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
-rw-r--r-- | gcc/ada/exp_attr.adb | 27 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 7 |
3 files changed, 45 insertions, 2 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e3c04aaeb24..7493c6d61a0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2012-11-06 Gary Dismukes <dismukes@adacore.com> + + * exp_attr.adb (Expand_N_Attribute_Reference): Apply a predicate + check when evaluating the attribute Valid, and issue a warning + about infinite recursion when the check occurs within the + predicate function of the prefix's subtype. + * exp_ch4.adb (Expand_N_In): Remove test for Is_Discrete_Type + when we're checking that there's no predicate check function as a + condition for substituting a Valid check for a scalar membership + test (substitution should be suppressed for any kind of scalar + subtype with a predicate check). Also, don't emit a predicate + check when the right operand is a range. + 2012-11-06 Robert Dewar <dewar@adacore.com> * par_sco.adb, bindgen.adb, exp_vfpt.adb, exp_vfpt.ads, exp_ch2.adb, diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 417bad98847..d94ae8896f2 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -27,6 +27,7 @@ with Atree; use Atree; with Checks; use Checks; with Einfo; use Einfo; with Elists; use Elists; +with Errout; use Errout; with Exp_Atag; use Exp_Atag; with Exp_Ch2; use Exp_Ch2; with Exp_Ch3; use Exp_Ch3; @@ -5608,6 +5609,32 @@ package body Exp_Attr is Rewrite (N, Make_Range_Test); end if; + -- If a predicate is present, then we do the predicate test, even if + -- within the predicate function (infinite recursion is warned about + -- in that case). + + declare + Pred_Func : constant Entity_Id := Predicate_Function (Ptyp); + + begin + if Present (Pred_Func) then + Rewrite (N, + Make_And_Then (Loc, + Left_Opnd => Relocate_Node (N), + Right_Opnd => Make_Predicate_Call (Ptyp, Pref))); + + -- If the attribute appears within the subtype's own predicate + -- function, then issue a warning that this will cause infinite + -- recursion. + + if Current_Scope = Pred_Func then + Error_Msg_N + ("attribute Valid requires a predicate check?", N); + Error_Msg_N ("\and will result in infinite recursion?", N); + end if; + end if; + end; + Analyze_And_Resolve (N, Standard_Boolean); Validity_Checks_On := Save_Validity_Checks_On; end Valid; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index ebdbcdeb316..d9bdebd2900 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5565,8 +5565,7 @@ package body Exp_Ch4 is -- Skip this for predicated types, where such expressions are a -- reasonable way of testing if something meets the predicate. - and then not (Is_Discrete_Type (Ltyp) - and then Present (Predicate_Function (Ltyp))) + and then not Present (Predicate_Function (Ltyp)) then Substitute_Valid_Check; return; @@ -6103,6 +6102,9 @@ package body Exp_Ch4 is -- If a predicate is present, then we do the predicate test, but we -- most certainly want to omit this if we are within the predicate -- function itself, since otherwise we have an infinite recursion! + -- The check should also not be emitted when testing against a range + -- (the check is only done when the right operand is a subtype; see + -- RM12-4.5.2 (28.1/3-30/3)). declare PFunc : constant Entity_Id := Predicate_Function (Rtyp); @@ -6110,6 +6112,7 @@ package body Exp_Ch4 is begin if Present (PFunc) and then Current_Scope /= PFunc + and then Nkind (Rop) /= N_Range then Rewrite (N, Make_And_Then (Loc, |