diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2017-01-06 11:03:36 +0000 |
|---|---|---|
| committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-01-06 12:03:36 +0100 |
| commit | 6eca51ce090586d67fe01897c848bb224142549f (patch) | |
| tree | b340effce88373fff5af0e2b3edde9115f90af08 /gcc/ada/checks.adb | |
| parent | 6413509bd47c3d3c2c9160d5d13a5d4f40903456 (diff) | |
| download | gcc-6eca51ce090586d67fe01897c848bb224142549f.zip gcc-6eca51ce090586d67fe01897c848bb224142549f.tar.gz gcc-6eca51ce090586d67fe01897c848bb224142549f.tar.bz2 | |
exp_ch5.adb (Get_Default_Iterator): For a derived type...
2017-01-06 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb (Get_Default_Iterator): For a derived type, the
alias of the inherited op is the parent iterator, no need to
examine dispatch table positions which might not be established
yet if type is not frozen.
* sem_disp.adb (Check_Controlling_Formals): The formal of a
predicate function may be a subtype of a tagged type.
* sem_ch3.adb (Complete_Private_Subtype): Adjust inheritance
of representation items for the completion of a type extension
where a predicate applies to the partial view.
* checks.ads, checks.adb (Apply_Predicate_Check): Add optional
parameter that designates function whose actual receives a
predicate check, to improve warning message when the check will
lead to infinite recursion.
* sem_res.adb (Resolve_Actuals): Pass additional parameter to
Apply_Predicate_Check.
From-SVN: r244132
Diffstat (limited to 'gcc/ada/checks.adb')
| -rw-r--r-- | gcc/ada/checks.adb | 19 |
1 files changed, 15 insertions, 4 deletions
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index d91d64b..83703b6 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -2605,7 +2605,11 @@ package body Checks is -- Apply_Predicate_Check -- --------------------------- - procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id) is + procedure Apply_Predicate_Check + (N : Node_Id; + Typ : Entity_Id; + Fun : Entity_Id := Empty) + is S : Entity_Id; begin @@ -2633,11 +2637,18 @@ package body Checks is -- is likely to be a common error, and thus deserves a warning. elsif Present (S) and then S = Predicate_Function (Typ) then - Error_Msg_N - ("predicate check includes a function call that " - & "requires a predicate check??", Parent (N)); + Error_Msg_NE + ("predicate check includes a call to& that " + & "requires a predicate check??", Parent (N), Fun); Error_Msg_N ("\this will result in infinite recursion??", Parent (N)); + + if Is_First_Subtype (Typ) then + Error_Msg_NE + ("\use an explicit subtype of& to carry the predicate", + Parent (N), Typ); + end if; + Insert_Action (N, Make_Raise_Storage_Error (Sloc (N), Reason => SE_Infinite_Recursion)); |