FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/77358 ([F08] deferred-length character function returns zero-length string)

Browse source 
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.

From-SVN: r239740
This commit is contained in:
Paul Thomas 2016-08-24 19:33:14 +00:00
parent c8cd469647
commit 88b8971f9c
4 changed files with 45 additions and 0 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 @@
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-23 Fritz Reese <fritzoreese@gmail.com>
* decl.c (gfc_match_structure_decl): Make gfc_structure_id static.

7
gcc/fortran/resolve.c
View file

@ -11884,6 +11884,13 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
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;

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2016-08-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/77358
* gfortran.dg/submodule_17.f08: New test.
2016-08-24 Michael Collison <michael.collison@linaro.org>
Michael Collison <michael.collison@arm.com>

27
gcc/testsuite/gfortran.dg/submodule_17.f08 Normal file
View file

@ -0,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