Re: Functions returning pointers

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

Paul Brook wrote:
>>I.e. the compiler decides that the statement has no effect. Maybe it should
>>be *__result = ... in the original dump?
> 
> 
> Yes, that makes sense.
> I forgot to mention that pointers to character variables may already be broken 
> in ways not related to your patch :-\

I've made some headway into understanding how we handle types in trans-*, but
not yet enough to fix the underlying problem. Therefore I suggest to apply my
previous patch, with the corrected condition, as this is definitely an
enhancement. We could also error out in the byref case, that would be an
additional enhancement, but I assume that this case is seldom enough, there
don't seem to be PRs related to any of these problems.

Updated patch below, built and tested. Attached is a testcase which checks for
the warning and verifies that the dereferencing takes place.

- Tobi

2004-08-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>

	* expr.c (gfc_check_assign): Add comment. Add new warning.
	* tans-expr.c (gfc_conv_function_call): Correctly dereference
	result of pointer valued function when not in pointer assignment.

Index: expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/expr.c,v
retrieving revision 1.13
diff -u -p -r1.13 expr.c
--- expr.c      8 Aug 2004 12:28:25 -0000       1.13
+++ expr.c      25 Aug 2004 21:38:01 -0000
@@ -1797,10 +1797,19 @@ gfc_check_assign (gfc_expr * lvalue, gfc
       return FAILURE;
     }

+  /* This is a guaranteed segfault and possibly a typo: p = NULL()
+     instead of p => NULL()  */
   if (rvalue->expr_type == EXPR_NULL)
     gfc_warning ("NULL appears on right-hand side in assignment at %L",
                 &rvalue->where);

+  /* This is possibly a typo: x = f() instead of x => f()  */
+  if (gfc_option.warn_surprising
+      && rvalue->expr_type == EXPR_FUNCTION
+      && rvalue->symtree->n.sym->attr.pointer)
+    gfc_warning ("POINTER valued function appears on right-hand side of "
+                "assignment at %L", &rvalue->where);
+
   /* Check size of array assignments.  */
   if (lvalue->rank != 0 && rvalue->rank != 0
       && gfc_check_conformance ("Array assignment", lvalue, rvalue) != SUCCESS)
Index: trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.21
diff -u -p -r1.21 trans-expr.c
--- trans-expr.c        25 Aug 2004 16:50:07 -0000      1.21
+++ trans-expr.c        25 Aug 2004 21:38:02 -0000
@@ -1170,6 +1170,13 @@ gfc_conv_function_call (gfc_se * se, gfc
   se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
                     arglist, NULL_TREE);

+  /* If we have a pointer function, but we don't want a pointer, e.g.
+     something like
+        x = f()
+     where f is pointer valued, we have to dereference the result.  */
+  if (sym->attr.pointer && !se->want_pointer && !byref)
+    se->expr = gfc_build_indirect_ref (se->expr);
+
   /* A pure function may still have side-effects - it may modify its
      parameters.  */
   TREE_SIDE_EFFECTS (se->expr) = 1;

! { dg-do run }
! { dg-options -Wsurprising }
integer, pointer :: p
integer, target :: t, s

! The tests for character pointers are currently commented out,
! because they don't yet work correctly.
!!$character*5, pointer :: d
!!$character*5, target :: c, e

t = 1
p => s
! We didn't dereference the pointer in the following line.
p = f() ! { dg-warning "POINTER valued function" "" }
p = p+1
if (p.ne.2) call abort()
if (p.ne.s) call abort()

!!$! verify that we also dereference correctly the result of a function 
!!$! which returns its result by reference
!!$c = "Hallo"
!!$d => e
!!$d = g() !  dg-warning "POINTER valued function" "" 
!!$if (d.ne."Hallo") call abort()

contains
function f()
integer, pointer :: f
f => t
end function f
!!$function g()
!!$character, pointer :: g
!!$g => c
!!$end function g
end