From: Janus Weil Date: Tue, 29 Jun 2010 19:06:07 +0000 (+0200) Subject: re PR fortran/44696 ([OOP] ASSOCIATED fails on polymorphic variables) X-Git-Tag: upstream/12.2.0~91889 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=0e3b941e0cd49395c8a0de9047a868a42327b51e;p=platform%2Fupstream%2Fgcc.git re PR fortran/44696 ([OOP] ASSOCIATED fails on polymorphic variables) 2010-06-29 Janus Weil PR fortran/44696 * trans-intrinsic.c (gfc_conv_associated): Handle polymorphic variables passed as second argument of ASSOCIATED. 2010-06-29 Janus Weil PR fortran/44696 * gfortran.dg/associated_target_4.f90: New. From-SVN: r161554 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 34c8f64..a838747 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2010-06-29 Janus Weil + + PR fortran/44696 + * trans-intrinsic.c (gfc_conv_associated): Handle polymorphic variables + passed as second argument of ASSOCIATED. + 2010-06-29 Paul Thomas PR fortran/44582 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 9f63ebf..06fd538 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4416,6 +4416,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) else { /* An optional target. */ + if (arg2->expr->ts.type == BT_CLASS) + gfc_add_component_ref (arg2->expr, "$data"); ss2 = gfc_walk_expr (arg2->expr); nonzero_charlen = NULL_TREE; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6bdd576..5a23fe0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-06-29 Janus Weil + + PR fortran/44696 + * gfortran.dg/associated_target_4.f90: New. + 2010-06-29 Paul Thomas PR fortran/44582 diff --git a/gcc/testsuite/gfortran.dg/associated_target_4.f90 b/gcc/testsuite/gfortran.dg/associated_target_4.f90 new file mode 100644 index 0000000..24f3317 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_target_4.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! +! PR 44696: [OOP] ASSOCIATED fails on polymorphic variables +! +! Original test case by Hans-Werner Boschmann +! Modified by Janus Weil + +program rte1 + implicit none + type::node_type + class(node_type),pointer::parent,child + integer::id + end type node_type + class(node_type),pointer::root + allocate(root) + allocate(root%child) + root%child%parent=>root + root%id=1 + root%child%id=2 + print *,root%child%id," is child of ",root%id,":" + print *,root%child%parent%id,root%id + if (.not. associated(root%child%parent,root)) call abort() +end program rte1