2010-11-06 Janus Weil <janus@gcc.gnu.org>

	PR fortran/46330
	* trans-expr.c (gfc_trans_class_assign): Find 'vtab' symbol in correct
	namespace.

2010-11-06  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/46330
	* gfortran.dg/class_27.f03: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@166405 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cace0a3..92be429 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-11-06  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/46330
+       * trans-expr.c (gfc_trans_class_assign): Find 'vtab' symbol in correct
+       namespace.
+
 2010-11-05  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/45451

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 8da6cf0..a95b421 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5925,7 +5925,7 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op)
          gcc_assert (vtab);
          rhs = gfc_get_expr ();
          rhs->expr_type = EXPR_VARIABLE;
-         gfc_find_sym_tree (vtab->name, NULL, 1, &st);
+         gfc_find_sym_tree (vtab->name, vtab->ns, 1, &st);
          rhs->symtree = st;
          rhs->ts = vtab->ts;
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fc8fc74..4577eb2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-11-06  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/46330
+       * gfortran.dg/class_27.f03: New.
+
 2010-11-06  Nicola Pero  <nicola.pero@meta-innovation.com>
 
        Fixed using the Objective-C 2.0 dot-syntax with self and super.

diff --git a/gcc/testsuite/gfortran.dg/class_27.f03 b/gcc/testsuite/gfortran.dg/class_27.f03
new file mode 100644 (file)
index 0000000..c3a3c90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_27.f03
@@ -0,0 +1,67 @@
+! { dg-do compile }
+!
+! PR 46330: [4.6 Regression] [OOP] ICE after revision 166368
+!
+! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
+! Taken from http://groups.google.com/group/comp.lang.fortran/browse_thread/thread/76f99e7fd4f3e772
+
+module type2_type 
+ implicit none 
+ type, abstract :: Type2 
+ end type Type2 
+end module type2_type 
+
+module extended2A_type 
+ use type2_type 
+ implicit none 
+ type, extends(Type2) :: Extended2A 
+    real(kind(1.0D0)) :: coeff1 = 1. 
+ contains 
+    procedure :: setCoeff1 => Extended2A_setCoeff1 
+ end type Extended2A 
+ contains 
+    function Extended2A_new(c1, c2) result(typePtr_) 
+       real(kind(1.0D0)), optional, intent(in) :: c1 
+       real(kind(1.0D0)), optional, intent(in) :: c2 
+       type(Extended2A), pointer  :: typePtr_ 
+       type(Extended2A), save, allocatable, target  :: type_ 
+       allocate(type_) 
+       typePtr_ => null() 
+       if (present(c1)) call type_%setCoeff1(c1) 
+       typePtr_ => type_ 
+       if ( .not.(associated (typePtr_))) then 
+          stop 'Error initializing Extended2A Pointer.' 
+       endif 
+    end function Extended2A_new 
+    subroutine Extended2A_setCoeff1(this,c1) 
+       class(Extended2A) :: this 
+       real(kind(1.0D0)), intent(in) :: c1 
+       this% coeff1 = c1 
+    end subroutine Extended2A_setCoeff1 
+end module extended2A_type 
+
+module type1_type 
+ use type2_type 
+ implicit none 
+ type Type1 
+    class(type2), pointer :: type2Ptr => null() 
+ contains 
+    procedure :: initProc => Type1_initProc 
+ end type Type1 
+ contains 
+    function Type1_initProc(this) result(iError) 
+       use extended2A_type 
+       implicit none 
+       class(Type1) :: this 
+       integer :: iError 
+          this% type2Ptr => extended2A_new() 
+          if ( .not.( associated(this% type2Ptr))) then 
+             iError = 1 
+             write(*,'(A)') "Something Wrong." 
+          else 
+             iError = 0 
+          endif 
+    end function Type1_initProc 
+end module type1_type
+
+! { dg-final { cleanup-modules "type2_type extended2A_type type1_type" } }