[gfortran] Cleanup handling of sym vs. sym->result was: Re: [Patch/gfortran]Fix for PR16939

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

Tobias Schlüter wrote:
> [ my original reply didn't make it to the list ]
> 
> THOMAS Paul Richard 169137 wrote:
> 
>>>Oh, and I'm wondering if I should have added 
>>>
>>>>!sym->attr.pointer to that
>>
>>
>>I think that your next remark is right.
> 
> 
> I'll look into this later today.

This is fixed in the attached patch together with a number of other cleanups,
made possible by my previous patch.  The combination of both implements what I
was saying here:

> Bleh, we need to make sure that every function has sym->result's properties
> set consistently with sym's properties.  That way we could do away with a lot
> of special cases.  There is code for this in resolve_formal_arglist but it
> doesn't handle everything, because all those special cases that are scattered
> around the code generation passes wouldn't be necessary then.

The necessary change to resolve.c was in the previous patch.  What is below is
the ensuing cleanup.  I also attached two more testcases which verify that
-ff2c works reliably.  I would have liked to test these testcases with both
-ff2c and -fno-f2c but I couldn't find a way of making the testsuite do this
without duplicating the testcases, so I left that to someone doing future work
on the testsuite.

Bubblestrapped and regtested, ok?

- Tobi

2005-05-11  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>

	* trans-expr.c (gfc_conv_variable): POINTER results don't need f2c
	calling conventions.  Look at sym instead of sym->result.
	* trans-types.c (gfc_sym_type): Remove workaround for frontend bug.
	Remove condition which is always false with workaround removed.
	(gfc_return_by_reference): Always look at sym, never at sym->result.

Index: trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.44
diff -u -p -r1.44 trans-expr.c
--- trans-expr.c	11 May 2005 14:52:27 -0000	1.44
+++ trans-expr.c	11 May 2005 16:50:52 -0000
@@ -366,7 +366,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr
       if (gfc_option.flag_f2c 
 	  && (sym->attr.function || sym->attr.result)
 	  && sym->ts.type == BT_COMPLEX
-	  && !sym->attr.dimension)
+	  && !sym->attr.dimension && !sym->attr.pointer)
 	se->expr = gfc_build_indirect_ref (se->expr);
 
       /* Dereference pointer variables.  */
@@ -1253,9 +1253,6 @@ gfc_conv_function_call (gfc_se * se, gfc
   se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
 		     arglist, NULL_TREE);
 
-  if (sym->result)
-    sym = sym->result;
-
   /* If we have a pointer function, but we don't want a pointer, e.g.
      something like
         x = f()
Index: trans-types.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-types.c,v
retrieving revision 1.42
diff -u -p -r1.42 trans-types.c
--- trans-types.c	10 May 2005 22:06:44 -0000	1.42
+++ trans-types.c	11 May 2005 16:50:53 -0000
@@ -1266,11 +1266,6 @@ gfc_sym_type (gfc_symbol * sym)
 	return TREE_TYPE (sym->backend_decl);
     }
 
-  /* The frontend doesn't set all the attributes for a function with an
-     explicit result value, so we use that instead when present.  */
-  if (sym->attr.function && sym->result)
-    sym = sym->result;
-
   type = gfc_typenode_for_spec (&sym->ts);
   if (gfc_option.flag_f2c
       && sym->attr.function
@@ -1297,7 +1292,7 @@ gfc_sym_type (gfc_symbol * sym)
 	  /* If this is a character argument of unknown length, just use the
 	     base type.  */
 	  if (sym->ts.type != BT_CHARACTER
-	      || !(sym->attr.dummy || sym->attr.function || sym->attr.result)
+	      || !(sym->attr.dummy || sym->attr.function)
 	      || sym->ts.cl->backend_decl)
 	    {
 	      type = gfc_get_nodesc_array_type (type, sym->as,
@@ -1465,17 +1460,13 @@ gfc_get_derived_type (gfc_symbol * deriv
 int
 gfc_return_by_reference (gfc_symbol * sym)
 {
-  gfc_symbol *result;
-
   if (!sym->attr.function)
     return 0;
 
-  result = sym->result ? sym->result : sym;
-
-  if (result->attr.dimension)
+  if (sym->attr.dimension)
     return 1;
 
-  if (result->ts.type == BT_CHARACTER)
+  if (sym->ts.type == BT_CHARACTER)
     return 1;
 
   /* Possibly return complex numbers by reference for g77 compatibility.
@@ -1484,7 +1475,7 @@ gfc_return_by_reference (gfc_symbol * sy
      require an explicit interface, as no compatibility problems can
      arise there.  */
   if (gfc_option.flag_f2c
-      && result->ts.type == BT_COMPLEX
+      && sym->ts.type == BT_COMPLEX
       && !sym->attr.intrinsic && !sym->attr.always_explicit)
     return 1;
   

! { dg-do run }
! { dg-options "-ff2c -O" }
! Verifies that complex pointer results work with -ff2c
! try all permutations of result clause in function yes/no
!                     and result clause in interface yes/no
! this is not possible in Fortran 77, but this exercises a previously
! buggy codepath
function c() result (r)
  common // z
  complex, pointer :: r
  complex, target :: z

  r=>z
end function c

function d()
  common // z
  complex, pointer :: d
  complex, target :: z

  d=>z
end function d

function e()
  common // z
  complex, pointer :: e
  complex, target :: z

  e=>z
end function e

function f() result(r)
  common // z
  complex, pointer :: r
  complex, target :: z

  r=>z
end function f

interface
   function c
     complex, pointer :: c
   end function c
end interface
interface
   function d
     complex, pointer :: d
   end function d
end interface
interface
   function e result(r)
     complex, pointer :: r
   end function e
end interface
interface
   function f result(r)
     complex, pointer :: r
   end function f
end interface

common // z
complex, target :: z
complex, pointer :: p

z = (1.,0.)
p => c()
z = (2.,0.)
if (p /= z) call abort ()

NULLIFY(p)
p => d()
z = (3.,0.)
if (p /= z) call abort ()

NULLIFY(p)
p => e()
z = (4.,0.)
if (p /= z) call abort ()

NULLIFY(p)
p => f()
z = (5.,0.)
if (p /= z) call abort ()
end


  

! { dg-do run }
! { dg-options "-ff2c -O" }
! Verifies that array results work with -ff2c
! try all permutations of result clause in function yes/no
!                     and result clause in interface yes/no
! this is not possible in Fortran 77, but this exercises a previously
! buggy codepath
function c() result (r)
  complex :: r(5)
  r = 0.
end function c

function d()
  complex :: d(5)
  d = 1.
end function d

subroutine test_without_result
interface
   function c
     complex :: c(5)
   end function c
end interface
interface
   function d
     complex :: d(5)
   end function d
end interface
complex z(5)
z = c()
if (any(z /= 0.)) call abort ()
z = d()
if (any(z /= 1.)) call abort ()
end subroutine test_without_result

subroutine test_with_result
interface
   function c result(r)
     complex :: r(5)
   end function c
end interface
interface
   function d result(r)
     complex :: r(5)
   end function d
end interface
complex z(5)
z = c()
if (any(z /= 0.)) call abort ()
z = d()
if (any(z /= 1.)) call abort ()
end subroutine test_with_result

call test_without_result
call test_with_result
end