[Patch, fortran] PR43841 and PR43843 - Missing temporary for ELEMENTAL function call

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

This one can only be described as embarrassing!  GFC_SS_REFERENCEs
were being stored as a temporary but not by value.  Thus dependencies
like the one in the testcase were not correctly handled.  I decided to
keep GFC_SS_REFERENCE, rather than convert to GFC_SS_SCALAR, so that
the mechanism for elemental procedure arguments does not get messed up
by the special cases of the latter (WHERE blocks or indices).  It is
probably over prissy but it does not cost any more than an extra enum
value.

The testcase is the reporter's original, rather than Harald's
reduction; just to ensure that all variants of array normalisation to
a member work correctly.

Many thanks to Kyle for the report!

Bootstrapped and regtested on FC9/x86_64 - OK for trunk, 4.5, 4.4, & ...?

Regards

Paul

2010-04-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43841
	PR fortran/43843
	* trans-expr.c (gfc_conv_expr): Supply an address expression for
	GFC_SS_REFERENCE.
	(gfc_conv_expr_reference): Call gfc_conv_expr and return for
	GFC_SS_REFERENCE.
	* trans-array.c (gfc_add_loop_ss_code): Store the value rather
	than the address of a GFC_SS_REFERENCE.
	* trans.h : Change comment on GFC_SS_REFERENCE.

2010-04-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43841
	PR fortran/43843
	* gfortran.dg/elemental_scalar_args_1.f90 : New test.

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 158569)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_expr (gfc_se * se, gfc_expr * e
*** 4541,4546 ****
--- 4541,4548 ----
        /* Substitute a scalar expression evaluated outside the scalarization
           loop.  */
        se->expr = se->ss->data.scalar.expr;
+       if (se->ss->type == GFC_SS_REFERENCE)
+ 	se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
        se->string_length = se->ss->string_length;
        gfc_advance_se_ss_chain (se);
        return;
*************** gfc_conv_expr_reference (gfc_se * se, gf
*** 4661,4669 ****
    if (se->ss && se->ss->expr == expr
        && se->ss->type == GFC_SS_REFERENCE)
      {
!       se->expr = se->ss->data.scalar.expr;
!       se->string_length = se->ss->string_length;
!       gfc_advance_se_ss_chain (se);
        return;
      }
  
--- 4663,4671 ----
    if (se->ss && se->ss->expr == expr
        && se->ss->type == GFC_SS_REFERENCE)
      {
!       /* Returns a reference to the scalar evaluated outside the loop
! 	 for this case.  */
!       gfc_conv_expr (se, expr);
        return;
      }
  
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 158569)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_add_loop_ss_code (gfc_loopinfo * loo
*** 2054,2062 ****
  	  break;
  
  	case GFC_SS_REFERENCE:
! 	  /* Scalar reference.  Evaluate this now.  */
  	  gfc_init_se (&se, NULL);
! 	  gfc_conv_expr_reference (&se, ss->expr);
  	  gfc_add_block_to_block (&loop->pre, &se.pre);
  	  gfc_add_block_to_block (&loop->post, &se.post);
  
--- 2054,2063 ----
  	  break;
  
  	case GFC_SS_REFERENCE:
! 	  /* Scalar argument to elemental procedure.  Evaluate this
! 	     now.  */
  	  gfc_init_se (&se, NULL);
! 	  gfc_conv_expr (&se, ss->expr);
  	  gfc_add_block_to_block (&loop->pre, &se.pre);
  	  gfc_add_block_to_block (&loop->post, &se.post);
  
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h	(revision 158569)
--- gcc/fortran/trans.h	(working copy)
*************** typedef enum
*** 126,133 ****
       scalarization loop.  */
    GFC_SS_SCALAR,
  
!   /* Like GFC_SS_SCALAR except it evaluates a pointer to the expression.
!      Used for elemental function parameters.  */
    GFC_SS_REFERENCE,
  
    /* An array section.  Scalarization indices will be substituted during
--- 126,134 ----
       scalarization loop.  */
    GFC_SS_SCALAR,
  
!   /* Like GFC_SS_SCALAR it evaluates the expression outside the
!      loop. Is always evaluated as a reference to the temporary.
!      Used for elemental function arguments.  */
    GFC_SS_REFERENCE,
  
    /* An array section.  Scalarization indices will be substituted during
Index: gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90	(revision 0)
***************
*** 0 ****
--- 1,87 ----
+ ! { dg-do compile }
+ ! Test the fix for PR43843, in which the temporary for b(1) in
+ ! test_member was an indirect reference, rather then the value.
+ !
+ ! Contributed by Kyle Horne <horne.kyle@gmail.com>
+ ! Reported by Tobias Burnus <burnus@gcc.gno.org>
+ ! Reported by Harald Anlauf <anlauf@gmx.de> (PR43841)
+ !
+ module polar_mod
+   implicit none
+   complex, parameter :: i = (0.0,1.0)
+   real, parameter :: pi = 3.14159265359
+   real, parameter :: e = exp (1.0)
+   type :: polar_t
+     real :: l, th
+   end type
+   type(polar_t) :: one = polar_t (1.0, 0)
+   interface operator(/)
+     module procedure div_pp
+   end interface
+   interface operator(.ne.)
+     module procedure ne_pp
+   end interface
+ contains
+   elemental function div_pp(u,v) result(o)
+     type(polar_t), intent(in) :: u, v
+     type(polar_t) :: o
+     complex :: a, b, c
+     a = u%l*exp (i*u%th*pi)
+     b = v%l*exp (i*v%th*pi)
+     c = a/b
+     o%l = abs (c)
+     o%th = atan2 (imag (c), real (c))/pi
+   end function div_pp
+   elemental function ne_pp(u,v) result(o)
+     type(polar_t), intent(in) :: u, v
+     LOGICAL :: o
+     if (u%l .ne. v%l) then
+       o = .true.
+     else if (u%th .ne. v%th) then
+       o = .true.
+     else
+       o = .false.
+     end if
+   end function ne_pp
+ end module polar_mod
+ 
+ program main
+   use polar_mod
+   implicit none
+   call test_member
+   call test_other
+   call test_scalar
+   call test_real
+ contains
+   subroutine test_member
+     type(polar_t), dimension(3) :: b
+     b = polar_t (2.0,0.5)
+     b(:) = b(:)/b(1)
+     if (any (b .ne. one)) call abort   
+   end subroutine test_member
+   subroutine test_other
+     type(polar_t), dimension(3) :: b
+     type(polar_t), dimension(3) :: c
+     b = polar_t (3.0,1.0)
+     c = polar_t (3.0,1.0)
+     b(:) = b(:)/c(1)
+     if (any (b .ne. one)) call abort   
+   end subroutine test_other
+   subroutine test_scalar
+     type(polar_t), dimension(3) :: b
+     type(polar_t) :: c
+     b = polar_t (4.0,1.5)
+     c = b(1)
+     b(:) = b(:)/c
+     if (any (b .ne. one)) call abort   
+   end subroutine test_scalar
+   subroutine test_real
+     real,dimension(3) :: b
+     real :: real_one
+     b = 2.0
+     real_one = b(2)/b(1)
+     b(:) = b(:)/b(1)
+     if (any (b .ne. real_one)) call abort   
+   end subroutine test_real
+ end program main
+ ! { dg-final { cleanup-modules "polar_mod" } }