From 28ed836457b3069ec6b248420784d8de7d650d30 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 1 Aug 2015 18:37:25 +0000 Subject: [PATCH] re PR fortran/67091 ([OOP] Bad result for type-bound procedures returning pointers to the intrinsic function ASSOCIATED) 2015-08-01 Paul Thomas PR fortran/67091 * trans-intrinsic.c (gfc_conv_associated): Add the pre and post blocks for the second argument to se. 2015-08-01 Paul Thomas PR fortran/67091 * gfortran.dg/associated_target_6.f03: New test From-SVN: r226464 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-intrinsic.c | 2 + gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/associated_target_6.f03 | 49 +++++++++++++++++++ 4 files changed, 62 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/associated_target_6.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e5b7681fa32..5bb70f1c68a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2015-08-01 Paul Thomas + + PR fortran/67091 + * trans-intrinsic.c (gfc_conv_associated): Add the pre and post + blocks for the second argument to se. + 2015-07-27 Thomas Schwinge * parse.c (parse_oacc_structured_block): Fix logic error. diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 967a74169c8..1aa299be21a 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6667,6 +6667,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) arg2se.expr); gfc_add_block_to_block (&se->pre, &arg1se.pre); gfc_add_block_to_block (&se->post, &arg1se.post); + gfc_add_block_to_block (&se->pre, &arg2se.pre); + gfc_add_block_to_block (&se->post, &arg2se.post); tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, arg1se.expr, arg2se.expr); tmp2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8117434d158..2bbe2a27bee 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-08-01 Paul Thomas + + PR fortran/67091 + * gfortran.dg/associated_target_6.f03: New test + 2015-08-01 Tom de Vries * gcc.dg/autopar/reduc-2char.c (init_arrays): Mark with attribute diff --git a/gcc/testsuite/gfortran.dg/associated_target_6.f03 b/gcc/testsuite/gfortran.dg/associated_target_6.f03 new file mode 100644 index 00000000000..15f795124c3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associated_target_6.f03 @@ -0,0 +1,49 @@ +! { dg-do run } +! Tests the fix for PR67091 in which the first call to associated +! gave a bad result because the 'target' argument was not being +! correctly handled. +! +! Contributed by 'FortranFan' on clf. +! https://groups.google.com/forum/#!topic/comp.lang.fortran/dN_tQA1Mu-I +! +module m + implicit none + private + type, public :: t + private + integer, pointer :: m_i + contains + private + procedure, pass(this), public :: iptr => getptr + procedure, pass(this), public :: setptr + end type t +contains + subroutine setptr( this, iptr ) + !.. Argument list + class(t), intent(inout) :: this + integer, pointer, intent(inout) :: iptr + this%m_i => iptr + return + end subroutine setptr + function getptr( this ) result( iptr ) + !.. Argument list + class(t), intent(in) :: this + !.. Function result + integer, pointer :: iptr + iptr => this%m_i + end function getptr +end module m + +program p + use m, only : t + integer, pointer :: i + integer, pointer :: j + type(t) :: foo + !.. create i with some value + allocate (i, source=42) + call foo%setptr (i) + if (.not.associated (i, foo%iptr())) call abort () ! Gave bad result. + if (.not.associated (foo%iptr(), i)) call abort () ! Was OK. + j => foo%iptr() + if (.not.associated (i, j)) call abort ! Was OK. +end program p -- 2.30.2