| Message ID | 20150313113339.32440f8c@vepi2 |
|---|---|
| State | New |
| Headers | show |
Hello, Le 13/03/2015 11:33, Andre Vehreschild a écrit : > Hi all, > > this is another patch preventing a segfault. This time the segfault occurred, > when -fdump-(fortran|tree)-original was given with the program having an > implicit class set. The issue is that the _data component is assumed to be > present in a BT_CLASS w/o checking and trying to access the unlimited > polymorphic flag there. The patch fixes this by redirecting the access to the > flag to the correct position whether the _data component is present or not. > > Building a testcase for this is difficult for me. May be I am just blocked in > the head there. The issue occurred when trying to dump the > (fortran|tree)-original of the testcase gfortran.dg/implicit_class_1.f90. So > one could argue to add the flag to that testcase, but does it pay in contrast > to the additional effort each time the testsuite is executed? I have added the > test now, not being happy with it, but having no clue how to do it better. > > Bootstraps and regtests ok on x86_64-linux-gnu/F20. > > Ok, for trunk? > Comments below: b/gcc/fortran/symbol.c > index 32eea21..3379f47 100644 > --- a/gcc/fortran/symbol.c > +++ b/gcc/fortran/symbol.c (skipped) The beginning looks good. I suggest using 'ts->u.derived->attr.is_class' instead of 'strcmp (ts->u.derived.components->name, "_data") == 0'. No strong opinion, your choice. > @@ -4576,13 +4579,14 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) > if (is_derived1 && is_derived2) > return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived); > > - if (is_derived1 && is_class2) > + if (is_derived1 && is_class2 && ts2->u.derived->components) > return gfc_compare_derived_types (ts1->u.derived, > ts2->u.derived->components->ts.u.derived); > - if (is_class1 && is_derived2) > + if (is_class1 && is_derived2 && ts1->u.derived->components) > return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, > ts2->u.derived); > - else if (is_class1 && is_class2) > + else if (is_class1 && is_class2 && ts1->u.derived->components > + && ts2->u.derived->components) > return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, > ts2->u.derived->components->ts.u.derived); > else The above change don't seem right. In the case where the class container is missing, you want to use "ts->u.derived" instead of "ts->u.derived->components->ts.u.derived", not skip the procedure call entirely. > diff --git a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 > index 329f57a..fff1f2b 100644 > --- a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 > +++ b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 > @@ -4,6 +4,10 @@ > ! > ! Contributed by Reinhold Bader <Reinhold.Bader@lrz.de> > > +! Add dump-tree-original to check, if the patch preventing a gfortran > +! segfault is working correctly. > +! { dg-options "-fdump-tree-original" } > + -fdump-tree-original doesn't trigger any bug here. So use -fdump-fortran-original (I'm not sure the testsuite will like it). Mikael
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 320eb01..71721dd 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 + && ((strcmp (ts1->u.derived->components->name, "_data") == 0 + && 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 + && ((strcmp (ts2->u.derived->components->name, "_data") == 0 + && 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 32eea21..3379f47 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) + && ((strcmp (ts1->u.derived->components->name, "_data") == 0 + && 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) @@ -4576,13 +4579,14 @@ gfc_type_compatible (gfc_typespec *ts1, gfc_typespec *ts2) if (is_derived1 && is_derived2) return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived); - if (is_derived1 && is_class2) + if (is_derived1 && is_class2 && ts2->u.derived->components) return gfc_compare_derived_types (ts1->u.derived, ts2->u.derived->components->ts.u.derived); - if (is_class1 && is_derived2) + if (is_class1 && is_derived2 && ts1->u.derived->components) return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, ts2->u.derived); - else if (is_class1 && is_class2) + else if (is_class1 && is_class2 && ts1->u.derived->components + && ts2->u.derived->components) return gfc_type_is_extension_of (ts1->u.derived->components->ts.u.derived, ts2->u.derived->components->ts.u.derived); else diff --git a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 index 329f57a..fff1f2b 100644 --- a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 +++ b/gcc/testsuite/gfortran.dg/implicit_class_1.f90 @@ -4,6 +4,10 @@ ! ! Contributed by Reinhold Bader <Reinhold.Bader@lrz.de> +! Add dump-tree-original to check, if the patch preventing a gfortran +! segfault is working correctly. +! { dg-options "-fdump-tree-original" } + program upimp implicit class(foo) (a-b) implicit class(*) (c) @@ -33,3 +37,5 @@ contains implicit class(*) (a-z) end end program + +! { dg-final { cleanup-tree-dump "original" } }