diff options
| author | Javier Miranda <miranda@adacore.com> | 2019-07-08 08:14:32 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-08 08:14:32 +0000 |
| commit | fa2538c77b94a62c657aee31a613ea29e6a46d4d (patch) | |
| tree | 78e0143b58e8943d97f6c4a1f33431c0f26fad67 /gcc/ada | |
| parent | 570d5bbc7b7c5f7eb0eb03660a93687a6698ae7e (diff) | |
| download | gcc-fa2538c77b94a62c657aee31a613ea29e6a46d4d.zip gcc-fa2538c77b94a62c657aee31a613ea29e6a46d4d.tar.gz gcc-fa2538c77b94a62c657aee31a613ea29e6a46d4d.tar.bz2 | |
[Ada] Wrong evaluation of membership test
The code generated by the compiler erroneously evaluates to True
membership tests when their left operand is a a class-wide interface
object and the right operand is a tagged type that implements such
interface type.
2019-07-08 Javier Miranda <miranda@adacore.com>
gcc/ada/
* exp_ch4.adb (Tagged_Membership): Fix regression silently
introduced in r260738 that erroneouslusy causes the evaluation
to True of the membership test when the left operand of the
membership test is a class-wide interface object and the right
operand is a type that implements such interface type.
gcc/testsuite/
* gnat.dg/interface10.adb: New testcase.
From-SVN: r273219
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 3 |
2 files changed, 10 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b122428..2692731 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-07-08 Javier Miranda <miranda@adacore.com> + + * exp_ch4.adb (Tagged_Membership): Fix regression silently + introduced in r260738 that erroneouslusy causes the evaluation + to True of the membership test when the left operand of the + membership test is a class-wide interface object and the right + operand is a type that implements such interface type. + 2019-07-08 Hristian Kirtchev <kirtchev@adacore.com> * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Do not diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 78b5028..eb35845 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -14156,7 +14156,8 @@ package body Exp_Ch4 is -- Obj1 in DT'Class; -- Compile time error -- Obj1 in Iface'Class; -- Compile time error - if not Is_Class_Wide_Type (Left_Type) + if not Is_Interface (Left_Type) + and then not Is_Class_Wide_Type (Left_Type) and then (Is_Ancestor (Etype (Right_Type), Left_Type, Use_Full_View => True) or else (Is_Interface (Etype (Right_Type)) |