interface.c (gfc_compare_types): Check for unlimited polymorphism flag in the correct...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d850ffbe19b75b6ed434849aeb3a0870734cb4aa..bb442325e8ed729c13bba7baa38ceb58a12f1ea0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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.
+
 2015-04-27  Jim Wilson  <jim.wilson@linaro.org>
 
        * Make-lang.in (fortran.mostlyclean): Remove gfortran and

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 320eb01809ab19cd472bb7d1000fded64871adf1..d4c26292feee3fd67404754d968a75c5040fd284 100644 (file)
--- 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 44392e8d19104d14a36fb047bba7a7f92a6b9809..b18608b9ab226ef4d886d208ccddb0e90c5c416e 100644 (file)
--- 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 9606cfbf08c12eac5a8ab83c2f8d289eb78335f8..1a018fa3a9e9ee521d38f601d4f61ca119b78665 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-04-28  Andre Vehreschild  <vehre@gmx.de>
+
+       * gfortran.dg/implicit_class_1.f90: Adding flag to check, if
+       segfault is fixed.
+
 2015-04-28  Bill Schmidt  <wschmidt@linux.vnet.ibm.com>
 
        * 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 329f57aaa12ed8553245197cfec6e0d41bd86923..64193daa16145121670e35942fbb9b909eb3260f 100644 (file)
--- 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:.*-{42}" }
+
 program upimp
   implicit class(foo) (a-b)
   implicit class(*) (c)