diff mbox

[Fortran] PR56649 - do more simplification of MERGE

Message ID 515184A8.8030108@net-b.de
State New
Headers show

Commit Message

Tobias Burnus March 26, 2013, 11:21 a.m. UTC 
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

Comments

Mikael Morin March 26, 2013, 2:18 p.m. UTC | #1 
Le 26/03/2013 12:21, Tobias Burnus a écrit :
> First, I am woefully aware that there are 7 patches which still have to
> be reviewed (...), one by Mikael
>
If you are referring to
http://gcc.gnu.org/ml/fortran/2013-03/msg00008.html
the patch is now obsolete, so we are now at only 6 patches pending. :-)

> 
> 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. 
>
OK, except for the array case which makes sure that tsource and fsource
are constant arrays.

> Build on x86-64-gnu-linux.
> OK for the trunk?
> 
OK with the array gfc_get_parentheses removed.

Mikael
Tobias Burnus March 26, 2013, 3:26 p.m. UTC | #2 
Mikael Morin wrote:
> If you are referring to 
> http://gcc.gnu.org/ml/fortran/2013-03/msg00008.html the patch is now 
> obsolete, so we are now at only 6 patches pending. :-) 

Yes, I was thinking of those - as fix for the 4.6?/4.7/4.8 regression.

> OK with the array gfc_get_parentheses removed.

Thanks for the review - and well spotted that the "()" is pointless for 
an array constructor.

Tobias
diff mbox

Patch

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