re PR fortran/38718 (some simplifiers for elemental intrinsics missing; required…

re PR fortran/38718 (some simplifiers for elemental intrinsics missing; required for init expressions)

gcc/fortran:
2009-01-04  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/38718
        * simplify.c (gfc_simplify_merge): New.
        * intrinsic.h (gfc_simplify_merge): New prototype.
        * intrinsic.c (add_functions): Added simplification for MERGE.

gcc/testsuite:
2009-01-04  Daniel Franke  <franke.daniel@gmail.com>

        PR fortran/38718
        * gfortran.dg/merge_init_expr.f90: New.

From-SVN: r143053

gcc/fortran/ChangeLog

+2009-01-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/38718
+	* simplify.c (gfc_simplify_merge): New.
+	* intrinsic.h (gfc_simplify_merge): New prototype.
+	* intrinsic.c (add_functions): Added simplification for MERGE.
+
 2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
 
 	PR fortran/38536

gcc/fortran/intrinsic.c

@@ -1974,7 +1974,7 @@ add_functions (void)
   make_generic ("mclock8", GFC_ISYM_MCLOCK8, GFC_STD_GNU);
 
   add_sym_3 ("merge", GFC_ISYM_MERGE, CLASS_ELEMENTAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
-	     gfc_check_merge, NULL, gfc_resolve_merge,
+	     gfc_check_merge, gfc_simplify_merge, gfc_resolve_merge,
 	     ts, BT_REAL, dr, REQUIRED, fs, BT_REAL, dr, REQUIRED,
 	     msk, BT_LOGICAL, dl, REQUIRED);
 

gcc/fortran/intrinsic.h

@@ -270,6 +270,7 @@ gfc_expr *gfc_simplify_llt (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_log (gfc_expr *);
 gfc_expr *gfc_simplify_log10 (gfc_expr *);
 gfc_expr *gfc_simplify_logical (gfc_expr *, gfc_expr *);
+gfc_expr *gfc_simplify_merge (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_min (gfc_expr *);
 gfc_expr *gfc_simplify_minval (gfc_expr *, gfc_expr*, gfc_expr*);
 gfc_expr *gfc_simplify_max (gfc_expr *);

gcc/fortran/simplify.c

@@ -2619,6 +2619,18 @@ gfc_simplify_logical (gfc_expr *e, gfc_expr *k)
 }
 
 
+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)
+    return NULL;
+
+  return gfc_copy_expr (mask->value.logical ? tsource : fsource);
+}
+
+
 /* Selects bewteen current value and extremum for simplify_min_max
    and simplify_minval_maxval.  */
 static void

gcc/testsuite/ChangeLog

+2009-01-04  Daniel Franke  <franke.daniel@gmail.com>
+
+	PR fortran/38718
+	* gfortran.dg/merge_init_expr.f90: New.
+
 2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
 
 	PR fortran/38536

gcc/testsuite/gfortran.dg/merge_init_expr.f90

+! { dg-do "run" }
+!
+! Check simplification of MERGE.
+!
+
+  INTEGER, PARAMETER :: array(3) = [1, 2, 3]
+  LOGICAL, PARAMETER :: mask(3)  = [ .TRUE., .FALSE., .TRUE. ]
+
+  INTEGER, PARAMETER :: scalar_1 = MERGE (1, 0, .TRUE.)
+  INTEGER, PARAMETER :: scalar_2 = MERGE (0, 1, .FALSE.)
+
+  INTEGER, PARAMETER :: array_1(3) = MERGE (array, 0, .TRUE.)
+  INTEGER, PARAMETER :: array_2(3) = MERGE (array, 0, .FALSE.)
+  INTEGER, PARAMETER :: array_3(3) = MERGE (0, array, .TRUE.)
+  INTEGER, PARAMETER :: array_4(3) = MERGE (0, array, .FALSE.)
+  INTEGER, PARAMETER :: array_5(3) = MERGE (1, 0, mask)
+  INTEGER, PARAMETER :: array_6(3) = MERGE (array, -array, mask)
+
+  INTEGER, PARAMETER :: array_7(3) = MERGE ([1,2,3], -array, mask)
+
+  IF (scalar_1 /= 1 .OR. scalar_2 /= 1) CALL abort
+  IF (.NOT. ALL (array_1 == array)) CALL abort
+  IF (.NOT. ALL (array_2 == [0, 0, 0])) CALL abort
+  IF (.NOT. ALL (array_3 == [0, 0, 0])) CALL abort
+  IF (.NOT. ALL (array_4 == array)) CALL abort
+  IF (.NOT. ALL (array_5 == [1, 0, 1])) CALL abort
+  IF (.NOT. ALL (array_6 == [1, -2, 3])) CALL abort
+END