From 96563a652406d3c8471d75e6527ba634fa013400 Mon Sep 17 00:00:00 2001

From: Jim MacArthur <jim.macarthur@codethink.co.uk>

Date: Mon, 5 Oct 2015 14:05:03 +0100

Subject: [PATCH 08/16] 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 3d8aaeaaf44..772cf5e81f1 100644

--- a/gcc/fortran/lang.opt

+++ b/gcc/fortran/lang.opt

@@ -474,6 +474,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 a8c2cf71c3b..e0ef03e6cc5 100644

--- a/gcc/fortran/options.c

+++ b/gcc/fortran/options.c

@@ -79,6 +79,7 @@ set_dec_flags (int value)

   SET_BITFLAG (flag_dec_char_conversions, value, value);

   SET_BITFLAG (flag_dec_comparisons, value, value);

   SET_BITFLAG (flag_dec_blank_format_item, 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 c8b6333874b..04679d3a15d 100644

--- a/gcc/fortran/resolve.c

+++ b/gcc/fortran/resolve.c

@@ -4992,6 +4992,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",

@@ -5021,6 +5031,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