From: Paul Thomas <pault@gcc.gnu.org>
Date: Mon, 31 Dec 2007 18:05:10 +0000 (+0000)
Subject: re PR fortran/34558 (ICE with same TYPE in both program and interface)
X-Git-Tag: releases/gcc-4.3.0~790
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=63287e10a8527f9ed9d7c3939943ab1bc66aa46b;p=thirdparty%2Fgcc.git

re PR fortran/34558 (ICE with same TYPE in both program and interface)

2007-12-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34558
	* interface.c (gfc_compare_types): Prevent linked lists from
	putting this function into an endless recursive loop.

2007-12-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34558
	* gfortran.dg/linked_list_1.f90: New test.

From-SVN: r131238
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 57574cee239b..8b92ad1aa318 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-12-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34558
+	* interface.c (gfc_compare_types): Prevent linked lists from
+	putting this function into an endless recursive loop.
+
 2007-12-26  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/34532
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b242d0707f88..717f3b78258d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -407,7 +407,17 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
       if (dt1->dimension && gfc_compare_array_spec (dt1->as, dt2->as) == 0)
 	return 0;
 
-      if (gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
+      /* Make sure that link lists do not put this function in an
+	 endless loop!  */
+      if (!(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
+	    && !(dt1->ts.type == BT_DERIVED && derived1 == dt1->ts.derived)
+	    && gfc_compare_types (&dt1->ts, &dt2->ts) == 0)
+	return 0;
+
+      else if (dt1->ts.type != BT_DERIVED
+		 || derived1 != dt1->ts.derived
+		 || dt2->ts.type != BT_DERIVED
+		 || derived2 != dt2->ts.derived)
 	return 0;
 
       dt1 = dt1->next;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7dd4fc04b859..c7a8e3e2ffe7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-12-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/34558
+	* gfortran.dg/linked_list_1.f90: New test.
+
 2007-12-29  Richard Sandiford  <rsandifo@nildram.co.uk>
 
 	* lib/objc.exp (objc_libgcc_s_path): Set objc_libgcc_s_path
diff --git a/gcc/testsuite/gfortran.dg/linked_list_1.f90 b/gcc/testsuite/gfortran.dg/linked_list_1.f90
new file mode 100644
index 000000000000..8066bcb39548
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/linked_list_1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! Regression. ICE on valid code.
+! The following worked with 4.1.3 and 4.2.2, but failed
+! (segmentation fault) with 4.3.0 because the type comparison
+! tried to comparethe types of the components of type(node), even
+! though the only component is of type(node).
+!
+! Found using the Fortran Company Fortran 90 Test Suite (Lite),
+! Version 1.4
+!
+! Reported by Tobias Burnus <burnus@gcc.gnu.org>
+!
+program error
+  implicit none
+  type node
+    sequence
+    type(node), pointer :: next
+  end type
+  type(node), pointer :: list
+
+  interface
+    subroutine insert(ptr)
+      implicit none
+      type node
+        sequence
+        type(node), pointer :: next
+      end type
+      type(node), pointer :: ptr
+    end subroutine insert
+  end interface
+  allocate (list);
+end program error