diff mbox series

PR fortran/91359 -- A function should return something

Message ID 20190806182424.GA9372@troutmask.apl.washington.edu
State New
Headers show
Series PR fortran/91359 -- A function should return something | expand

Commit Message

Steve Kargl Aug. 6, 2019, 6:24 p.m. UTC
The spaghetti code in PR fortran/91359 has a few gotos
to jump to different places.  In doing so, gfortran 
with generate a function that has a naked 'return'.
Namely,

foo ()
{
  logical(kind=4) __result_foo;

  goto __label_000002;
  __label_000001:;
  return;             /* <-- THIS IS BAD.  */
  __label_000002:;
  __result_foo = 0;
  if (!__result_foo) goto __label_000001;
  L.1:;
  return __result_foo;
  return __result_foo;
}

The attached patch avoids the naked 'return' by
adding the variable that is constructed from the 
the function name.  Namely,

foo ()
{
  logical(kind=4) __result_foo;

  goto __label_000002;
  __label_000001:;
  return __result_foo;    /* <-- THIS IS GOOD.  */
  __label_000002:;
  __result_foo = 0;
  if (!__result_foo) goto __label_000001;
  L.1:;
  return __result_foo;
  return __result_foo;
}

Regression tested on x86_64-*-freebsd.  OK to commit?

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.

Comments

Paul Richard Thomas Aug. 6, 2019, 7:16 p.m. UTC | #1
Hi Steve,

That certainly does the trick! OK to commit as far back as you have
the intestinal fortitude for.

Thanks

Paul

On Tue, 6 Aug 2019 at 19:24, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> The spaghetti code in PR fortran/91359 has a few gotos
> to jump to different places.  In doing so, gfortran
> with generate a function that has a naked 'return'.
> Namely,
>
> foo ()
> {
>   logical(kind=4) __result_foo;
>
>   goto __label_000002;
>   __label_000001:;
>   return;             /* <-- THIS IS BAD.  */
>   __label_000002:;
>   __result_foo = 0;
>   if (!__result_foo) goto __label_000001;
>   L.1:;
>   return __result_foo;
>   return __result_foo;
> }
>
> The attached patch avoids the naked 'return' by
> adding the variable that is constructed from the
> the function name.  Namely,
>
> foo ()
> {
>   logical(kind=4) __result_foo;
>
>   goto __label_000002;
>   __label_000001:;
>   return __result_foo;    /* <-- THIS IS GOOD.  */
>   __label_000002:;
>   __result_foo = 0;
>   if (!__result_foo) goto __label_000001;
>   L.1:;
>   return __result_foo;
>   return __result_foo;
> }
>
> Regression tested on x86_64-*-freebsd.  OK to commit?
>
> 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.
>
> --
> Steve
diff mbox series

Patch

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(revision 274121)
+++ gcc/fortran/trans-decl.c	(working copy)
@@ -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);
Index: gcc/testsuite/gfortran.dg/pr91359_1.f
===================================================================
--- gcc/testsuite/gfortran.dg/pr91359_1.f	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr91359_1.f	(working copy)
@@ -0,0 +1,17 @@ 
+! { dg do }
+! 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 'FAIL:  zero() returned .TRUE.'
+         stop 'OKAY:  zero() returned .FALSE.'
+      end
Index: gcc/testsuite/gfortran.dg/pr91359_2.f
===================================================================
--- gcc/testsuite/gfortran.dg/pr91359_2.f	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr91359_2.f	(working copy)
@@ -0,0 +1,17 @@ 
+! { dg do }
+! 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 'FAIL:  zero() returned .TRUE.'
+         stop 'OKAY:  zero() returned .FALSE.'
+      end