[Patch, fortran] pr77358 - [F08] deferred-length character function returns zero-length string
Paul Richard Thomas
paul.richard.thomas@gmail.com
Wed Aug 24 12:07:00 GMT 2016
Dear All,
The attached fixes this problem, bootstraps and regtests on FC21/x86_64.
OK for 6-branch and trunk?
Paul
2016-08-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/77358
* resolve.c (resolve_fl_procedure): Use the correct gfc_charlen
for deferred character length module procedures.
2016-08-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/77358
* gfortran.dg/submodule_17.f08: New test.
-------------- next part --------------
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 238840)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 11961,11966 ****
--- 11961,11973 ----
iface = sym->ts.interface;
sym->ts.interface = NULL;
+ /* Make sure that the result uses the correct charlen for deferred
+ length results. */
+ if (iface && sym->result
+ && iface->ts.type == BT_CHARACTER
+ && iface->ts.deferred)
+ sym->result->ts.u.cl = iface->ts.u.cl;
+
if (iface == NULL)
goto check_formal;
Index: gcc/testsuite/gfortran.dg/submodule_17.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_17.f08 (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_17.f08 (working copy)
***************
*** 0 ****
--- 1,27 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR77358, in which the wrong gfc_charlen was
+ ! being used for the result of 'get'.
+ !
+ ! Contributed by Damian Rouson <damian@sourceryinstitute.org>
+ !
+ module hello_interface
+ character(len=13) :: string="Hello, world!"
+ interface
+ module function get() result(result_string)
+ character(:), allocatable :: result_string
+ end function
+ end interface
+ end module
+
+ submodule(hello_interface) hello_implementation
+ contains
+ module function get() result(result_string)
+ character(:), allocatable :: result_string
+ result_string = string
+ end function
+ end submodule
+
+ use hello_interface
+ if (get() .ne. string) call abort
+ end
More information about the Gcc-patches
mailing list