Blame SOURCES/gcc11-fortran-fdec-non-integer-index.patch

f61693
From 67aef262311d6a746786ee0f59748ccaa7e1e711 Mon Sep 17 00:00:00 2001
f61693
From: Mark Eggleston <markeggleston@gcc.gnu.org>
f61693
Date: Fri, 22 Jan 2021 13:09:54 +0000
f61693
Subject: [PATCH 04/10] Allow non-integer substring indexes
f61693
f61693
Use -fdec-non-integer-index compiler flag to enable. Also enabled by -fdec.
f61693
---
f61693
 gcc/fortran/lang.opt                          |  4 ++++
f61693
 gcc/fortran/options.c                         |  1 +
f61693
 gcc/fortran/resolve.c                         | 20 +++++++++++++++++++
f61693
 .../dec_not_integer_substring_indexes_1.f     | 18 +++++++++++++++++
f61693
 .../dec_not_integer_substring_indexes_2.f     | 18 +++++++++++++++++
f61693
 .../dec_not_integer_substring_indexes_3.f     | 18 +++++++++++++++++
f61693
 6 files changed, 79 insertions(+)
f61693
 create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
f61693
 create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
f61693
 create mode 100644 gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
f61693
f61693
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
f61693
index c4da248f07c..d527c106bd6 100644
f61693
--- a/gcc/fortran/lang.opt
f61693
+++ b/gcc/fortran/lang.opt
f61693
@@ -489,6 +489,10 @@ fdec-math
f61693
 Fortran Var(flag_dec_math)
f61693
 Enable legacy math intrinsics for compatibility.
f61693
 
f61693
+fdec-non-integer-index
f61693
+Fortran Var(flag_dec_non_integer_index)
f61693
+Enable support for non-integer substring indexes.
f61693
+
f61693
 fdec-structure
f61693
 Fortran Var(flag_dec_structure)
f61693
 Enable support for DEC STRUCTURE/RECORD.
f61693
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
f61693
index f19ba87f8a0..9a042f64881 100644
f61693
--- a/gcc/fortran/options.c
f61693
+++ b/gcc/fortran/options.c
f61693
@@ -78,6 +78,7 @@ set_dec_flags (int value)
f61693
   SET_BITFLAG (flag_dec_blank_format_item, value, value);
f61693
   SET_BITFLAG (flag_dec_char_conversions, value, value);
f61693
   SET_BITFLAG (flag_dec_duplicates, value, value);
f61693
+  SET_BITFLAG (flag_dec_non_integer_index, value, value);
f61693
 }
f61693
 
f61693
 /* Finalize DEC flags.  */
f61693
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
f61693
index 4b90cb59902..bc0df0fdb99 100644
f61693
--- a/gcc/fortran/resolve.c
f61693
+++ b/gcc/fortran/resolve.c
f61693
@@ -5131,6 +5131,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
f61693
       if (!gfc_resolve_expr (ref->u.ss.start))
f61693
 	return false;
f61693
 
f61693
+      /* In legacy mode, allow non-integer string indexes by converting */
f61693
+      if (flag_dec_non_integer_index && ref->u.ss.start->ts.type != BT_INTEGER
f61693
+	  && gfc_numeric_ts (&ref->u.ss.start->ts))
f61693
+	{
f61693
+	  gfc_typespec t;
f61693
+	  t.type = BT_INTEGER;
f61693
+	  t.kind = ref->u.ss.start->ts.kind;
f61693
+	  gfc_convert_type_warn (ref->u.ss.start, &t, 2, 1);
f61693
+	}
f61693
+
f61693
       if (ref->u.ss.start->ts.type != BT_INTEGER)
