re PR fortran/56649 (ICE gfc_conv_structure with MERGE)
2013-03-26 Tobias Burnus <burnus@net-b.de> PR fortran/56649 * simplify.c (gfc_simplify_merge): Simplify more. 2013-03-26 Tobias Burnus <burnus@net-b.de> PR fortran/56649 * gfortran.dg/merge_init_expr_2.f90: New. * gfortran.dg/merge_char_1.f90: Modify test to stay a run-time test. * gfortran.dg/merge_char_3.f90: Ditto. From-SVN: r197109
This commit is contained in:
parent
795175513e
commit
0358013033
|
@ -1,3 +1,8 @@
|
|||
2013-03-26 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/56649
|
||||
* simplify.c (gfc_simplify_merge): Simplify more.
|
||||
|
||||
2013-03-25 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/38536
|
||||
|
|
|
@ -3976,12 +3976,47 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg)
|
|||
gfc_expr *
|
||||
gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
|
||||
{
|
||||
if (tsource->expr_type != EXPR_CONSTANT
|
||||
|| fsource->expr_type != EXPR_CONSTANT
|
||||
|| mask->expr_type != EXPR_CONSTANT)
|
||||
gfc_expr * result;
|
||||
gfc_constructor *tsource_ctor, *fsource_ctor, *mask_ctor;
|
||||
|
||||
if (mask->expr_type == EXPR_CONSTANT)
|
||||
return gfc_get_parentheses (gfc_copy_expr (mask->value.logical
|
||||
? tsource : fsource));
|
||||
|
||||
if (!mask->rank || !is_constant_array_expr (mask)
|
||||
|| !is_constant_array_expr (tsource) || !is_constant_array_expr (fsource))
|
||||
return NULL;
|
||||
|
||||
return gfc_copy_expr (mask->value.logical ? tsource : fsource);
|
||||
result = gfc_get_array_expr (tsource->ts.type, tsource->ts.kind,
|
||||
&tsource->where);
|
||||
if (tsource->ts.type == BT_DERIVED)
|
||||
result->ts.u.derived = tsource->ts.u.derived;
|
||||
else if (tsource->ts.type == BT_CHARACTER)
|
||||
result->ts.u.cl = tsource->ts.u.cl;
|
||||
|
||||
tsource_ctor = gfc_constructor_first (tsource->value.constructor);
|
||||
fsource_ctor = gfc_constructor_first (fsource->value.constructor);
|
||||
mask_ctor = gfc_constructor_first (mask->value.constructor);
|
||||
|
||||
while (mask_ctor)
|
||||
{
|
||||
if (mask_ctor->expr->value.logical)
|
||||
gfc_constructor_append_expr (&result->value.constructor,
|
||||
gfc_copy_expr (tsource_ctor->expr),
|
||||
NULL);
|
||||
else
|
||||
gfc_constructor_append_expr (&result->value.constructor,
|
||||
gfc_copy_expr (fsource_ctor->expr),
|
||||
NULL);
|
||||
tsource_ctor = gfc_constructor_next (tsource_ctor);
|
||||
fsource_ctor = gfc_constructor_next (fsource_ctor);
|
||||
mask_ctor = gfc_constructor_next (mask_ctor);
|
||||
}
|
||||
|
||||
result->shape = gfc_get_shape (1);
|
||||
gfc_array_size (result, &result->shape[0]);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -1,3 +1,11 @@
|
|||
2013-03-26 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/56649
|
||||
* gfortran.dg/merge_init_expr_2.f90: New.
|
||||
* gfortran.dg/merge_char_1.f90: Modify test to
|
||||
stay a run-time test.
|
||||
* gfortran.dg/merge_char_3.f90: Ditto.
|
||||
|
||||
2013-03-26 Paolo Carlini <paolo.carlini@oracle.com>
|
||||
|
||||
* g++.dg/cpp0x/constexpr-friend-2.C: New.
|
||||
|
|
|
@ -4,6 +4,13 @@
|
|||
! PR 15327
|
||||
! The merge intrinsic didn't work for strings
|
||||
character*2 :: c(2)
|
||||
logical :: ll(2)
|
||||
|
||||
ll = (/ .TRUE., .FALSE. /)
|
||||
c = merge( (/ "AA", "BB" /), (/ "CC", "DD" /), ll )
|
||||
if (c(1).ne."AA" .or. c(2).ne."DD") call abort ()
|
||||
|
||||
c = ""
|
||||
c = merge( (/ "AA", "BB" /), (/ "CC", "DD" /), (/ .TRUE., .FALSE. /) )
|
||||
if (c(1).ne."AA" .or. c(2).ne."DD") call abort ()
|
||||
end
|
||||
|
|
|
@ -12,7 +12,8 @@ subroutine foo(a)
|
|||
implicit none
|
||||
character(len=*) :: a
|
||||
character(len=3) :: b
|
||||
print *, merge(a,b,.true.) ! Unequal character lengths
|
||||
logical :: ll = .true.
|
||||
print *, merge(a,b,ll) ! Unequal character lengths
|
||||
end subroutine foo
|
||||
|
||||
call foo("ab")
|
||||
|
|
|
@ -0,0 +1,58 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-fdump-tree-original" }
|
||||
!
|
||||
! PR fortran/56649
|
||||
! MERGE was not properly compile-time simplified
|
||||
!
|
||||
! Contributed by Bill Long
|
||||
!
|
||||
module m
|
||||
implicit none
|
||||
|
||||
integer, parameter :: int32 = 4
|
||||
type MPI_Datatype
|
||||
integer :: i
|
||||
end type MPI_Datatype
|
||||
|
||||
integer,private,parameter :: dik = kind(0)
|
||||
type(MPI_Datatype),parameter,private :: MPIx_I4 = MPI_Datatype( 1275069467)
|
||||
type(MPI_Datatype),parameter,private :: MPIx_I8 = MPI_Datatype( 1275070491)
|
||||
type(MPI_Datatype),parameter :: MPI_INTEGER = merge(MPIx_I4, MPIx_I8, &
|
||||
dik==int32)
|
||||
contains
|
||||
subroutine foo
|
||||
integer :: check1
|
||||
check1 = MPI_INTEGER%i
|
||||
end subroutine foo
|
||||
end module m
|
||||
|
||||
module m2
|
||||
implicit none
|
||||
integer, parameter :: int32 = 4
|
||||
type MPI_Datatype
|
||||
integer :: i
|
||||
end type MPI_Datatype
|
||||
|
||||
integer,private,parameter :: dik = kind(0)
|
||||
type(MPI_Datatype),parameter,private :: MPIx_I4 = MPI_Datatype( 1275069467)
|
||||
type(MPI_Datatype),parameter,private :: MPIx_I8 = MPI_Datatype( 1275070491)
|
||||
type(MPI_Datatype),parameter :: MPI_INTEGER(1) = merge([MPIx_I4], [MPIx_I8], &
|
||||
[dik==int32])
|
||||
contains
|
||||
subroutine foo
|
||||
logical :: check2
|
||||
check2 = MPI_INTEGER(1)%i == 1275069467
|
||||
end subroutine foo
|
||||
end module m2
|
||||
|
||||
|
||||
subroutine test
|
||||
character(len=3) :: one, two, three
|
||||
logical, parameter :: true = .true.
|
||||
three = merge (one, two, true)
|
||||
end subroutine test
|
||||
|
||||
! { dg-final { scan-tree-dump-times "check1 = 1275069467;" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "check2 = 1;" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "__builtin_memmove ..void .. &three, .void .. &one, 3.;" 1 "original" } }
|
||||
! { dg-final { cleanup-tree-dump "original" } }
|
Loading…
Reference in New Issue