You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
159 lines
5.9 KiB
159 lines
5.9 KiB
3 years ago
|
From e61c233e6af3c392f5ac7d3f927b3fa8a55c6076 Mon Sep 17 00:00:00 2001
|
||
|
From: Mark Eggleston <markeggleston@gcc.gnu.org>
|
||
|
Date: Mon, 3 Feb 2020 09:11:38 +0000
|
||
|
Subject: [PATCH 04/10] Allow non-integer substring indexes
|
||
|
|
||
|
Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
|
||
|
---
|
||
|
gcc/fortran/lang.opt | 4 ++++
|
||
|
gcc/fortran/options.c | 1 +
|
||
|
gcc/fortran/resolve.c | 20 ++++++++++++++++++++
|
||
|
.../dec_not_integer_substring_indexes_1.f | 18 ++++++++++++++++++
|
||
|
.../dec_not_integer_substring_indexes_2.f | 18 ++++++++++++++++++
|
||
|
.../dec_not_integer_substring_indexes_3.f | 18 ++++++++++++++++++
|
||
|
6 files changed, 79 insertions(+)
|
||
|
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
|
||
|
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
|
||
|
create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
|
||
|
|
||
|
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
|
||
|
index 5257da74b06..0fea012b7b6 100644
|
||
|
--- a/gcc/fortran/lang.opt
|
||
|
+++ b/gcc/fortran/lang.opt
|
||
|
@@ -485,6 +485,10 @@ fdec-math
|
||
|
Fortran Var(flag_dec_math)
|
||
|
Enable legacy math intrinsics for compatibility.
|
||
|
|
||
|
+fdec-non-integer-index
|
||
|
+Fortran Var(flag_dec_non_integer_index)
|
||
|
+Enable support for non-integer substring indexes.
|
||
|
+
|
||
|
fdec-structure
|
||
|
Fortran Var(flag_dec_structure)
|
||
|
Enable support for DEC STRUCTURE/RECORD.
|
||
|
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
|
||
|
index 75181ca6442..8c79a0bd122 100644
|
||
|
--- a/gcc/fortran/options.c
|
||
|
+++ b/gcc/fortran/options.c
|
||
|
@@ -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_non_integer_index, value, value);
|
||
|
}
|
||
|
|
||
|
/* Finalize DEC flags. */
|
||
|
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
|
||
|
index 6e70eaf8812..044eed22c76 100644
|
||
|
--- a/gcc/fortran/resolve.c
|
||
|
+++ b/gcc/fortran/resolve.c
|
||
|
@@ -5087,6 +5087,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
|
||
|
if (!gfc_resolve_expr (ref->u.ss.start))
|
||
|
return false;
|
||
|
|
||
|
+ /* In legacy mode, allow non-integer string indexes by converting */
|
||
|
+ if (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER
|
||
|
+ && gfc_numeric_ts (&ref->u.ss.start->ts))
|
||
|
+ {
|
||
|
+ gfc_typespec t;
|
||
|
+ t.type = BT_INTEGER;
|
||
|
+ t.kind = ref->u.ss.start->ts.kind;
|
||
|
+ gfc_convert_type_warn (ref->u.ss.start, &t, 2, 1);
|
||
|
+ }
|
||
|
+
|
||
|
if (ref->u.ss.start->ts.type != BT_INTEGER)
|
||
|
{
|
||
|
gfc_error ("Substring start index at %L must be of type INTEGER",
|
||
|
@@ -5116,6 +5126,16 @@ resolve_substring (gfc_ref *ref, bool *equal_length)
|
||
|
if (!gfc_resolve_expr (ref->u.ss.end))
|
||
|
return false;
|
||
|
|
||
|
+ /* Non-integer string index endings, as for start */
|
||
|
+ if (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER
|
||
|
+ && gfc_numeric_ts (&ref->u.ss.end->ts))
|
||
|
+ {
|
||
|
+ gfc_typespec t;
|
||
|
+ t.type = BT_INTEGER;
|
||
|
+ t.kind = ref->u.ss.end->ts.kind;
|
||
|
+ gfc_convert_type_warn (ref->u.ss.end, &t, 2, 1);
|
||
|
+ }
|
||
|
+
|
||
|
if (ref->u.ss.end->ts.type != BT_INTEGER)
|
||
|
{
|
||
|
gfc_error ("Substring end index at %L must be of type INTEGER",
|
||
|
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
|
||
|
new file mode 100644
|
||
|
index 00000000000..0be28abaa4b
|
||
|
--- /dev/null
|
||
|
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
|
||
|
@@ -0,0 +1,18 @@
|
||
|
+! { dg-do run }
|
||
|
+! { dg-options "-fdec" }
|
||
|
+!
|
||
|
+! Test not integer substring indexes
|
||
|
+!
|
||
|
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
||
|
+!
|
||
|
+ PROGRAM not_integer_substring_indexes
|
||
|
+ CHARACTER*5 st/'Tests'/
|
||
|
+ REAL ir/1.0/
|
||
|
+ REAL ir2/4.0/
|
||
|
+
|
||
|
+ if (st(ir:4).ne.'Test') stop 1
|
||
|
+ if (st(1:ir2).ne.'Test') stop 2
|
||
|
+ if (st(1.0:4).ne.'Test') stop 3
|
||
|
+ if (st(1:4.0).ne.'Test') stop 4
|
||
|
+ if (st(2.5:4).ne.'est') stop 5
|
||
|
+ END
|
||
|
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
|
||
|
new file mode 100644
|
||
|
index 00000000000..3cf05296d0c
|
||
|
--- /dev/null
|
||
|
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
|
||
|
@@ -0,0 +1,18 @@
|
||
|
+! { dg-do run }
|
||
|
+! { dg-options "-fdec-non-integer-index" }
|
||
|
+!
|
||
|
+! Test not integer substring indexes
|
||
|
+!
|
||
|
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
||
|
+!
|
||
|
+ PROGRAM not_integer_substring_indexes
|
||
|
+ CHARACTER*5 st/'Tests'/
|
||
|
+ REAL ir/1.0/
|
||
|
+ REAL ir2/4.0/
|
||
|
+
|
||
|
+ if (st(ir:4).ne.'Test') stop 1
|
||
|
+ if (st(1:ir2).ne.'Test') stop 2
|
||
|
+ if (st(1.0:4).ne.'Test') stop 3
|
||
|
+ if (st(1:4.0).ne.'Test') stop 4
|
||
|
+ if (st(2.5:4).ne.'est') stop 5
|
||
|
+ END
|
||
|
diff --git a/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
|
||
|
new file mode 100644
|
||
|
index 00000000000..703de995897
|
||
|
--- /dev/null
|
||
|
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
|
||
|
@@ -0,0 +1,18 @@
|
||
|
+! { dg-do compile }
|
||
|
+! { dg-options "-fdec -fno-dec-non-integer-index" }
|
||
|
+!
|
||
|
+! Test not integer substring indexes
|
||
|
+!
|
||
|
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
|
||
|
+!
|
||
|
+ PROGRAM not_integer_substring_indexes
|
||
|
+ CHARACTER*5 st/'Tests'/
|
||
|
+ REAL ir/1.0/
|
||
|
+ REAL ir2/4.0/
|
||
|
+
|
||
|
+ if (st(ir:4).ne.'Test') stop 1 ! { dg-error "Substring start index" }
|
||
|
+ if (st(1:ir2).ne.'Test') stop 2 ! { dg-error "Substring end index" }
|
||
|
+ if (st(1.0:4).ne.'Test') stop 3 ! { dg-error "Substring start index" }
|
||
|
+ if (st(1:4.0).ne.'Test') stop 4 ! { dg-error "Substring end index" }
|
||
|
+ if (st(2.5:4).ne.'est') stop 5 ! { dg-error "Substring start index" }
|
||
|
+ END
|
||
|
--
|
||
|
2.11.0
|
||
|
|