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
This commit is contained in:
parent
7b65808d33
commit
991b4da122
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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" } }
|
Loading…
Reference in New Issue