+2010-04-24 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-22 Richard Guenther <rguenther@suse.de>
PR fortran/43829
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);
/* 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;
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;
}
--- /dev/null
+! { 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" } }