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

re PR fortran/91359 (logical function X returns .TRUE. - Warning: spaghetti code)

Browse Source 
2019-08-06  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/91359
	* trans-decl.c (gfc_generate_return): Ensure something is returned
	from a function.

2019-08-06  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/91359
	* gfortran.dg/pr91359_1.f: New test.
	* gfortran.dg/pr91359_2.f: Ditto.

From-SVN: r274149
This commit is contained in:
Steven G. Kargl 2019-08-06 21:32:09 +00:00
parent 1a3920654f
commit e0af8f52b1
5 changed files with 58 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 @@
2019-08-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91359
* trans-decl.c (gfc_generate_return): Ensure something is returned
from a function.
2019-08-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/42546

14
gcc/fortran/trans-decl.c
View File

@ -6449,6 +6449,20 @@ gfc_generate_return (void)
TREE_TYPE (result), DECL_RESULT (fndecl),
result);
}
else
{
/* If the function does not have a result variable, result is
NULL_TREE, and a 'return' is generated without a variable.
The following generates a 'return __result_XXX' where XXX is
the function name. */
if (sym == sym->result && sym->attr.function)
{
result = gfc_get_fake_result_decl (sym, 0);
result = fold_build2_loc (input_location, MODIFY_EXPR,
TREE_TYPE (result),
DECL_RESULT (fndecl), result);
}
}
}
return build1_v (RETURN_EXPR, result);

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2019-08-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91359
* gfortran.dg/pr91359_1.f: New test.
* gfortran.dg/pr91359_2.f: Ditto.
2019-08-06 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/42546

16
gcc/testsuite/gfortran.dg/pr91359_1.f Normal file
View File

@ -0,0 +1,16 @@
! { dg do run }
! PR fortran/91359
! Orginal code contributed by Brian T. Carcich <briantcarcich at gmail dot com>
!
logical function zero() result(a)
goto 2
1 return
2 a = .false.
if (.not.a) goto 1
return
end
program test_zero
logical zero
if (zero()) stop 1
end

16
gcc/testsuite/gfortran.dg/pr91359_2.f Normal file
View File

@ -0,0 +1,16 @@
! { dg do run }
! PR fortran/91359
! Orginal code contributed by Brian T. Carcich <briantcarcich at gmail dot com>
!
logical function zero() result(a)
goto 2
1 return
2 a = .false.
if (.not.a) goto 1
return
end
program test_zero
logical zero
if (zero()) stop 1
end