From: Tobias Burnus <burnus@net-b.de>
Date: Sat, 21 Jan 2012 16:11:47 +0000 (+0100)
Subject: re PR fortran/51913 ([OOP] bug when submitting a class pointer to a subroutine)
X-Git-Tag: releases/gcc-4.6.3~157
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=7e1cbc7e91d19031d071b51d1a0f4c8722917436;p=thirdparty%2Fgcc.git

re PR fortran/51913 ([OOP] bug when submitting a class pointer to a subroutine)

2012-01-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51913
        * interface.c (compare_parameter): Fix CLASS comparison.

2012-01-21  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51913
        * gfortran.dg/class_47.f90: New.

From-SVN: r183369
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ac998ee9c573..952b289aae92 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51913
+	* interface.c (compare_parameter): Fix CLASS comparison.
+
 2012-01-19  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/51904
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index eece7f45d82e..cc7eef75d9f0 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1535,7 +1535,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return 0;
     }
     
-  /* F2003, 12.5.2.5.  */
+  /* F2008, 12.5.2.5.  */
   if (formal->ts.type == BT_CLASS
       && (CLASS_DATA (formal)->attr.class_pointer
           || CLASS_DATA (formal)->attr.allocatable))
@@ -1547,8 +1547,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 			formal->name, &actual->where);
 	  return 0;
 	}
-      if (CLASS_DATA (actual)->ts.u.derived
-	  != CLASS_DATA (formal)->ts.u.derived)
+      if (!gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
+				      CLASS_DATA (formal)->ts.u.derived))
 	{
 	  if (where)
 	    gfc_error ("Actual argument to '%s' at %L must have the same "
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7964bf4a925a..3e29ef59bb5c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-21  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/51913
+	* gfortran.dg/class_47.f90: New.
+
 2012-01-21  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/renaming5.ad[sb]: New test.
diff --git a/gcc/testsuite/gfortran.dg/class_47.f90 b/gcc/testsuite/gfortran.dg/class_47.f90
new file mode 100644
index 000000000000..90a7560bc5ee
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_47.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+!
+! PR fortran/51913
+!
+! Contributed by Alexander Tismer
+!
+MODULE m_sparseMatrix
+
+  implicit none
+  
+  type :: sparseMatrix_t
+
+  end type sparseMatrix_t
+END MODULE m_sparseMatrix
+
+!===============================================================================
+module m_subroutine
+!  USE m_sparseMatrix !< when uncommenting this line program works fine
+
+  implicit none
+
+  contains
+  subroutine test(matrix)
+    use m_sparseMatrix
+    class(sparseMatrix_t), pointer :: matrix
+  end subroutine
+end module
+
+!===============================================================================
+PROGRAM main
+  use m_subroutine
+  USE m_sparseMatrix
+  implicit none
+
+  CLASS(sparseMatrix_t), pointer :: sparseMatrix
+  
+  call test(sparseMatrix)
+END PROGRAM
+
+! { dg-final { cleanup-modules "m_sparsematrix m_subroutine" } }