mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-22 21:31:19 +08:00
Code Issues Packages Projects Releases Wiki Activity

[Fortran] Fix result-variable handling of MODULE PROCEDURE (PR94348)

Browse Source 
PR fortran/94348
	* decl.c (gfc_match_submod_proc): Add result var to the
	proc's namespace.

	PR fortran/94348
	* gfortran.dg/module_procedure_3.f90: New.
This commit is contained in:
Tobias Burnus 2020-03-28 14:01:57 +01:00
parent 7981c06ae9
commit 3fb7f2fbd5
4 changed files with 50 additions and 5 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 @@
2020-03-28 Tobias Burnus <tobias@codesourcery.com>
PR fortran/94348
* decl.c (gfc_match_submod_proc): Add result var to the
proc's namespace.
2020-03-27 Tobias Burnus <tobias@codesourcery.com>
PR fortran/93957

17
gcc/fortran/decl.c
View File

@ -9699,13 +9699,20 @@ gfc_match_submod_proc (void)
if (get_proc_name (name, &sym, false))
return MATCH_ERROR;
/* Make sure that the result field is appropriately filled, even though
the result symbol will be replaced later on. */
/* Make sure that the result field is appropriately filled. */
if (sym->tlink && sym->tlink->attr.function)
{
if (sym->tlink->result
&& sym->tlink->result != sym->tlink)
sym->result= sym->tlink->result;
if (sym->tlink->result && sym->tlink->result != sym->tlink)
{
sym->result = sym->tlink->result;
if (!sym->result->attr.use_assoc)
{
gfc_symtree *st = gfc_new_symtree (&gfc_current_ns->sym_root,
sym->result->name);
st->n.sym = sym->result;
sym->result->refs++;
}
}
else
sym->result = sym;
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2020-03-28 Tobias Burnus <tobias@codesourcery.com>
PR fortran/94348
* gfortran.dg/module_procedure_3.f90: New.
2020-03-28 Patrick Palka <ppalka@redhat.com>
PR c++/94306

27
gcc/testsuite/gfortran.dg/module_procedure_3.f90 Normal file
View File

@ -0,0 +1,27 @@
! { dg-do run }
!
! PR fortran/94348
!
! Contributed by Damian Rouson
module foo_module
implicit none
interface
module function foo() result(bar)
implicit none
integer bar
end function
end interface
contains
module procedure foo
bar = 5
end procedure
end module
program main
use foo_module
implicit none
if (foo() /= 5) stop 1
end program main