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

gcc/fortran/ChangeLog

+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

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

gcc/testsuite/ChangeLog

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

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

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

gcc/testsuite/gfortran.dg/merge_init_expr_2.f90

+! { 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" } }