OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/52585 (Wrong result for ASSOCIATED with dummy procedure pointer)

Browse Source 
2012-03-17  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52585
        * trans-intrinsic.c (gfc_conv_associated): Fix handling of
        procpointer dummy arguments.

2012-03-17  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52585
        * gfortran.dg/proc_ptr_36.f90: New.

From-SVN: r185485
This commit is contained in:
Tobias Burnus 2012-03-17 18:03:59 +01:00 committed by Tobias Burnus
parent 10c20ebd93
commit 4dc86aa8aa
4 changed files with 82 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2012-03-17 Tobias Burnus <burnus@net-b.de>
PR fortran/52585
* trans-intrinsic.c (gfc_conv_associated): Fix handling of
procpointer dummy arguments.
2012-03-16 Janne Blomqvist <jb@gcc.gnu.org>
* trans-intrinsic.c (build_round_expr): Don't use BUILT_IN_IROUND

33
gcc/fortran/trans-intrinsic.c
View File

@ -5761,10 +5761,14 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
/* No optional target. */
if (ss1 == gfc_ss_terminator)
{
/* A pointer to a scalar. */
arg1se.want_pointer = 1;
gfc_conv_expr (&arg1se, arg1->expr);
tmp2 = arg1se.expr;
/* A pointer to a scalar. */
arg1se.want_pointer = 1;
gfc_conv_expr (&arg1se, arg1->expr);
if (arg1->expr->symtree->n.sym->attr.proc_pointer
&& arg1->expr->symtree->n.sym->attr.dummy)
arg1se.expr = build_fold_indirect_ref_loc (input_location,
arg1se.expr);
tmp2 = arg1se.expr;
}
else
{
@ -5794,12 +5798,21 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
if (ss1 == gfc_ss_terminator)
{
/* A pointer to a scalar. */
gcc_assert (ss2 == gfc_ss_terminator);
arg1se.want_pointer = 1;
gfc_conv_expr (&arg1se, arg1->expr);
arg2se.want_pointer = 1;
gfc_conv_expr (&arg2se, arg2->expr);
/* A pointer to a scalar. */
gcc_assert (ss2 == gfc_ss_terminator);
arg1se.want_pointer = 1;
gfc_conv_expr (&arg1se, arg1->expr);
if (arg1->expr->symtree->n.sym->attr.proc_pointer
&& arg1->expr->symtree->n.sym->attr.dummy)
arg1se.expr = build_fold_indirect_ref_loc (input_location,
arg1se.expr);
arg2se.want_pointer = 1;
gfc_conv_expr (&arg2se, arg2->expr);
if (arg2->expr->symtree->n.sym->attr.proc_pointer
&& arg2->expr->symtree->n.sym->attr.dummy)
arg2se.expr = build_fold_indirect_ref_loc (input_location,
arg2se.expr);
gfc_add_block_to_block (&se->pre, &arg1se.pre);
gfc_add_block_to_block (&se->post, &arg1se.post);
tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2012-03-17 Tobias Burnus <burnus@net-b.de>
PR fortran/52585
* gfortran.dg/proc_ptr_36.f90: New.
2012-03-16 Martin Jambor <mjambor@suse.cz>
* gcc.dg/misaligned-expand-1.c: New test.

48
gcc/testsuite/gfortran.dg/proc_ptr_36.f90 Normal file
View File

@ -0,0 +1,48 @@
! { dg-do run }
!
! PR fortran/52585
!
! Test proc-pointer dummies with ASSOCIATE
!
! Contributed by Mat Cross of NAG
!
module m0
abstract interface
subroutine sub
end subroutine sub
end interface
interface
subroutine s(ss, isassoc)
import sub
logical :: isassoc
procedure(sub), pointer, intent(in) :: ss
end subroutine s
end interface
end module m0
use m0, only : sub, s
procedure(sub) :: sub2, pp
pointer :: pp
pp => sub2
if (.not. associated(pp)) call abort ()
if (.not. associated(pp,sub2)) call abort ()
call s(pp, .true.)
pp => null()
if (associated(pp)) call abort ()
if (associated(pp,sub2)) call abort ()
call s(pp, .false.)
end
subroutine s(ss, isassoc)
use m0, only : sub
logical :: isassoc
procedure(sub), pointer, intent(in) :: ss
procedure(sub) :: sub2
if (isassoc .neqv. associated(ss)) call abort ()
if (isassoc .neqv. associated(ss,sub2)) call abort ()
end subroutine s
subroutine sub2
end subroutine sub2
! { dg-final { cleanup-modules "m0" } }