aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorPaul Thomas <pault@gcc.gnu.org>2010-04-24 09:28:32 +0000
committerPaul Thomas <pault@gcc.gnu.org>2010-04-24 09:28:32 +0000
commit991b4da12247eb3e688e47f393229cc098bc7cea (patch)
treef478c03fe05157ce3c385681dcb888a51104ffd8 /gcc
parent7b65808d33edf19143af6d0f272cf126f87ca147 (diff)
downloadgcc-991b4da12247eb3e688e47f393229cc098bc7cea.zip
gcc-991b4da12247eb3e688e47f393229cc098bc7cea.tar.gz
gcc-991b4da12247eb3e688e47f393229cc098bc7cea.tar.bz2
re PR fortran/43841 (Missing temporary for ELEMENTAL function call)
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-24 Paul Thomas <pault@gcc.gnu.org> PR fortran/43841 PR fortran/43843 * gfortran.dg/elemental_scalar_args_1.f90 : New test. From-SVN: r158683
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog12
-rw-r--r--gcc/fortran/trans-array.c5
-rw-r--r--gcc/fortran/trans-expr.c8
-rw-r--r--gcc/fortran/trans.h5
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f9087
6 files changed, 116 insertions, 7 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1c77717..6072c05 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+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
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 199eb23..c3a92bc 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2054,9 +2054,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);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 42e1d34..dc138a3 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4541,6 +4541,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;
@@ -4661,9 +4663,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;
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 91f1b77..b332c8e 100644
--- a/gcc/fortran/trans.h
+++ b/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
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6e32296..d4331be 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-04-24 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/43841
+ PR fortran/43843
+ * gfortran.dg/elemental_scalar_args_1.f90 : New test.
+
2010-04-23 Manuel López-Ibáñez <manu@gcc.gnu.org>
* gcc.dg/Wconversion-integer.c: Update.
diff --git a/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90 b/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
new file mode 100644
index 0000000..d180bc9
--- /dev/null
+++ b/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" } }