diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c12809706777e448c7877ad8a7142644462001f4..77ec5111a4d4ee96ced8d3bf071881f183bb7a77 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-07-04 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/31198
+ * trans-intrinsic.c (trans-intrinsic.c): Handle optional
+ arguments correctly for MIN and MAX intrinsics.
+
2007-07-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/32545
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 874b1081de668d91aafed493e7f326dac7b85b4b..8856f1965af8f4e9bab170bf92344e0cf1e167bb 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1381,12 +1381,51 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
tree val;
tree thencase;
tree elsecase;
- tree arg;
+ tree arg, arg1, arg2;
tree type;
+ gfc_actual_arglist *argexpr;
+ unsigned int i;
arg = gfc_conv_intrinsic_function_args (se, expr);
+ arg1 = TREE_VALUE (arg);
+ arg2 = TREE_VALUE (TREE_CHAIN (arg));
type = gfc_typenode_for_spec (&expr->ts);
+ /* The first and second arguments should be present, if they are
+ optional dummy arguments. */
+ argexpr = expr->value.function.actual;
+ if (argexpr->expr->expr_type == EXPR_VARIABLE
+ && argexpr->expr->symtree->n.sym->attr.optional
+ && TREE_CODE (arg1) == INDIRECT_REF)
+ {
+ /* Check the first argument. */
+ tree cond;
+ char *msg;
+
+ asprintf (&msg, "First argument of '%s' intrinsic should be present",
+ expr->symtree->n.sym->name);
+ cond = build2 (EQ_EXPR, boolean_type_node, TREE_OPERAND (arg1, 0),
+ build_int_cst (TREE_TYPE (TREE_OPERAND (arg1, 0)), 0));
+ gfc_trans_runtime_check (cond, msg, &se->pre, &expr->where);
+ gfc_free (msg);
+ }
+
+ if (argexpr->next->expr->expr_type == EXPR_VARIABLE
+ && argexpr->next->expr->symtree->n.sym->attr.optional
+ && TREE_CODE (arg2) == INDIRECT_REF)
+ {
+ /* Check the second argument. */
+ tree cond;
+ char *msg;
+
+ asprintf (&msg, "Second argument of '%s' intrinsic should be present",
+ expr->symtree->n.sym->name);
+ cond = build2 (EQ_EXPR, boolean_type_node, TREE_OPERAND (arg2, 0),
+ build_int_cst (TREE_TYPE (TREE_OPERAND (arg2, 0)), 0));
+ gfc_trans_runtime_check (cond, msg, &se->pre, &expr->where);
+ gfc_free (msg);
+ }
+
limit = TREE_VALUE (arg);
if (TREE_TYPE (limit) != type)
limit = convert (type, limit);
@@ -1396,23 +1435,40 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op)
mvar = gfc_create_var (type, "M");
elsecase = build2_v (MODIFY_EXPR, mvar, limit);
- for (arg = TREE_CHAIN (arg); arg != NULL_TREE; arg = TREE_CHAIN (arg))
+ for (arg = TREE_CHAIN (arg), i = 0, argexpr = argexpr->next;
+ arg != NULL_TREE; arg = TREE_CHAIN (arg), i++)
{
+ tree cond;
+
val = TREE_VALUE (arg);
- if (TREE_TYPE (val) != type)
- val = convert (type, val);
- /* Only evaluate the argument once. */
- if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val))
- val = gfc_evaluate_now (val, &se->pre);
+ /* Handle absent optional arguments by ignoring the comparison. */
+ if (i > 0 && argexpr->expr->expr_type == EXPR_VARIABLE
+ && argexpr->expr->symtree->n.sym->attr.optional
+ && TREE_CODE (val) == INDIRECT_REF)
+ cond = build2 (NE_EXPR, boolean_type_node, TREE_OPERAND (val, 0),
+ build_int_cst (TREE_TYPE (TREE_OPERAND (val, 0)), 0));
+ else
+ {
+ cond = NULL_TREE;
+
+ /* Only evaluate the argument once. */
+ if (TREE_CODE (val) != VAR_DECL && !TREE_CONSTANT (val))
+ val = gfc_evaluate_now (val, &se->pre);
+ }
thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val));
- tmp = build2 (op, boolean_type_node, val, limit);
+ tmp = build2 (op, boolean_type_node, convert (type, val), limit);
tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
+
+ if (cond != NULL_TREE)
+ tmp = build3_v (COND_EXPR, cond, tmp, build_empty_stmt ());
+
gfc_add_expr_to_block (&se->pre, tmp);
elsecase = build_empty_stmt ();
limit = mvar;
+ argexpr = argexpr->next;
}
se->expr = mvar;
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 77dc469169e29b93f872faba4791d9ab0d57686f..71c389afc87d8d97c443cd88adce2d506dfff0f4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2007-07-04 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/31198
+ * gfortran.dg/min_max_optional_1.f90: New test.
+ * gfortran.dg/min_max_optional_2.f90: New test.
+ * gfortran.dg/min_max_optional_3.f90: New test.
+
2007-07-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/32545
@@ -16,7 +23,7 @@
2007-07-03 Christopher D. Rickett <crickett@lanl.gov>
PR fortran/32579
- * gfortran.dg/iso_c_binding_only.f03: Updated test case.
+ * gfortran.dg/iso_c_binding_only.f03: Updated test case.
2007-07-03 Tobias Burnus <burnus@net-b.de>
diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_1.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..250010dffb966b15b8d096a38da5e552d45b0ad4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/min_max_optional_1.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+IF (T1(1.0,1.0) .NE. (1.0,1.0) ) CALL ABORT()
+IF (T1(1.0) .NE. (1.0,0.0)) CALL ABORT()
+IF (M1(1,2,3) .NE. 3) CALL ABORT()
+IF (M1(1,2,A4=4) .NE. 4) CALL ABORT()
+CONTAINS
+
+COMPLEX FUNCTION T1(X,Y)
+ REAL :: X
+ REAL, OPTIONAL :: Y
+ T1=CMPLX(X,Y)
+END FUNCTION T1
+
+INTEGER FUNCTION M1(A1,A2,A3,A4)
+ INTEGER :: A1,A2
+ INTEGER, OPTIONAL :: A3,A4
+ M1=MAX(A1,A2,A3,A4)
+END FUNCTION M1
+
+END
diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_2.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..51e0feee641a8f2f22a20f8f966de96ea42446ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/min_max_optional_2.f90
@@ -0,0 +1,13 @@
+! { dg-do run }
+! { dg-shouldfail "" }
+ program test
+ if (m1(3,4) /= 4) call abort
+ if (m1(3) /= 3) call abort
+ print *, m1()
+ contains
+ integer function m1(a1,a2)
+ integer, optional :: a1,a2
+ m1 = max(a2, a1, 1, 2)
+ end function m1
+ end
+! { dg-output "First argument of 'max' intrinsic should be present" }
diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_3.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_3.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e0e6e29d969d6a11db844b26b27d17565c1e9600
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/min_max_optional_3.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! { dg-shouldfail "" }
+ program test
+ if (m1(1,2,3,4) /= 1) call abort
+ if (m1(1,2,3) /= 1) call abort
+ if (m1(1,2) /= 1) call abort
+ print *, m1(1)
+ print *, m1()
+ contains
+ integer function m1(a1,a2,a3,a4)
+ integer, optional :: a1,a2,a3,a4
+ m1 = min(a1,a2,a3,a4) ! { dg-output "Second argument of 'min' intrinsic should be present" }
+ end function m1
+ end