From fbc7f9df71ac3c5dd63e014686ce9b3022f83f82 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Sat, 6 Nov 2010 18:58:11 +0100 Subject: [PATCH] re PR fortran/46330 ([OOP] ICE after revision 166368) 2010-11-06 Janus Weil PR fortran/46330 * trans-expr.c (gfc_trans_class_assign): Find 'vtab' symbol in correct namespace. 2010-11-06 Janus Weil PR fortran/46330 * gfortran.dg/class_27.f03: New. From-SVN: r166405 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-expr.c | 2 +- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/class_27.f03 | 67 ++++++++++++++++++++++++++ 4 files changed, 79 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/class_27.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cace0a310f1a..92be42993557 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-11-06 Janus Weil + + PR fortran/46330 + * trans-expr.c (gfc_trans_class_assign): Find 'vtab' symbol in correct + namespace. + 2010-11-05 Janus Weil PR fortran/45451 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 8da6cf0ef133..a95b421170aa 100644 --- 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 fc8fc748d02f..4577eb26dfae 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-11-06 Janus Weil + + PR fortran/46330 + * gfortran.dg/class_27.f03: New. + 2010-11-06 Nicola Pero 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 index 000000000000..c3a3c902eae6 --- /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 +! 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" } } -- 2.43.5