Re: Functions returning pointers

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

Paul Brook wrote:
> 
> This does show a gfortran bug, though possibly not the one you were originally 
> trying to demonstrate ;-)

Fix below, as you suggested off-list. I also added a warning which is enabled
with -Wsurprising. A testcase derived from (y)our example is attached.

Built and tested on i686-pc-linux. Ok?

- Tobi

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

	* expr.c (gfc_check_assign): Add comment, add warning in
	doubtful assignment.
	* trans-expr.c (gfc_conv_function_call): Dereference pointer
	result if not expecting pointer.

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      22 Aug 2004 22:09:55 -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 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.19
diff -u -p -r1.19 trans-expr.c
--- trans-expr.c        22 Aug 2004 20:01:22 -0000      1.19
+++ trans-expr.c        22 Aug 2004 22:09:58 -0000
@@ -1170,6 +1170,13 @@ gfc_conv_function_call (gfc_se * se, gfc
   se->expr = build (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)
+    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 }
integer, pointer :: p
integer, target :: t, s
t = 1
p => s
p = f() ! this assignment was compiled wrongly
p = p+1
if (p.ne.2) call abort()
if (p.ne.s) call abort()
contains
function f()
integer, pointer :: f
f => t
end function f
end