From: Andre Vehreschild Date: Tue, 28 Apr 2015 19:03:01 +0000 (+0200) Subject: interface.c (gfc_compare_types): Check for unlimited polymorphism flag in the correct... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=77b7d71e793213a330ccb19dbf3c54323c656539;p=gcc.git 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 * 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 * gfortran.dg/implicit_class_1.f90: Adding flag to check, if segfault is fixed. From-SVN: r222539 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d850ffbe19b..bb442325e8e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2015-04-28 Andre Vehreschild + + * 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. + 2015-04-27 Jim Wilson * Make-lang.in (fortran.mostlyclean): Remove gfortran and diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 320eb01809a..d4c26292fee 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -484,13 +484,24 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2) if (ts1->type == BT_VOID || ts2->type == BT_VOID) return 1; - if (ts1->type == BT_CLASS - && ts1->u.derived->components->ts.u.derived->attr.unlimited_polymorphic) + /* The _data component is not always present, therefore check for its + presence before assuming, that its derived->attr is available. + When the _data component is not present, then nevertheless the + unlimited_polymorphic flag may be set in the derived type's attr. */ + if (ts1->type == BT_CLASS && ts1->u.derived->components + && ((ts1->u.derived->attr.is_class + && ts1->u.derived->components->ts.u.derived->attr + .unlimited_polymorphic) + || ts1->u.derived->attr.unlimited_polymorphic)) return 1; /* F2003: C717 */ if (ts2->type == BT_CLASS && ts1->type == BT_DERIVED - && ts2->u.derived->components->ts.u.derived->attr.unlimited_polymorphic + && ts2->u.derived->components + && ((ts2->u.derived->attr.is_class + && ts2->u.derived->components->ts.u.derived->attr + .unlimited_polymorphic) + || ts2->u.derived->attr.unlimited_polymorphic) && (ts1->u.derived->attr.sequence || ts1->u.derived->attr.is_bind_c)) return 1; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 44392e8d191..b18608b9ab2 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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9606cfbf08c..1a018fa3a9e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-04-28 Andre Vehreschild + + * gfortran.dg/implicit_class_1.f90: Adding flag to check, if + segfault is fixed. + 2015-04-28 Bill Schmidt * gcc.dg/vect/vect-33.c: Remove spurious line. diff --git a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 index 329f57aaa12..64193daa161 100644 --- a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 +++ b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 @@ -4,6 +4,12 @@ ! ! Contributed by Reinhold Bader +! Add dump-fortran-original to check, if the patch preventing a gfortran +! segfault is working correctly. No cleanup needed, because the dump +! goes to stdout. +! { dg-options "-fdump-fortran-original" } +! { dg-prune-output "Namespace:.*-{42}" } + program upimp implicit class(foo) (a-b) implicit class(*) (c)