re PR fortran/43841 (Missing temporary for ELEMENTAL function call)

2010-06-27  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-06-27  Paul Thomas  <pault@gcc.gnu.org>

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

From-SVN: r161472

gcc/fortran/ChangeLog

@@ -1,3 +1,15 @@
+2010-06-27  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-06-15  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/44536

gcc/fortran/trans-array.c

@@ -1983,9 +1983,10 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
 	  break;
 
 	case GFC_SS_REFERENCE:
-	  /* Scalar reference.  Evaluate this now.  */
+	  /* Scalar argument to elemental procedure.  Evaluate this
+	     now.  */
 	  gfc_init_se (&se, NULL);
-	  gfc_conv_expr_reference (&se, ss->expr);
+	  gfc_conv_expr (&se, ss->expr);
 	  gfc_add_block_to_block (&loop->pre, &se.pre);
 	  gfc_add_block_to_block (&loop->post, &se.post);
 

gcc/fortran/trans-expr.c

@@ -3903,6 +3903,8 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr)
       /* 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;
@@ -4023,9 +4025,9 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
   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);
+      /* Returns a reference to the scalar evaluated outside the loop
+	 for this case.  */
+      gfc_conv_expr (se, expr);
       return;
     }
 

gcc/fortran/trans.h

@@ -126,8 +126,9 @@ typedef enum
      scalarization loop.  */
   GFC_SS_SCALAR,
 
-  /* Like GFC_SS_SCALAR except it evaluates a pointer to the expression.
-     Used for elemental function parameters.  */
+  /* 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

gcc/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2010-06-27  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43841
+	PR fortran/43843
+	* gfortran.dg/elemental_scalar_args_1.f90 : New test.
+
 2010-06-27  Richard Guenther  <rguenther@suse.de>
 
 	PR tree-optimization/44683

gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90

@@ -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" } }