Re: [Patch, Fortran] Prevent segfault with dump-*-original for implicit class expressions.

[Andre Vehreschild <vehre at gmx dot de>]

Hi Mikael, hi all,

Mikael, thanks for the comments. I have worked in your suggestions and the
patch now looks like the attached one. 

To get the testsuite accepting a dump-fortran-original, I had to insert a
dg-prune-output. Without the prune output, dejagnu was reporting excess errors.
The prune removes all output after the first Namespace: that starts the
fortran-dump. I am not that happy with it, because ICEs in the dump will not be
detected that way. But I could not find a better solution yet. Does anyone know
of a better way to solve this? Best would be to have the fortran dump go to a
file like all other dumps, but that is not scope of this patch.

Bootstraps and regtests ok on x86_64-linux-gnu/F21.

OK for trunk now?

Regards,
	Andre

On Sat, 25 Apr 2015 23:13:34 +0200
Mikael Morin <mikael.morin@sfr.fr> wrote:

> 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
> 


-- 
Andre Vehreschild * Email: vehre ad gmx dot de

Attachment: crashfix2_v2.clog
Description: Binary data

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 320eb01..d4c2629 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 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;
 }
diff --git a/gcc/testsuite/gfortran.dg/implicit_class_1.f90 b/gcc/testsuite/gfortran.dg/implicit_class_1.f90
index 329f57a..46516ca 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 <Reinhold.Bader@lrz.de>
 
+! 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:.*" }
+
 program upimp
   implicit class(foo) (a-b)
   implicit class(*) (c)