From 4d45d495663618e45f0a0baa481b74ee7a87a597 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 15 Nov 2008 17:26:13 +0000 Subject: [PATCH] re PR fortran/37926 (Program gives wrong output (connected to char len)) 2008-11-15 Paul Thomas PR fortran/37926 * trans-expr.c (gfc_add_interface_mapping): Transfer the formal arglist and the always_explicit attribute if the dummy arg is a procedure. 2008-11-15 Paul Thomas PR fortran/37926 * gfortran.dg/dummy_procedure_3.f90: New test. From-SVN: r141890 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-expr.c | 9 +++++ gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/dummy_procedure_3.f90 | 40 +++++++++++++++++++ 4 files changed, 61 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/dummy_procedure_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c3b58b5312c..35466d42184 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-11-15 Paul Thomas + + PR fortran/37926 + * trans-expr.c (gfc_add_interface_mapping): Transfer the formal + arglist and the always_explicit attribute if the dummy arg is a + procedure. + 2008-11-14 Jerry DeLisle PR fortran/37988 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index a3265ace756..ff74928d63e 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1711,6 +1711,15 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping, new_sym->attr.flavor = sym->attr.flavor; new_sym->attr.function = sym->attr.function; + /* Ensure that the interface is available and that + descriptors are passed for array actual arguments. */ + if (sym->attr.flavor == FL_PROCEDURE) + { + copy_formal_args (new_sym, expr->symtree->n.sym); + new_sym->attr.always_explicit + = expr->symtree->n.sym->attr.always_explicit; + } + /* Create a fake symtree for it. */ root = NULL; new_symtree = gfc_new_symtree (&root, sym->name); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3ff73d29ab3..78a345a1eb3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-11-15 Paul Thomas + + PR fortran/37926 + * gfortran.dg/dummy_procedure_3.f90: New test. + 2008-11-15 Jakub Jelinek PR target/38123 diff --git a/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90 b/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90 new file mode 100644 index 00000000000..cde2f0166af --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dummy_procedure_3.f90 @@ -0,0 +1,40 @@ +! { dg-do run } +! PR37926 - the interface did not transfer the formal +! argument list for the call to 'asz' in the specification of 'p'. +! +! Contributed by Janus Weil +! +module m +contains + pure integer function mysize(a) + integer,intent(in) :: a(:) + mysize = size(a) + end function +end module + +program prog + use m + implicit none + character(3) :: str + integer :: i(3) = (/1,2,3/) + str = p(i,mysize) + if (len(str) .ne. 3) call abort + if (str .ne. "BCD") call abort +contains + function p(y,asz) + implicit none + integer :: y(:) + interface + pure integer function asz(c) + integer,intent(in) :: c(:) + end function + end interface + character(asz(y)) p + integer i + do i=1,asz(y) + p(i:i) = achar(iachar('A')+y(i)) + end do + end function +end +! { dg-final { cleanup-modules "m" } } + -- 2.30.2