From 99c791361468b61976d6054e1ec1c81fe43e6559 Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Wed, 11 Nov 2015 15:37:00 +0000 Subject: [PATCH 14/23] Allow non-logical expressions in IF statements This feature is enabled by the `-std=extra-legacy` compiler flag. --- 0014-Allow-non-logical-expressions-in-IF-statements.patch Allow non-logical expressions in IF statements This feature is enabled by the `-std=extra-legacy` compiler flag. Signed-off-by: Ben Brewer Signed-off-by: Francisco Redondo Marchena diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 33b441aa1bc..f979915e856 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9919,10 +9919,23 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) switch (b->op) { case EXEC_IF: - if (t && b->expr1 != NULL - && (b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) - gfc_error ("IF clause at %L requires a scalar LOGICAL expression", - &b->expr1->where); + if (t && b->expr1 != NULL) + { + if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && b->expr1->ts.type != BT_LOGICAL) + { + gfc_expr* cast; + cast = gfc_ne (b->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); + if (cast == NULL) + gfc_internal_error ("gfc_resolve_blocks(): Failed to cast to LOGICAL in IF"); + b->expr1 = cast; + gfc_warning (0, "Non-LOGICAL type in IF statement condition %L" + " will be true if it evaluates to nonzero", &b->expr1->where); + } + + if ((b->expr1->ts.type != BT_LOGICAL || b->expr1->rank != 0)) + gfc_error ("IF clause at %L requires a scalar LOGICAL expression", + &b->expr1->where); + } break; case EXEC_WHERE: @@ -11182,11 +11195,23 @@ start: break; case EXEC_IF: - if (t && code->expr1 != NULL - && (code->expr1->ts.type != BT_LOGICAL - || code->expr1->rank != 0)) - gfc_error ("IF clause at %L requires a scalar LOGICAL expression", - &code->expr1->where); + if (t && code->expr1 != NULL) + { + if (gfc_option.allow_std & GFC_STD_EXTRA_LEGACY && code->expr1->ts.type != BT_LOGICAL) + { + gfc_expr* cast; + cast = gfc_ne (code->expr1, gfc_get_int_expr (1, &gfc_current_locus, 0), INTRINSIC_NE); + if (cast == NULL) + gfc_internal_error ("gfc_resolve_code(): Failed to cast to LOGICAL in IF"); + code->expr1 = cast; + gfc_warning (0, "Non-LOGICAL type in IF statement condition %L" + " will be true if it evaluates to nonzero", &code->expr1->where); + } + + if ((code->expr1->ts.type != BT_LOGICAL || code->expr1->rank != 0)) + gfc_error ("IF clause at %L requires a scalar LOGICAL expression", + &code->expr1->where); + } break; case EXEC_CALL: diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f new file mode 100644 index 00000000000..ad23fcfc9af --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks.f @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-std=extra-legacy" } +! +! Allow logical expressions in if statements and blocks +! + PROGRAM logical_exp_if_st_bl + INTEGER ipos/1/ + INTEGER ineg/0/ + + ! Test non logical variables + if (ineg) STOP 1 ! { dg-warning "if it evaluates to nonzero" } + if (0) STOP 2 ! { dg-warning "if it evaluates to nonzero" } + + ! Test non logical expressions in if statements + if (MOD(ipos, 1)) STOP 3 ! { dg-warning "if it evaluates to nonzero" } + + ! Test non logical expressions in if blocks + if (MOD(2 * ipos, 2)) then ! { dg-warning "if it evaluates to nonzero" } + STOP 4 + endif + END commit cf72338b9468fad669b60600bcce7918a8d4591e Author: Jeff Law Date: Tue Jun 5 15:45:41 2018 -0600 Additional test for 0014-Allow-non-logical-expressions-in-IF-statements.patch "Allow non-logical expressions in IF statements" diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f new file mode 100644 index 00000000000..7da6aaceec7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks-2.f @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-std=extra-legacy" } + + function othersub1() + integer*4 othersub1 + othersub1 = 1 + end + function othersub2() + integer*4 othersub2 + othersub2 = 2 + end + program MAIN + integer*4 othersub1 + integer*4 othersub2 +c the if (integer) works here + if (othersub2()) then ! { dg-warning "" } + write (*,*), 'othersub2 is true' +c but fails in the "else if" + else if (othersub1()) then ! { dg-warning "" } + write (*,*), 'othersub2 is false, othersub1 is true' + endif + end +