aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorFrancois-Xavier Coudert <fxcoudert@gcc.gnu.org>2007-08-23 10:22:18 +0000
committerFrançois-Xavier Coudert <fxcoudert@gcc.gnu.org>2007-08-23 10:22:18 +0000
commit7af6648c5985b467eba67431d384b8bc26e13ad4 (patch)
tree84bf35d895cd7383b730ed7d676d980eb32f8772 /gcc
parente3a47fe4af35469b8769711fa89c6c88fdc72dab (diff)
downloadgcc-7af6648c5985b467eba67431d384b8bc26e13ad4.zip
gcc-7af6648c5985b467eba67431d384b8bc26e13ad4.tar.gz
gcc-7af6648c5985b467eba67431d384b8bc26e13ad4.tar.bz2
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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog6
-rw-r--r--gcc/fortran/trans-intrinsic.c67
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/min_max_optional_2.f9013
-rw-r--r--gcc/testsuite/gfortran.dg/min_max_optional_3.f9014
-rw-r--r--gcc/testsuite/gfortran.dg/min_max_optional_4.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/min_max_optional_5.f9021
7 files changed, 48 insertions, 93 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ab8067c..05e7b9f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-08-23 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/33095
+ * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Remove
+ runtime error checking.
+
2007-08-22 Roger Sayle <roger@eyesopen.com>
Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 2e8b8a0..a6802b3 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 f213b48..2f3961d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2007-08-23 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ 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 <bonzini@gnu.org>
* 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 51e0fee..0000000
--- 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 e0e6e29..0000000
--- 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 b749db0..0000000
--- 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 0000000..ae3344f
--- /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