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.
158 lines
5.8 KiB
158 lines
5.8 KiB
From 67aef262311d6a746786ee0f59748ccaa7e1e711 Mon Sep 17 00:00:00 2001 |
|
From: Mark Eggleston <markeggleston@gcc.gnu.org> |
|
Date: Fri, 22 Jan 2021 13:09:54 +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 c4da248f07c..d527c106bd6 100644 |
|
--- a/gcc/fortran/lang.opt |
|
+++ b/gcc/fortran/lang.opt |
|
@@ -489,6 +489,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 f19ba87f8a0..9a042f64881 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 4b90cb59902..bc0df0fdb99 100644 |
|
--- a/gcc/fortran/resolve.c |
|
+++ b/gcc/fortran/resolve.c |
|
@@ -5131,6 +5131,16 @@ gfc_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", |
|
@@ -5160,6 +5170,16 @@ gfc_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.27.0 |
|
|
|
|