From 7af6648c5985b467eba67431d384b8bc26e13ad4 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Thu, 23 Aug 2007 10:22:18 +0000 Subject: [PATCH] re PR fortran/33095 (MAX with optional arguments gives run-time error) PR fortran/33095 * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Remove runtime error checking. * gfortran.dg/min_max_optional_5.f90: New test. * gfortran.dg/min_max_optional_2.f90: Remove. * gfortran.dg/min_max_optional_3.f90: Remove. * gfortran.dg/min_max_optional_4.f90: Remove. From-SVN: r127732 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/trans-intrinsic.c | 67 ++++--------------- gcc/testsuite/ChangeLog | 8 +++ .../gfortran.dg/min_max_optional_2.f90 | 13 ---- .../gfortran.dg/min_max_optional_3.f90 | 14 ---- .../gfortran.dg/min_max_optional_4.f90 | 12 ---- .../gfortran.dg/min_max_optional_5.f90 | 21 ++++++ 7 files changed, 48 insertions(+), 93 deletions(-) delete mode 100644 gcc/testsuite/gfortran.dg/min_max_optional_2.f90 delete mode 100644 gcc/testsuite/gfortran.dg/min_max_optional_3.f90 delete mode 100644 gcc/testsuite/gfortran.dg/min_max_optional_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/min_max_optional_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ab8067c7782..05e7b9f897b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2007-08-23 Francois-Xavier Coudert + + PR fortran/33095 + * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Remove + runtime error checking. + 2007-08-22 Roger Sayle Tobias Schlüter diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 2e8b8a010ac..a6802b33f7d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1420,10 +1420,9 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr) /* Get the minimum/maximum value of all the parameters. minmax (a1, a2, a3, ...) { - if (a2 .op. a1 || isnan(a1)) + mvar = a1; + if (a2 .op. mvar || isnan(mvar)) mvar = a2; - else - mvar = a1; if (a3 .op. mvar || isnan(mvar)) mvar = a3; ... @@ -1436,17 +1435,14 @@ gfc_conv_intrinsic_ttynam (gfc_se * se, gfc_expr * expr) static void gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) { - tree limit; tree tmp; tree mvar; tree val; tree thencase; - tree elsecase; tree *args; tree type; gfc_actual_arglist *argexpr; - unsigned int i; - unsigned int nargs; + unsigned int i, nargs; nargs = gfc_intrinsic_argument_list_length (expr); args = alloca (sizeof (tree) * nargs); @@ -1454,50 +1450,15 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) gfc_conv_intrinsic_function_args (se, expr, args, nargs); 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 (args[0]) == 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 (args[0], 0), - build_int_cst (TREE_TYPE (TREE_OPERAND (args[0], 0)), 0)); - gfc_trans_runtime_check (cond, &se->pre, &expr->where, msg); - gfc_free (msg); - } - - if (argexpr->next->expr->expr_type == EXPR_VARIABLE - && argexpr->next->expr->symtree->n.sym->attr.optional - && TREE_CODE (args[1]) == 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 (args[1], 0), - build_int_cst (TREE_TYPE (TREE_OPERAND (args[1], 0)), 0)); - gfc_trans_runtime_check (cond, &se->pre, &expr->where, msg); - gfc_free (msg); - } - - limit = args[0]; - if (TREE_TYPE (limit) != type) - limit = convert (type, limit); + if (TREE_TYPE (args[0]) != type) + args[0] = convert (type, args[0]); /* Only evaluate the argument once. */ - if (TREE_CODE (limit) != VAR_DECL && !TREE_CONSTANT (limit)) - limit = gfc_evaluate_now (limit, &se->pre); + if (TREE_CODE (args[0]) != VAR_DECL && !TREE_CONSTANT (args[0])) + args[0] = gfc_evaluate_now (args[0], &se->pre); mvar = gfc_create_var (type, "M"); - elsecase = build2_v (MODIFY_EXPR, mvar, limit); + gfc_add_modify_expr (&se->pre, mvar, args[0]); for (i = 1, argexpr = argexpr->next; i < nargs; i++) { tree cond, isnan; @@ -1505,7 +1466,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) val = args[i]; /* Handle absent optional arguments by ignoring the comparison. */ - if (i > 0 && argexpr->expr->expr_type == EXPR_VARIABLE + if (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), @@ -1521,25 +1482,23 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) thencase = build2_v (MODIFY_EXPR, mvar, convert (type, val)); - tmp = build2 (op, boolean_type_node, convert (type, val), limit); + tmp = build2 (op, boolean_type_node, convert (type, val), mvar); /* FIXME: When the IEEE_ARITHMETIC module is implemented, the call to __builtin_isnan might be made dependent on that module being loaded, to help performance of programs that don't rely on IEEE semantics. */ - if (FLOAT_TYPE_P (TREE_TYPE (limit))) + if (FLOAT_TYPE_P (TREE_TYPE (mvar))) { - isnan = build_call_expr (built_in_decls[BUILT_IN_ISNAN], 1, limit); + isnan = build_call_expr (built_in_decls[BUILT_IN_ISNAN], 1, mvar); tmp = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, tmp, fold_convert (boolean_type_node, isnan)); } - tmp = build3_v (COND_EXPR, tmp, thencase, elsecase); + tmp = build3_v (COND_EXPR, tmp, thencase, build_empty_stmt ()); 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 f213b482d9f..2f3961dfe62 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-08-23 Francois-Xavier Coudert + + PR fortran/33095 + * gfortran.dg/min_max_optional_5.f90: New test. + * gfortran.dg/min_max_optional_2.f90: Remove. + * gfortran.dg/min_max_optional_3.f90: Remove. + * gfortran.dg/min_max_optional_4.f90: Remove. + 2007-08-23 Paolo Bonzini * gcc.target/i386/cmov3.c: Fix scan-assembler. diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_2.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_2.f90 deleted file mode 100644 index 51e0feee641..00000000000 --- a/gcc/testsuite/gfortran.dg/min_max_optional_2.f90 +++ /dev/null @@ -1,13 +0,0 @@ -! { 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 deleted file mode 100644 index e0e6e29d969..00000000000 --- a/gcc/testsuite/gfortran.dg/min_max_optional_3.f90 +++ /dev/null @@ -1,14 +0,0 @@ -! { 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 diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_4.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_4.f90 deleted file mode 100644 index b749db0f8e3..00000000000 --- a/gcc/testsuite/gfortran.dg/min_max_optional_4.f90 +++ /dev/null @@ -1,12 +0,0 @@ -! { dg-do run } -! { dg-shouldfail "" } -program test - call foo("foo") -contains - subroutine foo(a, b, c, d) - character(len=*), optional :: a, b, c, d - integer :: i - i = len_trim(min(a,b,c,d)) ! { dg-output "Second argument of 'MIN' intrinsic should be present" } - print *, i - end subroutine foo -end diff --git a/gcc/testsuite/gfortran.dg/min_max_optional_5.f90 b/gcc/testsuite/gfortran.dg/min_max_optional_5.f90 new file mode 100644 index 00000000000..ae3344f790f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/min_max_optional_5.f90 @@ -0,0 +1,21 @@ +! More tests for MIN/MAX with optional arguments +! PR33095 +! +! { dg-do run } + if (m1(3,4) /= 4) call abort + if (m1(3) /= 3) call abort + if (m1() /= 2) call abort + + if (m1(3,4) /= 4) call abort + if (m1(3) /= 3) call abort +contains + integer function m1(a1,a2) + integer, optional, intent(in) :: a1, a2 + m1 = max(1, 2, a1, a2) + end function m1 + + integer function m2(a1,a2) + integer, optional, intent(in) :: a1, a2 + m2 = max(1, a1, 2, a2) + end function m2 +end