Remove 3 gcc13-fortran-* patches
This commit is contained in:
parent
f3a804c686
commit
2751220912
6
gcc.spec
6
gcc.spec
@ -290,9 +290,6 @@ Patch11: gcc13-d-shared-libphobos.patch
|
|||||||
Patch50: isl-rh2155127.patch
|
Patch50: isl-rh2155127.patch
|
||||||
|
|
||||||
Patch100: gcc13-fortran-fdec-duplicates.patch
|
Patch100: gcc13-fortran-fdec-duplicates.patch
|
||||||
Patch101: gcc13-fortran-flogical-as-integer.patch
|
|
||||||
Patch102: gcc13-fortran-fdec-override-kind.patch
|
|
||||||
Patch103: gcc13-fortran-fdec-non-logical-if.patch
|
|
||||||
|
|
||||||
# On ARM EABI systems, we do want -gnueabi to be part of the
|
# On ARM EABI systems, we do want -gnueabi to be part of the
|
||||||
# target triple.
|
# target triple.
|
||||||
@ -868,9 +865,6 @@ touch -r isl-0.24/m4/ax_prog_cxx_for_build.m4 isl-0.24/m4/ax_prog_cc_for_build.m
|
|||||||
|
|
||||||
%if 0%{?rhel} >= 9
|
%if 0%{?rhel} >= 9
|
||||||
%patch -P100 -p1 -b .fortran-fdec-duplicates~
|
%patch -P100 -p1 -b .fortran-fdec-duplicates~
|
||||||
%patch -P101 -p1 -b .fortran-flogical-as-integer~
|
|
||||||
%patch -P102 -p1 -b .fortran-fdec-override-kind~
|
|
||||||
%patch -P103 -p1 -b .fortran-fdec-non-logical-if~
|
|
||||||
%endif
|
%endif
|
||||||
|
|
||||||
%ifarch %{arm}
|
%ifarch %{arm}
|
||||||
|
@ -1,378 +0,0 @@
|
|||||||
From cc87ddb841017bb0976b05091733609ee17d7f05 Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 13:15:17 +0000
|
|
||||||
Subject: [PATCH 07/10] Allow non-logical expressions in IF statements
|
|
||||||
|
|
||||||
Use -fdec-non-logical-if to enable feature. Also enabled using -fdec.
|
|
||||||
---
|
|
||||||
gcc/fortran/lang.opt | 4 ++
|
|
||||||
gcc/fortran/options.cc | 1 +
|
|
||||||
gcc/fortran/resolve.cc | 60 ++++++++++++++++---
|
|
||||||
...gical_expressions_if_statements_blocks_1.f | 25 ++++++++
|
|
||||||
...gical_expressions_if_statements_blocks_2.f | 25 ++++++++
|
|
||||||
...gical_expressions_if_statements_blocks_3.f | 25 ++++++++
|
|
||||||
...gical_expressions_if_statements_blocks_4.f | 45 ++++++++++++++
|
|
||||||
...gical_expressions_if_statements_blocks_5.f | 45 ++++++++++++++
|
|
||||||
...gical_expressions_if_statements_blocks_6.f | 45 ++++++++++++++
|
|
||||||
9 files changed, 266 insertions(+), 9 deletions(-)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
||||||
index 4a269ebb22d..d886c2f33ed 100644
|
|
||||||
--- a/gcc/fortran/lang.opt
|
|
||||||
+++ b/gcc/fortran/lang.opt
|
|
||||||
@@ -506,6 +506,10 @@ fdec-override-kind
|
|
||||||
Fortran Var(flag_dec_override_kind)
|
|
||||||
Enable support for per variable kind specification.
|
|
||||||
|
|
||||||
+fdec-non-logical-if
|
|
||||||
+Fortran Var(flag_dec_non_logical_if)
|
|
||||||
+Enable support for non-logical expressions in if statements.
|
|
||||||
+
|
|
||||||
fdec-structure
|
|
||||||
Fortran Var(flag_dec_structure)
|
|
||||||
Enable support for DEC STRUCTURE/RECORD.
|
|
||||||
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
|
||||||
index edbab483b36..a946c86790a 100644
|
|
||||||
--- a/gcc/fortran/options.cc
|
|
||||||
+++ b/gcc/fortran/options.cc
|
|
||||||
@@ -79,6 +79,7 @@ set_dec_flags (int value)
|
|
||||||
SET_BITFLAG (flag_dec_char_conversions, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_duplicates, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_override_kind, value, value);
|
|
||||||
+ SET_BITFLAG (flag_dec_non_logical_if, value, value);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Finalize DEC flags. */
|
|
||||||
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
|
|
||||||
index bc0df0fdb99..07dd039f3bf 100644
|
|
||||||
--- a/gcc/fortran/resolve.cc
|
|
||||||
+++ b/gcc/fortran/resolve.cc
|
|
||||||
@@ -11030,10 +11030,31 @@ gfc_resolve_blocks (gfc_code *b, gfc_nam
|
|
||||||
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 (flag_dec_non_logical_if && 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;
|
|
||||||
+ if (warn_conversion_extra)
|
|
||||||
+ {
|
|
||||||
+ gfc_warning (OPT_Wconversion_extra, "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:
|
|
||||||
@@ -12585,11 +12606,32 @@ 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 (flag_dec_non_logical_if
|
|
||||||
+ && 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;
|
|
||||||
+ if (warn_conversion_extra)
|
|
||||||
+ {
|
|
||||||
+ gfc_warning (OPT_Wconversion_extra, "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_1.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..0101db893ca
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_1.f
|
|
||||||
@@ -0,0 +1,25 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec -Wconversion-extra" }
|
|
||||||
+!
|
|
||||||
+! Allow logical expressions in if statements and blocks
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
|
|
||||||
+! and Jeff Law <law@redhat.com>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ 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
|
|
||||||
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..876f4e09508
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_2.f
|
|
||||||
@@ -0,0 +1,25 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
|
|
||||||
+!
|
|
||||||
+! Allow logical expressions in if statements and blocks
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
|
|
||||||
+! and Jeff Law <law@redhat.com>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ 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
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..35cb4c51b8d
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_3.f
|
|
||||||
@@ -0,0 +1,25 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec -fno-dec-non-logical-if" }
|
|
||||||
+!
|
|
||||||
+! Allow logical expressions in if statements and blocks
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
|
|
||||||
+! and Jeff Law <law@redhat.com>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM logical_exp_if_st_bl
|
|
||||||
+ INTEGER ipos/1/
|
|
||||||
+ INTEGER ineg/0/
|
|
||||||
+
|
|
||||||
+ ! Test non logical variables
|
|
||||||
+ if (ineg) STOP 1 ! { dg-error "IF clause at" }
|
|
||||||
+ if (0) STOP 2 ! { dg-error "IF clause at" }
|
|
||||||
+
|
|
||||||
+ ! Test non logical expressions in if statements
|
|
||||||
+ if (MOD(ipos, 1)) STOP 3 ! { dg-error "IF clause at" }
|
|
||||||
+
|
|
||||||
+ ! Test non logical expressions in if blocks
|
|
||||||
+ if (MOD(2 * ipos, 2)) then ! { dg-error "IF clause at" }
|
|
||||||
+ STOP 4
|
|
||||||
+ endif
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..7b60b60827f
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_4.f
|
|
||||||
@@ -0,0 +1,45 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec -Wconversion-extra" }
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
|
|
||||||
+! and Jeff Law <law@redhat.com>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ function othersub1()
|
|
||||||
+ integer*4 othersub1
|
|
||||||
+ othersub1 = 9
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
+ function othersub2()
|
|
||||||
+ integer*4 othersub2
|
|
||||||
+ othersub2 = 0
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
+ program MAIN
|
|
||||||
+ integer*4 othersub1
|
|
||||||
+ integer*4 othersub2
|
|
||||||
+ integer a /1/
|
|
||||||
+ integer b /2/
|
|
||||||
+
|
|
||||||
+ if (othersub1()) then ! { dg-warning "if it evaluates to nonzero" }
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ else
|
|
||||||
+ stop 1
|
|
||||||
+ end if
|
|
||||||
+ if (othersub2()) then ! { dg-warning "if it evaluates to nonzero" }
|
|
||||||
+ stop 2
|
|
||||||
+ else
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ end if
|
|
||||||
+ if (a-b) then ! { dg-warning "if it evaluates to nonzero" }
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ else
|
|
||||||
+ stop 3
|
|
||||||
+ end if
|
|
||||||
+ if (b-(a+1)) then ! { dg-warning "if it evaluates to nonzero" }
|
|
||||||
+ stop 3
|
|
||||||
+ else
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ end if
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..80336f48ca1
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_5.f
|
|
||||||
@@ -0,0 +1,45 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-non-logical-if -Wconversion-extra" }
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
|
|
||||||
+! and Jeff Law <law@redhat.com>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ function othersub1()
|
|
||||||
+ integer*4 othersub1
|
|
||||||
+ othersub1 = 9
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
+ function othersub2()
|
|
||||||
+ integer*4 othersub2
|
|
||||||
+ othersub2 = 0
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
+ program MAIN
|
|
||||||
+ integer*4 othersub1
|
|
||||||
+ integer*4 othersub2
|
|
||||||
+ integer a /1/
|
|
||||||
+ integer b /2/
|
|
||||||
+
|
|
||||||
+ if (othersub1()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ else
|
|
||||||
+ stop 1
|
|
||||||
+ end if
|
|
||||||
+ if (othersub2()) then ! { dg-warning "Non-LOGICAL type in IF statement" }
|
|
||||||
+ stop 2
|
|
||||||
+ else
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ end if
|
|
||||||
+ if (a-b) then ! { dg-warning "Non-LOGICAL type in IF statement" }
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ else
|
|
||||||
+ stop 3
|
|
||||||
+ end if
|
|
||||||
+ if (b-(a+1)) then ! { dg-warning "Non-LOGICAL type in IF statement" }
|
|
||||||
+ stop 3
|
|
||||||
+ else
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ end if
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..e1125ca717a
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_logical_expressions_if_statements_blocks_6.f
|
|
||||||
@@ -0,0 +1,45 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec -fno-dec-non-logical-if" }
|
|
||||||
+!
|
|
||||||
+! Contributed by Francisco Redondo Marchena <francisco.marchema@codethink.co.uk>
|
|
||||||
+! and Jeff Law <law@redhat.com>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ function othersub1()
|
|
||||||
+ integer*4 othersub1
|
|
||||||
+ othersub1 = 9
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
+ function othersub2()
|
|
||||||
+ integer*4 othersub2
|
|
||||||
+ othersub2 = 0
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
+ program MAIN
|
|
||||||
+ integer*4 othersub1
|
|
||||||
+ integer*4 othersub2
|
|
||||||
+ integer a /1/
|
|
||||||
+ integer b /2/
|
|
||||||
+
|
|
||||||
+ if (othersub1()) then ! { dg-error "IF clause at" }
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ else
|
|
||||||
+ stop 1
|
|
||||||
+ end if
|
|
||||||
+ if (othersub2()) then ! { dg-error "IF clause at" }
|
|
||||||
+ stop 2
|
|
||||||
+ else
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ end if
|
|
||||||
+ if (a-b) then ! { dg-error "IF clause at" }
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ else
|
|
||||||
+ stop 3
|
|
||||||
+ end if
|
|
||||||
+ if (b-(a+1)) then ! { dg-error "IF clause at" }
|
|
||||||
+ stop 3
|
|
||||||
+ else
|
|
||||||
+ write(*,*) "OK"
|
|
||||||
+ end if
|
|
||||||
+ end
|
|
||||||
+
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
@ -1,588 +0,0 @@
|
|||||||
From 786869fd62813e80da9b6545a295d53c36275c19 Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 13:12:14 +0000
|
|
||||||
Subject: [PATCH 06/10] Allow string length and kind to be specified on a per
|
|
||||||
variable basis.
|
|
||||||
|
|
||||||
This allows kind/length to be mixed with array specification in
|
|
||||||
declarations.
|
|
||||||
|
|
||||||
e.g.
|
|
||||||
|
|
||||||
INTEGER*4 x*2, y*8
|
|
||||||
CHARACTER names*20(10)
|
|
||||||
REAL v(100)*8, vv*4(50)
|
|
||||||
|
|
||||||
The per-variable size overrides the kind or length specified for the type.
|
|
||||||
|
|
||||||
Use -fdec-override-kind to enable. Also enabled by -fdec.
|
|
||||||
|
|
||||||
Note: this feature is a merger of two previously separate features.
|
|
||||||
|
|
||||||
Now accepts named constants as kind parameters:
|
|
||||||
|
|
||||||
INTEGER A
|
|
||||||
PARAMETER (A=2)
|
|
||||||
INTEGER B*(A)
|
|
||||||
|
|
||||||
Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
|
|
||||||
Now rejects invalid kind parameters and prints error messages:
|
|
||||||
|
|
||||||
INTEGER X*3
|
|
||||||
|
|
||||||
caused an internal compiler error.
|
|
||||||
|
|
||||||
Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
---
|
|
||||||
gcc/fortran/decl.cc | 156 ++++++++++++++----
|
|
||||||
gcc/fortran/lang.opt | 4 +
|
|
||||||
gcc/fortran/options.cc | 1 +
|
|
||||||
.../dec_mixed_char_array_declaration_1.f | 13 ++
|
|
||||||
.../dec_mixed_char_array_declaration_2.f | 13 ++
|
|
||||||
.../dec_mixed_char_array_declaration_3.f | 13 ++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_1.f | 31 ++++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_2.f | 31 ++++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_3.f | 31 ++++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_4.f | 14 ++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_5.f | 19 +++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_6.f | 19 +++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_7.f | 15 ++
|
|
||||||
.../gfortran.dg/dec_spec_in_variable_8.f | 14 ++
|
|
||||||
14 files changed, 340 insertions(+), 34 deletions(-)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
|
|
||||||
index 5c8c1b7981b..f7dc9d8263d 100644
|
|
||||||
--- a/gcc/fortran/decl.cc
|
|
||||||
+++ b/gcc/fortran/decl.cc
|
|
||||||
@@ -1213,6 +1213,54 @@ syntax:
|
|
||||||
return MATCH_ERROR;
|
|
||||||
}
|
|
||||||
|
|
||||||
+/* This matches the nonstandard kind given after a variable name, like:
|
|
||||||
+ INTEGER x*2, y*4
|
|
||||||
+ The per-variable kind will override any kind given in the type
|
|
||||||
+ declaration.
|
|
||||||
+*/
|
|
||||||
+
|
|
||||||
+static match
|
|
||||||
+match_per_symbol_kind (int *length)
|
|
||||||
+{
|
|
||||||
+ match m;
|
|
||||||
+ gfc_expr *expr = NULL;
|
|
||||||
+
|
|
||||||
+ m = gfc_match_char ('*');
|
|
||||||
+ if (m != MATCH_YES)
|
|
||||||
+ return m;
|
|
||||||
+
|
|
||||||
+ m = gfc_match_small_literal_int (length, NULL);
|
|
||||||
+ if (m == MATCH_YES || m == MATCH_ERROR)
|
|
||||||
+ return m;
|
|
||||||
+
|
|
||||||
+ if (gfc_match_char ('(') == MATCH_NO)
|
|
||||||
+ return MATCH_ERROR;
|
|
||||||
+
|
|
||||||
+ m = gfc_match_expr (&expr);
|
|
||||||
+ if (m == MATCH_YES)
|
|
||||||
+ {
|
|
||||||
+ m = MATCH_ERROR; // Assume error
|
|
||||||
+ if (gfc_expr_check_typed (expr, gfc_current_ns, false))
|
|
||||||
+ {
|
|
||||||
+ if ((expr->expr_type == EXPR_CONSTANT)
|
|
||||||
+ && (expr->ts.type == BT_INTEGER))
|
|
||||||
+ {
|
|
||||||
+ *length = mpz_get_si(expr->value.integer);
|
|
||||||
+ m = MATCH_YES;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
+ if (m == MATCH_YES)
|
|
||||||
+ {
|
|
||||||
+ if (gfc_match_char (')') == MATCH_NO)
|
|
||||||
+ m = MATCH_ERROR;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
+ if (expr != NULL)
|
|
||||||
+ gfc_free_expr (expr);
|
|
||||||
+ return m;
|
|
||||||
+}
|
|
||||||
|
|
||||||
/* Special subroutine for finding a symbol. Check if the name is found
|
|
||||||
in the current name space. If not, and we're compiling a function or
|
|
||||||
@@ -2443,6 +2491,35 @@ check_function_name (char *name)
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
+static match
|
|
||||||
+match_character_length_clause (gfc_charlen **cl, bool *cl_deferred, int elem)
|
|
||||||
+{
|
|
||||||
+ gfc_expr* char_len;
|
|
||||||
+ char_len = NULL;
|
|
||||||
+
|
|
||||||
+ match m = match_char_length (&char_len, cl_deferred, false);
|
|
||||||
+ if (m == MATCH_YES)
|
|
||||||
+ {
|
|
||||||
+ *cl = gfc_new_charlen (gfc_current_ns, NULL);
|
|
||||||
+ (*cl)->length = char_len;
|
|
||||||
+ }
|
|
||||||
+ else if (m == MATCH_NO)
|
|
||||||
+ {
|
|
||||||
+ if (elem > 1
|
|
||||||
+ && (current_ts.u.cl->length == NULL
|
|
||||||
+ || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
|
|
||||||
+ {
|
|
||||||
+ *cl = gfc_new_charlen (gfc_current_ns, NULL);
|
|
||||||
+ (*cl)->length = gfc_copy_expr (current_ts.u.cl->length);
|
|
||||||
+ }
|
|
||||||
+ else
|
|
||||||
+ *cl = current_ts.u.cl;
|
|
||||||
+
|
|
||||||
+ *cl_deferred = current_ts.deferred;
|
|
||||||
+ }
|
|
||||||
+ return m;
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
/* Match a variable name with an optional initializer. When this
|
|
||||||
subroutine is called, a variable is expected to be parsed next.
|
|
||||||
Depending on what is happening at the moment, updates either the
|
|
||||||
@@ -2453,7 +2530,7 @@ variable_decl (int elem)
|
|
||||||
{
|
|
||||||
char name[GFC_MAX_SYMBOL_LEN + 1];
|
|
||||||
static unsigned int fill_id = 0;
|
|
||||||
- gfc_expr *initializer, *char_len;
|
|
||||||
+ gfc_expr *initializer;
|
|
||||||
gfc_array_spec *as;
|
|
||||||
gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */
|
|
||||||
gfc_charlen *cl;
|
|
||||||
@@ -2462,11 +2539,15 @@ variable_decl (int elem)
|
|
||||||
match m;
|
|
||||||
bool t;
|
|
||||||
gfc_symbol *sym;
|
|
||||||
+ match cl_match;
|
|
||||||
+ match kind_match;
|
|
||||||
+ int overridden_kind;
|
|
||||||
char c;
|
|
||||||
|
|
||||||
initializer = NULL;
|
|
||||||
as = NULL;
|
|
||||||
cp_as = NULL;
|
|
||||||
+ kind_match = MATCH_NO;
|
|
||||||
|
|
||||||
/* When we get here, we've just matched a list of attributes and
|
|
||||||
maybe a type and a double colon. The next thing we expect to see
|
|
||||||
@@ -2519,6 +2600,28 @@ variable_decl (int elem)
|
|
||||||
|
|
||||||
var_locus = gfc_current_locus;
|
|
||||||
|
|
||||||
+
|
|
||||||
+ cl = NULL;
|
|
||||||
+ cl_deferred = false;
|
|
||||||
+ cl_match = MATCH_NO;
|
|
||||||
+
|
|
||||||
+ /* Check for a character length clause before an array clause */
|
|
||||||
+ if (flag_dec_override_kind)
|
|
||||||
+ {
|
|
||||||
+ if (current_ts.type == BT_CHARACTER)
|
|
||||||
+ {
|
|
||||||
+ cl_match = match_character_length_clause (&cl, &cl_deferred, elem);
|
|
||||||
+ if (cl_match == MATCH_ERROR)
|
|
||||||
+ goto cleanup;
|
|
||||||
+ }
|
|
||||||
+ else
|
|
||||||
+ {
|
|
||||||
+ kind_match = match_per_symbol_kind (&overridden_kind);
|
|
||||||
+ if (kind_match == MATCH_ERROR)
|
|
||||||
+ goto cleanup;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
/* Now we could see the optional array spec. or character length. */
|
|
||||||
m = gfc_match_array_spec (&as, true, true);
|
|
||||||
if (m == MATCH_ERROR)
|
|
||||||
@@ -2667,40 +2770,12 @@ variable_decl (int elem)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
- char_len = NULL;
|
|
||||||
- cl = NULL;
|
|
||||||
- cl_deferred = false;
|
|
||||||
-
|
|
||||||
- if (current_ts.type == BT_CHARACTER)
|
|
||||||
+ /* Second chance for a character length clause */
|
|
||||||
+ if (cl_match == MATCH_NO && current_ts.type == BT_CHARACTER)
|
|
||||||
{
|
|
||||||
- switch (match_char_length (&char_len, &cl_deferred, false))
|
|
||||||
- {
|
|
||||||
- case MATCH_YES:
|
|
||||||
- cl = gfc_new_charlen (gfc_current_ns, NULL);
|
|
||||||
-
|
|
||||||
- cl->length = char_len;
|
|
||||||
- break;
|
|
||||||
-
|
|
||||||
- /* Non-constant lengths need to be copied after the first
|
|
||||||
- element. Also copy assumed lengths. */
|
|
||||||
- case MATCH_NO:
|
|
||||||
- if (elem > 1
|
|
||||||
- && (current_ts.u.cl->length == NULL
|
|
||||||
- || current_ts.u.cl->length->expr_type != EXPR_CONSTANT))
|
|
||||||
- {
|
|
||||||
- cl = gfc_new_charlen (gfc_current_ns, NULL);
|
|
||||||
- cl->length = gfc_copy_expr (current_ts.u.cl->length);
|
|
||||||
- }
|
|
||||||
- else
|
|
||||||
- cl = current_ts.u.cl;
|
|
||||||
-
|
|
||||||
- cl_deferred = current_ts.deferred;
|
|
||||||
-
|
|
||||||
- break;
|
|
||||||
-
|
|
||||||
- case MATCH_ERROR:
|
|
||||||
- goto cleanup;
|
|
||||||
- }
|
|
||||||
+ m = match_character_length_clause (&cl, &cl_deferred, elem);
|
|
||||||
+ if (m == MATCH_ERROR)
|
|
||||||
+ goto cleanup;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* The dummy arguments and result of the abreviated form of MODULE
|
|
||||||
@@ -2802,6 +2877,19 @@ variable_decl (int elem)
|
|
||||||
goto cleanup;
|
|
||||||
}
|
|
||||||
|
|
||||||
+ if (kind_match == MATCH_YES)
|
|
||||||
+ {
|
|
||||||
+ gfc_find_symbol (name, gfc_current_ns, 1, &sym);
|
|
||||||
+ /* sym *must* be found at this point */
|
|
||||||
+ sym->ts.kind = overridden_kind;
|
|
||||||
+ if (gfc_validate_kind (sym->ts.type, sym->ts.kind, true) < 0)
|
|
||||||
+ {
|
|
||||||
+ gfc_error ("Kind %d not supported for type %s at %C",
|
|
||||||
+ sym->ts.kind, gfc_basic_typename (sym->ts.type));
|
|
||||||
+ return MATCH_ERROR;
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (!check_function_name (name))
|
|
||||||
{
|
|
||||||
m = MATCH_ERROR;
|
|
||||||
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
||||||
index 25cc948699b..4a269ebb22d 100644
|
|
||||||
--- a/gcc/fortran/lang.opt
|
|
||||||
+++ b/gcc/fortran/lang.opt
|
|
||||||
@@ -502,6 +502,10 @@ fdec-math
|
|
||||||
Fortran Var(flag_dec_math)
|
|
||||||
Enable legacy math intrinsics for compatibility.
|
|
||||||
|
|
||||||
+fdec-override-kind
|
|
||||||
+Fortran Var(flag_dec_override_kind)
|
|
||||||
+Enable support for per variable kind specification.
|
|
||||||
+
|
|
||||||
fdec-structure
|
|
||||||
Fortran Var(flag_dec_structure)
|
|
||||||
Enable support for DEC STRUCTURE/RECORD.
|
|
||||||
diff --git a/gcc/fortran/options.cc b/gcc/fortran/options.cc
|
|
||||||
index d6bd36c3a8a..edbab483b36 100644
|
|
||||||
--- a/gcc/fortran/options.cc
|
|
||||||
+++ b/gcc/fortran/options.cc
|
|
||||||
@@ -78,6 +78,7 @@ set_dec_flags (int value)
|
|
||||||
SET_BITFLAG (flag_dec_blank_format_item, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_char_conversions, value, value);
|
|
||||||
SET_BITFLAG (flag_dec_duplicates, value, value);
|
|
||||||
+ SET_BITFLAG (flag_dec_override_kind, value, value);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Finalize DEC flags. */
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..706ea4112a4
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_1.f
|
|
||||||
@@ -0,0 +1,13 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Test character declaration with mixed string length and array specification
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM character_declaration
|
|
||||||
+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/
|
|
||||||
+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
|
|
||||||
+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..26d2acf01de
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_2.f
|
|
||||||
@@ -0,0 +1,13 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-override-kind" }
|
|
||||||
+!
|
|
||||||
+! Test character declaration with mixed string length and array specification
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM character_declaration
|
|
||||||
+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/
|
|
||||||
+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
|
|
||||||
+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..76e4f0bdb93
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_mixed_char_array_declaration_3.f
|
|
||||||
@@ -0,0 +1,13 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec-override-kind -fno-dec-override-kind" }
|
|
||||||
+!
|
|
||||||
+! Test character declaration with mixed string length and array specification
|
|
||||||
+!
|
|
||||||
+! Contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM character_declaration
|
|
||||||
+ CHARACTER ASPEC_SLENGTH*2 (5) /'01','02','03','04','05'/ ! { dg-error "Syntax error" }
|
|
||||||
+ CHARACTER SLENGTH_ASPEC(5)*2 /'01','02','03','04','05'/
|
|
||||||
+ if (ASPEC_SLENGTH(3).NE.SLENGTH_ASPEC(3)) STOP 1 ! { dg-error " Operands of comparison operator" }
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..edd0f5874b7
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_1.f
|
|
||||||
@@ -0,0 +1,31 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Test kind specification in variable not in type
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer*8 ai*1, bi*4, ci
|
|
||||||
+ real*4 ar*4, br*8, cr
|
|
||||||
+
|
|
||||||
+ ai = 1
|
|
||||||
+ ar = 1.0
|
|
||||||
+ bi = 2
|
|
||||||
+ br = 2.0
|
|
||||||
+ ci = 3
|
|
||||||
+ cr = 3.0
|
|
||||||
+
|
|
||||||
+ if (ai .ne. 1) stop 1
|
|
||||||
+ if (abs(ar - 1.0) > 1.0D-6) stop 2
|
|
||||||
+ if (bi .ne. 2) stop 3
|
|
||||||
+ if (abs(br - 2.0) > 1.0D-6) stop 4
|
|
||||||
+ if (ci .ne. 3) stop 5
|
|
||||||
+ if (abs(cr - 3.0) > 1.0D-6) stop 6
|
|
||||||
+ if (kind(ai) .ne. 1) stop 7
|
|
||||||
+ if (kind(ar) .ne. 4) stop 8
|
|
||||||
+ if (kind(bi) .ne. 4) stop 9
|
|
||||||
+ if (kind(br) .ne. 8) stop 10
|
|
||||||
+ if (kind(ci) .ne. 8) stop 11
|
|
||||||
+ if (kind(cr) .ne. 4) stop 12
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..bfaba584dbb
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_2.f
|
|
||||||
@@ -0,0 +1,31 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-override-kind" }
|
|
||||||
+!
|
|
||||||
+! Test kind specification in variable not in type
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer*8 ai*1, bi*4, ci
|
|
||||||
+ real*4 ar*4, br*8, cr
|
|
||||||
+
|
|
||||||
+ ai = 1
|
|
||||||
+ ar = 1.0
|
|
||||||
+ bi = 2
|
|
||||||
+ br = 2.0
|
|
||||||
+ ci = 3
|
|
||||||
+ cr = 3.0
|
|
||||||
+
|
|
||||||
+ if (ai .ne. 1) stop 1
|
|
||||||
+ if (abs(ar - 1.0) > 1.0D-6) stop 2
|
|
||||||
+ if (bi .ne. 2) stop 3
|
|
||||||
+ if (abs(br - 2.0) > 1.0D-6) stop 4
|
|
||||||
+ if (ci .ne. 3) stop 5
|
|
||||||
+ if (abs(cr - 3.0) > 1.0D-6) stop 6
|
|
||||||
+ if (kind(ai) .ne. 1) stop 7
|
|
||||||
+ if (kind(ar) .ne. 4) stop 8
|
|
||||||
+ if (kind(bi) .ne. 4) stop 9
|
|
||||||
+ if (kind(br) .ne. 8) stop 10
|
|
||||||
+ if (kind(ci) .ne. 8) stop 11
|
|
||||||
+ if (kind(cr) .ne. 4) stop 12
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..5ff434e7466
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_3.f
|
|
||||||
@@ -0,0 +1,31 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec -fno-dec-override-kind" }
|
|
||||||
+!
|
|
||||||
+! Test kind specification in variable not in type
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer*8 ai*1, bi*4, ci ! { dg-error "Syntax error" }
|
|
||||||
+ real*4 ar*4, br*8, cr ! { dg-error "Syntax error" }
|
|
||||||
+
|
|
||||||
+ ai = 1
|
|
||||||
+ ar = 1.0
|
|
||||||
+ bi = 2
|
|
||||||
+ br = 2.0
|
|
||||||
+ ci = 3
|
|
||||||
+ cr = 3.0
|
|
||||||
+
|
|
||||||
+ if (ai .ne. 1) stop 1
|
|
||||||
+ if (abs(ar - 1.0) > 1.0D-6) stop 2
|
|
||||||
+ if (bi .ne. 2) stop 3
|
|
||||||
+ if (abs(br - 2.0) > 1.0D-6) stop 4
|
|
||||||
+ if (ci .ne. 3) stop 5
|
|
||||||
+ if (abs(cr - 3.0) > 1.0D-6) stop 6
|
|
||||||
+ if (kind(ai) .ne. 1) stop 7
|
|
||||||
+ if (kind(ar) .ne. 4) stop 8
|
|
||||||
+ if (kind(bi) .ne. 4) stop 9
|
|
||||||
+ if (kind(br) .ne. 8) stop 10
|
|
||||||
+ if (kind(ci) .ne. 8) stop 11
|
|
||||||
+ if (kind(cr) .ne. 4) stop 12
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..c01980e8b9d
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_4.f
|
|
||||||
@@ -0,0 +1,14 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+!
|
|
||||||
+! Test kind specification in variable not in type. The per variable
|
|
||||||
+! kind specification is not enabled so these should fail
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer a
|
|
||||||
+ parameter(a=2)
|
|
||||||
+ integer b*(a) ! { dg-error "Syntax error" }
|
|
||||||
+ real c*(8) ! { dg-error "Syntax error" }
|
|
||||||
+ logical d*1_1 ! { dg-error "Syntax error" }
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..e2f39da3f4f
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_5.f
|
|
||||||
@@ -0,0 +1,19 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec-override-kind" }
|
|
||||||
+!
|
|
||||||
+! Test kind specification in variable not in type
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer a
|
|
||||||
+ parameter(a=2)
|
|
||||||
+ integer b*(a)
|
|
||||||
+ real c*(8)
|
|
||||||
+ logical d*(1_1)
|
|
||||||
+ character e*(a)
|
|
||||||
+ if (kind(b).ne.2) stop 1
|
|
||||||
+ if (kind(c).ne.8) stop 2
|
|
||||||
+ if (kind(d).ne.1) stop 3
|
|
||||||
+ if (len(e).ne.2) stop 4
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..569747874e3
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_6.f
|
|
||||||
@@ -0,0 +1,19 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Test kind specification in variable not in type
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer a
|
|
||||||
+ parameter(a=2)
|
|
||||||
+ integer b*(a)
|
|
||||||
+ real c*(8)
|
|
||||||
+ logical d*(1_1)
|
|
||||||
+ character e*(a)
|
|
||||||
+ if (kind(b).ne.2) stop 1
|
|
||||||
+ if (kind(c).ne.8) stop 2
|
|
||||||
+ if (kind(d).ne.1) stop 3
|
|
||||||
+ if (len(e).ne.2) stop 4
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..b975bfd15c5
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_7.f
|
|
||||||
@@ -0,0 +1,15 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec -fno-dec-override-kind" }
|
|
||||||
+!
|
|
||||||
+! Test kind specification in variable not in type as the per variable
|
|
||||||
+! kind specification is not enables these should fail
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer a
|
|
||||||
+ parameter(a=2)
|
|
||||||
+ integer b*(a) ! { dg-error "Syntax error" }
|
|
||||||
+ real c*(8) ! { dg-error "Syntax error" }
|
|
||||||
+ logical d*1_1 ! { dg-error "Syntax error" }
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..85732e0bd85
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/dec_spec_in_variable_8.f
|
|
||||||
@@ -0,0 +1,14 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-fdec" }
|
|
||||||
+!
|
|
||||||
+! Check that invalid kind values are rejected.
|
|
||||||
+!
|
|
||||||
+! Contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ program spec_in_var
|
|
||||||
+ integer a
|
|
||||||
+ parameter(a=3)
|
|
||||||
+ integer b*(a) ! { dg-error "Kind 3 not supported" }
|
|
||||||
+ real c*(78) ! { dg-error "Kind 78 not supported" }
|
|
||||||
+ logical d*(*) ! { dg-error "Invalid character" }
|
|
||||||
+ end
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
@ -1,305 +0,0 @@
|
|||||||
From 9b45f3063dfd2b893e7963a4828c1b0afecdc68a Mon Sep 17 00:00:00 2001
|
|
||||||
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
|
||||||
Date: Fri, 22 Jan 2021 12:41:46 +0000
|
|
||||||
Subject: [PATCH 02/10] Convert LOGICAL to INTEGER for arithmetic ops, and vice
|
|
||||||
versa
|
|
||||||
|
|
||||||
We allow converting LOGICAL types to INTEGER when doing arithmetic
|
|
||||||
operations, and converting INTEGER types to LOGICAL for use in
|
|
||||||
boolean operations.
|
|
||||||
|
|
||||||
This feature is enabled with the -flogical-as-integer flag.
|
|
||||||
|
|
||||||
Note: using this feature will disable bitwise logical operations enabled by
|
|
||||||
-fdec.
|
|
||||||
---
|
|
||||||
gcc/fortran/lang.opt | 4 ++
|
|
||||||
gcc/fortran/resolve.cc | 55 ++++++++++++++++++-
|
|
||||||
.../logical_to_integer_and_vice_versa_1.f | 31 +++++++++++
|
|
||||||
.../logical_to_integer_and_vice_versa_2.f | 31 +++++++++++
|
|
||||||
.../logical_to_integer_and_vice_versa_3.f | 33 +++++++++++
|
|
||||||
.../logical_to_integer_and_vice_versa_4.f | 33 +++++++++++
|
|
||||||
6 files changed, 186 insertions(+), 1 deletion(-)
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
|
||||||
create mode 100644 gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
|
||||||
|
|
||||||
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
|
||||||
index 52bd522051e..c4da248f07c 100644
|
|
||||||
--- a/gcc/fortran/lang.opt
|
|
||||||
+++ b/gcc/fortran/lang.opt
|
|
||||||
@@ -497,6 +497,10 @@ fdec-static
|
|
||||||
Fortran Var(flag_dec_static)
|
|
||||||
Enable DEC-style STATIC and AUTOMATIC attributes.
|
|
||||||
|
|
||||||
+flogical-as-integer
|
|
||||||
+Fortran Var(flag_logical_as_integer)
|
|
||||||
+Convert from integer to logical or logical to integer for arithmetic operations.
|
|
||||||
+
|
|
||||||
fdefault-double-8
|
|
||||||
Fortran Var(flag_default_double)
|
|
||||||
Set the default double precision kind to an 8 byte wide type.
|
|
||||||
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
|
|
||||||
index c075d0fa0c4..4b90cb59902 100644
|
|
||||||
--- a/gcc/fortran/resolve.cc
|
|
||||||
+++ b/gcc/fortran/resolve.cc
|
|
||||||
@@ -4035,7 +4035,6 @@ lookup_uop_fuzzy (const char *op, gfc_sy
|
|
||||||
return gfc_closest_fuzzy_match (op, candidates);
|
|
||||||
}
|
|
||||||
|
|
||||||
-
|
|
||||||
/* Callback finding an impure function as an operand to an .and. or
|
|
||||||
.or. expression. Remember the last function warned about to
|
|
||||||
avoid double warnings when recursing. */
|
|
||||||
@@ -4095,6 +4094,22 @@ convert_hollerith_to_character (gfc_expr
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
+/* If E is a logical, convert it to an integer and issue a warning
|
|
||||||
+ for the conversion. */
|
|
||||||
+
|
|
||||||
+static void
|
|
||||||
+convert_integer_to_logical (gfc_expr *e)
|
|
||||||
+{
|
|
||||||
+ if (e->ts.type == BT_INTEGER)
|
|
||||||
+ {
|
|
||||||
+ /* Convert to LOGICAL */
|
|
||||||
+ gfc_typespec t;
|
|
||||||
+ t.type = BT_LOGICAL;
|
|
||||||
+ t.kind = 1;
|
|
||||||
+ gfc_convert_type_warn (e, &t, 2, 1);
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
/* Convert to numeric and issue a warning for the conversion. */
|
|
||||||
|
|
||||||
static void
|
|
||||||
@@ -4107,6 +4122,22 @@ convert_to_numeric (gfc_expr *a, gfc_exp
|
|
||||||
gfc_convert_type_warn (a, &t, 2, 1);
|
|
||||||
}
|
|
||||||
|
|
||||||
+/* If E is a logical, convert it to an integer and issue a warning
|
|
||||||
+ for the conversion. */
|
|
||||||
+
|
|
||||||
+static void
|
|
||||||
+convert_logical_to_integer (gfc_expr *e)
|
|
||||||
+{
|
|
||||||
+ if (e->ts.type == BT_LOGICAL)
|
|
||||||
+ {
|
|
||||||
+ /* Convert to INTEGER */
|
|
||||||
+ gfc_typespec t;
|
|
||||||
+ t.type = BT_INTEGER;
|
|
||||||
+ t.kind = 1;
|
|
||||||
+ gfc_convert_type_warn (e, &t, 2, 1);
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
/* Resolve an operator expression node. This can involve replacing the
|
|
||||||
operation with a user defined function call. */
|
|
||||||
|
|
||||||
@@ -4198,6 +4229,12 @@ resolve_operator (gfc_expr *e)
|
|
||||||
case INTRINSIC_TIMES:
|
|
||||||
case INTRINSIC_DIVIDE:
|
|
||||||
case INTRINSIC_POWER:
|
|
||||||
+ if (flag_logical_as_integer)
|
|
||||||
+ {
|
|
||||||
+ convert_logical_to_integer (op1);
|
|
||||||
+ convert_logical_to_integer (op2);
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts))
|
|
||||||
{
|
|
||||||
/* Do not perform conversions if operands are not conformable as
|
|
||||||
@@ -4245,6 +4282,13 @@ resolve_operator (gfc_expr *e)
|
|
||||||
case INTRINSIC_OR:
|
|
||||||
case INTRINSIC_EQV:
|
|
||||||
case INTRINSIC_NEQV:
|
|
||||||
+
|
|
||||||
+ if (flag_logical_as_integer)
|
|
||||||
+ {
|
|
||||||
+ convert_integer_to_logical (op1);
|
|
||||||
+ convert_integer_to_logical (op2);
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
|
|
||||||
{
|
|
||||||
e->ts.type = BT_LOGICAL;
|
|
||||||
@@ -4296,6 +4340,9 @@ resolve_operator (gfc_expr *e)
|
|
||||||
goto simplify_op;
|
|
||||||
}
|
|
||||||
|
|
||||||
+ if (flag_logical_as_integer)
|
|
||||||
+ convert_integer_to_logical (op1);
|
|
||||||
+
|
|
||||||
if (op1->ts.type == BT_LOGICAL)
|
|
||||||
{
|
|
||||||
e->ts.type = BT_LOGICAL;
|
|
||||||
@@ -4336,6 +4383,12 @@ resolve_operator (gfc_expr *e)
|
|
||||||
convert_hollerith_to_character (op2);
|
|
||||||
}
|
|
||||||
|
|
||||||
+ if (flag_logical_as_integer)
|
|
||||||
+ {
|
|
||||||
+ convert_logical_to_integer (op1);
|
|
||||||
+ convert_logical_to_integer (op2);
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
if (op1->ts.type == BT_CHARACTER && op2->ts.type == BT_CHARACTER
|
|
||||||
&& op1->ts.kind == op2->ts.kind)
|
|
||||||
{
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..938a91d9e9a
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_1.f
|
|
||||||
@@ -0,0 +1,31 @@
|
|
||||||
+! { dg-do run }
|
|
||||||
+! { dg-options "-std=legacy -flogical-as-integer" }
|
|
||||||
+!
|
|
||||||
+! Test conversion between logical and integer for logical operators
|
|
||||||
+!
|
|
||||||
+! Test case contributed by Jim MacArthur <jim.macarthur@codethink.co.uk>
|
|
||||||
+! Modified for -flogical-as-integer by Mark Eggleston
|
|
||||||
+! <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+ PROGRAM logical_integer_conversion
|
|
||||||
+ LOGICAL lpos /.true./
|
|
||||||
+ INTEGER ineg/0/
|
|
||||||
+ INTEGER ires
|
|
||||||
+ LOGICAL lres
|
|
||||||
+
|
|
||||||
+ ! Test Logicals converted to Integers
|
|
||||||
+ if ((lpos.AND.ineg).EQ.1) STOP 3
|
|
||||||
+ if ((ineg.AND.lpos).NE.0) STOP 4
|
|
||||||
+ ires = (.true..AND.0)
|
|
||||||
+ if (ires.NE.0) STOP 5
|
|
||||||
+ ires = (1.AND..false.)
|
|
||||||
+ if (ires.EQ.1) STOP 6
|
|
||||||
+
|
|
||||||
+ ! Test Integers converted to Logicals
|
|
||||||
+ if (lpos.EQ.ineg) STOP 7
|
|
||||||
+ if (ineg.EQ.lpos) STOP 8
|
|
||||||
+ lres = (.true..EQ.0)
|
|
||||||
+ if (lres) STOP 9
|
|
||||||
+ lres = (1.EQ..false.)
|
|
||||||
+ if (lres) STOP 10
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..9f146202ba5
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_2.f
|
|
||||||
@@ -0,0 +1,31 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
|
|
||||||
+!
|
|
||||||
+! Based on logical_to_integer_and_vice_versa_1.f but with option disabled
|
|
||||||
+! to test for error messages.
|
|
||||||
+!
|
|
||||||
+! Test case contributed by by Mark Eggleston <mark.eggleston@codethink.com>
|
|
||||||
+!
|
|
||||||
+!
|
|
||||||
+ PROGRAM logical_integer_conversion
|
|
||||||
+ LOGICAL lpos /.true./
|
|
||||||
+ INTEGER ineg/0/
|
|
||||||
+ INTEGER ires
|
|
||||||
+ LOGICAL lres
|
|
||||||
+
|
|
||||||
+ ! Test Logicals converted to Integers
|
|
||||||
+ if ((lpos.AND.ineg).EQ.1) STOP 3 ! { dg-error "Operands of logical operator" }
|
|
||||||
+ if ((ineg.AND.lpos).NE.0) STOP 4 ! { dg-error "Operands of logical operator" }
|
|
||||||
+ ires = (.true..AND.0) ! { dg-error "Operands of logical operator" }
|
|
||||||
+ if (ires.NE.0) STOP 5
|
|
||||||
+ ires = (1.AND..false.) ! { dg-error "Operands of logical operator" }
|
|
||||||
+ if (ires.EQ.1) STOP 6
|
|
||||||
+
|
|
||||||
+ ! Test Integers converted to Logicals
|
|
||||||
+ if (lpos.EQ.ineg) STOP 7 ! { dg-error "Operands of comparison operator" }
|
|
||||||
+ if (ineg.EQ.lpos) STOP 8 ! { dg-error "Operands of comparison operator" }
|
|
||||||
+ lres = (.true..EQ.0) ! { dg-error "Operands of comparison operator" }
|
|
||||||
+ if (lres) STOP 9
|
|
||||||
+ lres = (1.EQ..false.) ! { dg-error "Operands of comparison operator" }
|
|
||||||
+ if (lres) STOP 10
|
|
||||||
+ END
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..446873eb2dc
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_3.f
|
|
||||||
@@ -0,0 +1,33 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-std=legacy -flogical-as-integer" }
|
|
||||||
+!
|
|
||||||
+! Test conversion between logical and integer for logical operators
|
|
||||||
+!
|
|
||||||
+ program test
|
|
||||||
+ logical f /.false./
|
|
||||||
+ logical t /.true./
|
|
||||||
+ real x
|
|
||||||
+
|
|
||||||
+ x = 7.7
|
|
||||||
+ x = x + t*3.0
|
|
||||||
+ if (abs(x - 10.7).gt.0.00001) stop 1
|
|
||||||
+ x = x + .false.*5.0
|
|
||||||
+ if (abs(x - 10.7).gt.0.00001) stop 2
|
|
||||||
+ x = x - .true.*5.0
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 3
|
|
||||||
+ x = x + t
|
|
||||||
+ if (abs(x - 6.7).gt.0.00001) stop 4
|
|
||||||
+ x = x + f
|
|
||||||
+ if (abs(x - 6.7).gt.0.00001) stop 5
|
|
||||||
+ x = x - t
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 6
|
|
||||||
+ x = x - f
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 7
|
|
||||||
+ x = x**.true.
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 8
|
|
||||||
+ x = x**.false.
|
|
||||||
+ if (abs(x - 1.0).gt.0.00001) stop 9
|
|
||||||
+ x = x/t
|
|
||||||
+ if (abs(x - 1.0).gt.0.00001) stop 10
|
|
||||||
+ if ((x/.false.).le.huge(x)) stop 11
|
|
||||||
+ end
|
|
||||||
diff --git a/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
|
||||||
new file mode 100644
|
|
||||||
index 00000000000..4301a4988d8
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/gcc/testsuite/gfortran.dg/logical_to_integer_and_vice_versa_4.f
|
|
||||||
@@ -0,0 +1,33 @@
|
|
||||||
+! { dg-do compile }
|
|
||||||
+! { dg-options "-std=legacy -flogical-as-integer -fno-logical-as-integer" }
|
|
||||||
+!
|
|
||||||
+! Test conversion between logical and integer for logical operators
|
|
||||||
+!
|
|
||||||
+ program test
|
|
||||||
+ logical f /.false./
|
|
||||||
+ logical t /.true./
|
|
||||||
+ real x
|
|
||||||
+
|
|
||||||
+ x = 7.7
|
|
||||||
+ x = x + t*3.0 ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 10.7).gt.0.00001) stop 1
|
|
||||||
+ x = x + .false.*5.0 ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 10.7).gt.0.00001) stop 2
|
|
||||||
+ x = x - .true.*5.0 ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 3
|
|
||||||
+ x = x + t ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 6.7).gt.0.00001) stop 4
|
|
||||||
+ x = x + f ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 6.7).gt.0.00001) stop 5
|
|
||||||
+ x = x - t ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 6
|
|
||||||
+ x = x - f ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 7
|
|
||||||
+ x = x**.true. ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 5.7).gt.0.00001) stop 8
|
|
||||||
+ x = x**.false. ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 1.0).gt.0.00001) stop 9
|
|
||||||
+ x = x/t ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ if (abs(x - 1.0).gt.0.00001) stop 10
|
|
||||||
+ if ((x/.false.).le.huge(x)) stop 11 ! { dg-error "Operands of binary numeric" }
|
|
||||||
+ end
|
|
||||||
--
|
|
||||||
2.27.0
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user