f61693
 	{
f61693
 	  gfc_error ("Substring start index at %L must be of type INTEGER",
f61693
@@ -5160,6 +5170,16 @@ gfc_resolve_substring (gfc_ref *ref, bool *equal_length)
f61693
       if (!gfc_resolve_expr (ref->u.ss.end))
f61693
 	return false;
f61693
 
f61693
+      /* Non-integer string index endings, as for start */
f61693
+      if (flag_dec_non_integer_index && ref->u.ss.end->ts.type != BT_INTEGER
f61693
+	  && gfc_numeric_ts (&ref->u.ss.end->ts))
f61693
+	{
f61693
+	  gfc_typespec t;
f61693
+	  t.type = BT_INTEGER;
f61693
+	  t.kind = ref->u.ss.end->ts.kind;
f61693
+	  gfc_convert_type_warn (ref->u.ss.end, &t, 2, 1);
f61693
+	}
f61693
+
f61693
       if (ref->u.ss.end->ts.type != BT_INTEGER)
f61693
 	{
f61693
 	  gfc_error ("Substring end index at %L must be of type INTEGER",
f61693
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
f61693
new file mode 100644
f61693
index 00000000000..0be28abaa4b
f61693
--- /dev/null
f61693
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_1.f
f61693
@@ -0,0 +1,18 @@
f61693
+! { dg-do run }
f61693
+! { dg-options "-fdec" }
f61693
+!
f61693
+! Test not integer substring indexes
f61693
+!
f61693
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
f61693
+!
f61693
+        PROGRAM not_integer_substring_indexes
f61693
+          CHARACTER*5 st/'Tests'/
f61693
+          REAL ir/1.0/
f61693
+          REAL ir2/4.0/
f61693
+
f61693
+          if (st(ir:4).ne.'Test') stop 1
f61693
+          if (st(1:ir2).ne.'Test') stop 2
f61693
+          if (st(1.0:4).ne.'Test') stop 3
f61693
+          if (st(1:4.0).ne.'Test') stop 4
f61693
+          if (st(2.5:4).ne.'est') stop 5
f61693
+        END
f61693
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
f61693
new file mode 100644
f61693
index 00000000000..3cf05296d0c
f61693
--- /dev/null
f61693
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_2.f
f61693
@@ -0,0 +1,18 @@
f61693
+! { dg-do run }
f61693
+! { dg-options "-fdec-non-integer-index" }
f61693
+!
f61693
+! Test not integer substring indexes
f61693
+!
f61693
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
f61693
+!
f61693
+        PROGRAM not_integer_substring_indexes
f61693
+          CHARACTER*5 st/'Tests'/
f61693
+          REAL ir/1.0/
f61693
+          REAL ir2/4.0/
f61693
+
f61693
+          if (st(ir:4).ne.'Test') stop 1
f61693
+          if (st(1:ir2).ne.'Test') stop 2
f61693
+          if (st(1.0:4).ne.'Test') stop 3
f61693
+          if (st(1:4.0).ne.'Test') stop 4
f61693
+          if (st(2.5:4).ne.'est') stop 5
f61693
+        END
f61693
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
f61693
new file mode 100644
f61693
index 00000000000..703de995897
f61693
--- /dev/null
f61693
+++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes_3.f
f61693
@@ -0,0 +1,18 @@
f61693
+! { dg-do compile }
f61693
+! { dg-options "-fdec -fno-dec-non-integer-index" }
f61693
+!
f61693
+! Test not integer substring indexes
f61693
+!
f61693
+! Test case contributed by Mark Eggleston <mark.eggleston@codethink.com>
f61693
+!
f61693
+        PROGRAM not_integer_substring_indexes
f61693
+          CHARACTER*5 st/'Tests'/
f61693
+          REAL ir/1.0/
f61693
+          REAL ir2/4.0/
f61693
+
f61693
+          if (st(ir:4).ne.'Test') stop 1 ! { dg-error "Substring start index" }
f61693
+          if (st(1:ir2).ne.'Test') stop 2 ! { dg-error "Substring end index" }
f61693
+          if (st(1.0:4).ne.'Test') stop 3 ! { dg-error "Substring start index" }
f61693
+          if (st(1:4.0).ne.'Test') stop 4 ! { dg-error "Substring end index" }
f61693
+          if (st(2.5:4).ne.'est') stop 5 ! { dg-error "Substring start index" }
f61693
+        END
f61693
-- 
f61693
2.27.0
f61693