OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Tobias Burnus 2013-03-26 15:51:56 +01:00 committed by Tobias Burnus
parent 795175513e
commit 0358013033
6 changed files with 119 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

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

43
gcc/fortran/simplify.c
View File

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

8
gcc/testsuite/ChangeLog
View File

@ -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.

7
gcc/testsuite/gfortran.dg/merge_char_1.f90
View File

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

3
gcc/testsuite/gfortran.dg/merge_char_3.f90
View File

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

58
gcc/testsuite/gfortran.dg/merge_init_expr_2.f90 Normal file
View File

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