diff options
| author | Andre Vehreschild <vehre@gmx.de> | 2015-04-28 21:03:01 +0200 |
|---|---|---|
| committer | Andre Vehreschild <vehre@gcc.gnu.org> | 2015-04-28 21:03:01 +0200 |
| commit | 77b7d71e793213a330ccb19dbf3c54323c656539 (patch) | |
| tree | 687628690dd631060e30c2ad86efe1d98649dc21 /gcc/fortran/symbol.c | |
| parent | f307500830e39dbab2e0bc904aecbfc1995216ac (diff) | |
| download | gcc-77b7d71e793213a330ccb19dbf3c54323c656539.zip gcc-77b7d71e793213a330ccb19dbf3c54323c656539.tar.gz gcc-77b7d71e793213a330ccb19dbf3c54323c656539.tar.bz2 | |
interface.c (gfc_compare_types): Check for unlimited polymorphism flag in the correct position indepent of the...
gcc/fortran/ChangeLog:
2015-04-28 Andre Vehreschild <vehre@gmx.de>
* interface.c (gfc_compare_types): Check for unlimited
polymorphism flag in the correct position indepent of the _data
component being present or not. This prevents a segfault, when
the _data component is not present.
* symbol.c (gfc_type_compatible): Same.
gcc/testsuite/ChangeLog:
2015-04-28 Andre Vehreschild <vehre@gmx.de>
* gfortran.dg/implicit_class_1.f90: Adding flag to check, if
segfault is fixed.
From-SVN: r222539
Diffstat (limited to 'gcc/fortran/symbol.c')
| -rw-r--r-- | gcc/fortran/symbol.c | 21 |
1 files changed, 16 insertions, 5 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 44392e8..b18608b 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4567,7 +4567,10 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) if (is_class1 && ts1->u.derived->components - && ts1->u.derived->components->ts.u.derived->attr.unlimited_polymorphic) + && ((ts1->u.derived->attr.is_class + && ts1->u.derived->components->ts.u.derived->attr + .unlimited_polymorphic) + || ts1->u.derived->attr.unlimited_polymorphic)) return 1; if (!is_derived1 && !is_derived2 && !is_class1 && !is_class2) @@ -4578,13 +4581,21 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) if (is_derived1 && is_class2) return gfc_compare_derived_types (ts1->u.derived, - ts2->u.derived->components->ts.u.derived); + ts2->u.derived->attr.is_class ? + ts2->u.derived->components->ts.u.derived + : ts2->u.derived); if (is_class1 && is_derived2) - return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, + return gfc_type_is_extension_of (ts1->u.derived->attr.is_class ? + ts1->u.derived->components->ts.u.derived + : ts1->u.derived, ts2->u.derived); else if (is_class1 && is_class2) - return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, - ts2->u.derived->components->ts.u.derived); + return gfc_type_is_extension_of (ts1->u.derived->attr.is_class ? + ts1->u.derived->components->ts.u.derived + : ts1->u.derived, + ts2->u.derived->attr.is_class ? + ts2->u.derived->components->ts.u.derived + : ts2->u.derived); else return 0; } |