expr.c (gfc_check_assign): Add comment.

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

testsuite/
* gfortran.dg/assignment_1.f90: New test.

From-SVN: r86585

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0d5e262ecbe3b02cd8b03460ebf56215956e6835..832c0457acede3db0ec7d338f12136bce57a4e4a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2004-08-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       * expr.c (gfc_check_assign): Add comment. Add new warning.
+       * trans-expr.c (gfc_conv_function_call): Correctly dereference
+       result of pointer valued function when not in pointer assignment.
+
 2004-08-25  Paul Brook  <paul@codesourcery.com>
 
        * config-lang.in: Remove dead commented line.

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 99db76d908c99dc6e1d84d6eb794b8e3d5838bd1..0539b6568acf9ad1eca6a79d1acc6df17e5d361c 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1797,10 +1797,19 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
       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)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cbf2dd1fb67462b514ca415b53ca661077dc84c7..b39aed9b50a5e262b2cfebd29b1ce278297517a3 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1170,6 +1170,13 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c65479da39661afa39ab77d5dd8b953147fe4840..4d5fcbfb8bbbba5f9c89009bf4056b0cc23d722f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2004-08-25  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
+       * gfortran.dg/assignment_1.f90: New test.
+
 2004-08-25  Adam Nemet  <anemet@lnxw.com>
 
        * g++.dg/template/repo3.C: New test.

diff --git a/gcc/testsuite/gfortran.dg/assignment_1.f90 b/gcc/testsuite/gfortran.dg/assignment_1.f90
new file mode 100644 (file)
index 0000000..c8018a3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assignment_1.f90
@@ -0,0 +1,36 @@
+! { 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.
+! This is PR 17192
+!!$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