This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR56649 - do more simplification of MERGE
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Tue, 26 Mar 2013 12:21:12 +0100
- Subject: [Patch, Fortran] PR56649 - do more simplification of MERGE
First, I am woefully aware that there are 7 patches which still have to
be reviewed, three by Thomas, two by Janne, one by Mikael and one by me
(value+optional). I try to find time for reviewing one or two - but
wouldn't mind if others contributed to the deed.
The attached patch fixes one of two issues into which MPICH runs. MERGE
didn't properly simplify valid constant expressions. With this patch,
for scalar constant MERGE, it only looks at the MASK value as more it
not required. For constant-expression arrays, it walks the constructor
and creates a new one, based on the truth value.
Note: The gfc_get_parentheses() is required in some context, e.g.
lbound(merge(i,i, .true.)) shall not not becomes lbound(i) but lbound(
(i) ) otherwise, the result might be wrong. I think there are more such
issues in simplify.c (and possible also in frontend-passes.c).
Build on x86-64-gnu-linux.
OK for the trunk?
Tobias
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.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index a0909a3..e1392a5 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -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 gfc_get_parentheses (result);
}
diff --git a/gcc/testsuite/gfortran.dg/merge_char_1.f90 b/gcc/testsuite/gfortran.dg/merge_char_1.f90
index 5974e8c..ece939e 100644
--- a/gcc/testsuite/gfortran.dg/merge_char_1.f90
+++ b/gcc/testsuite/gfortran.dg/merge_char_1.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/merge_char_3.f90 b/gcc/testsuite/gfortran.dg/merge_char_3.f90
index 498e3ec..1142141 100644
--- a/gcc/testsuite/gfortran.dg/merge_char_3.f90
+++ b/gcc/testsuite/gfortran.dg/merge_char_3.f90
@@ -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")
--- /dev/null 2013-03-26 09:17:16.160088642 +0100
+++ gcc/gcc/testsuite/gfortran.dg/merge_init_expr_2.f90 2013-03-26 11:48:40.226193293 +0100
@@ -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" } }