diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 2 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/class_27.f03 | 67 |
4 files changed, 79 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cace0a310f1..92be4299355 100644 --- 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 8da6cf0ef13..a95b421170a 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 fc8fc748d02..4577eb26dfa 100644 --- 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 index 00000000000..c3a3c902eae --- /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" } } |
