PR fortran/23373: Early modification of pointer target

[Richard Sandiford <richard at codesourcery dot com>]

The PR reports a failure for code like:

    program main
      implicit none
      real, dimension (:), pointer :: x
      x => null ()
      x => test (x)
    contains
      function test (p)
        real, dimension (:), pointer :: p, test
        if (associated (p)) call abort
        allocate (test (10))
        if (associated (p)) call abort
      end function test
    end program main

We pass x's descriptor as the result argument to test(), so allocate()
modifies x prematurely.

I wondered at first if this sort of situation could be detected by
gfc_check_fncall_dependency.  Unfortunately, I don't think it's tight
enough, because it doesn't handle cases in which x is accessed directly:

    program main
      implicit none
      real, dimension (:), pointer :: x
      x => null ()
      x => test ()
    contains
      function test
        real, dimension (:), pointer :: test
        if (associated (x)) call abort
        allocate (test (10))
        if (associated (x)) call abort
      end function test
    end program main

I wasn't 100% sure whether this test was valid or not, but I haven't
read anything in the standard that forbids it, and Tobi confirms that
it works with the Intel and the Portland Group compilers (thanks).

I also think this might be a generic problem with
gfc_check_fncall_dependency.  For example:

    program main
      integer, dimension (2) :: x
      x = (/ 1, 2 /)
      x = foo ()
      if (sum (x) .ne. 103) call abort
    contains
      function foo
        integer, dimension (2) :: foo
        foo (1) = 100
        foo (2) = sum (x)
      end function
    end program main

fails for the same reason, and I think this case is explicitly allowed:

    7.5.1.5     Interpretation of intrinsic assignments

    Execution of an intrinsic assignment causes, in effect, the evaluation
    of the expression expr and all expressions within variable (7.1.7), the
    possible conversion of expr to the type and type parameters of variable
    (Table 7.10), and the definition of variable with the resulting
    value. The execution of the assignment shall have the same effect as if
    the evaluation of all operations in expr and variable occurred before
    any portion of variable is defined by the assignment. The evaluation of
    expressions within variable shall neither affect nor be affected by the
    evaluation of expr.  [...]

So perhaps the most correct fix would be to make gfc_check_fncall_dependency
more robust and then use it for pointer assignments as well as intrinsic
assignments.  However, I'm not confident that I know how catch all cases.
(What about common, etc?)

I think the safest 4.1 fix for pointer assignment is to assume that any
function call can read the destination of the assignment.  We can make
the callee assign to a temporary descriptor variable, then copy the
contents of that descriptor variable to the pointer.  This is easy
enough to do, as per the patch below.

Note that the missed optimisation opportunity has nothing like the
overhead that it would have had for non-pointer assignments, because
no temporary array data is involved.  We're simply using a temporary
on-stack descriptor variable (a few bytes) and then doing a block copy
of that temporary variable to the pointer.  It seems likely that the
effect would not be measurable for most real-world uses of array
pointer functions.

Bootstrapped & regression tested on i686-pc-linux-gnu.  OK to install?

Richard


gcc/fortran/
	PR fortran/23373
	* trans-expr.c (gfc_trans_pointer_assignment): Assign to a temporary
	descriptor if the rhs is not a null pointer or variable.

gcc/testsuite/
	PR fortran/23373
	* gfortran.fortran-torture/execute/pr23373-1.f90,
	* gfortran.fortran-torture/execute/pr23373-1.f90: New tests.

Index: gcc/fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.57
diff -c -p -F^\([(a-zA-Z0-9_]\|#define\) -r1.57 trans-expr.c
*** gcc/fortran/trans-expr.c 16 Aug 2005 12:58:46 -0000 1.57
--- gcc/fortran/trans-expr.c 8 Sep 2005 08:27:56 -0000
*************** gfc_trans_pointer_assignment (gfc_expr *
*** 2041,2046 ****
--- 2041,2048 ----
    gfc_ss *lss;
    gfc_ss *rss;
    stmtblock_t block;
+   tree desc;
+   tree tmp;
  
    gfc_start_block (&block);
  
*************** gfc_trans_pointer_assignment (gfc_expr *
*** 2068,2080 ****
      {
        /* Array pointer.  */
        gfc_conv_expr_descriptor (&lse, expr1, lss);
!       /* Implement Nullify.  */
!       if (expr2->expr_type == EXPR_NULL)
! 	gfc_conv_descriptor_data_set (&block, lse.expr, null_pointer_node);
!       else
!         {
            lse.direct_byref = 1;
!           gfc_conv_expr_descriptor (&lse, expr2, rss);
          }
        gfc_add_block_to_block (&block, &lse.pre);
        gfc_add_block_to_block (&block, &lse.post);
--- 2070,2099 ----
      {
        /* Array pointer.  */
        gfc_conv_expr_descriptor (&lse, expr1, lss);
!       switch (expr2->expr_type)
! 	{
! 	case EXPR_NULL:
! 	  /* Just set the data pointer to null.  */
! 	  gfc_conv_descriptor_data_set (&block, lse.expr, null_pointer_node);
! 	  break;
! 
! 	case EXPR_VARIABLE:
! 	  /* Assign directly to the pointer's descriptor.  */
            lse.direct_byref = 1;
! 	  gfc_conv_expr_descriptor (&lse, expr2, rss);
! 	  break;
! 
! 	default:
! 	  /* Assign to a temporary descriptor and then copy that
! 	     temporary to the pointer.  */
! 	  desc = lse.expr;
! 	  tmp = gfc_create_var (TREE_TYPE (desc), "ptrtemp");
! 
! 	  lse.expr = tmp;
! 	  lse.direct_byref = 1;
! 	  gfc_conv_expr_descriptor (&lse, expr2, rss);
! 	  gfc_add_modify_expr (&lse.pre, desc, tmp);
! 	  break;
          }
        gfc_add_block_to_block (&block, &lse.pre);
        gfc_add_block_to_block (&block, &lse.post);
diff -c /dev/null gcc/testsuite/gfortran.fortran-torture/execute/pr23373-1.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.fortran-torture/execute/pr23373-1.f90	2005-09-07 18:01:34.000000000 +0100
***************
*** 0 ****
--- 1,15 ----
+ program main
+   implicit none
+   real, dimension (:), pointer :: x
+   x => null ()
+   x => test (x)
+   if (.not. associated (x)) call abort
+   if (size (x) .ne. 10) call abort
+ contains
+   function test (p)
+     real, dimension (:), pointer :: p, test
+     if (associated (p)) call abort
+     allocate (test (10))
+     if (associated (p)) call abort
+   end function test
+ end program main
diff -c /dev/null gcc/testsuite/gfortran.fortran-torture/execute/pr23373-2.f90
*** /dev/null	2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.fortran-torture/execute/pr23373-2.f90	2005-09-07 18:03:08.000000000 +0100
***************
*** 0 ****
--- 1,15 ----
+ program main
+   implicit none
+   real, dimension (:), pointer :: x
+   x => null ()
+   x => test ()
+   if (.not. associated (x)) call abort
+   if (size (x) .ne. 10) call abort
+ contains
+   function test
+     real, dimension (:), pointer :: test
+     if (associated (x)) call abort
+     allocate (test (10))
+     if (associated (x)) call abort
+   end function test
+ end program main