From a6e02ad7b8b66823629a9703af4662b8b4037e2b Mon Sep 17 00:00:00 2001 From: Jim MacArthur Date: Mon, 5 Oct 2015 14:05:03 +0100 Subject: [PATCH 08/23] Allow non-integer substring indexes This feature is enabled by the `-std=extra-legacy` compiler flag. --- commit 9f05bda69f21d7a7c17b58ff0b6392bfd1a06bae Author: Jim MacArthur Date: Mon Oct 5 14:05:03 2015 +0100 Allow non-integer substring indexes This feature is enabled by the `-std=extra-legacy` compiler flag. Test written by: Francisco Redondo Marchena diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 84a4827a1b7..667cc5073e3 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4680,6 +4680,17 @@ resolve_substring (gfc_ref *ref) if (!gfc_resolve_expr (ref->u.ss.start)) return false; + /* In legacy mode, allow non-integer string indexes by converting */ + if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) + && 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", @@ -4709,6 +4720,17 @@ resolve_substring (gfc_ref *ref) if (!gfc_resolve_expr (ref->u.ss.end)) return false; + /* Non-integer string index endings, as for start */ + if ((gfc_option.allow_std & GFC_STD_EXTRA_LEGACY) + && 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.f b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f new file mode 100644 index 00000000000..8f5c8eb3c0e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_not_integer_substring_indexes.f @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-options "-std=extra-legacy" } +! +! Test not integer substring indexes +! + PROGRAM not_integer_substring_indexes + CHARACTER*5 st/'Tests'/ + CHARACTER*4 st2 + REAL ir/1.0/ + REAL ir2/4.0/ + + st2 = st(ir:4) + st2 = st(1:ir2) + st2 = st(1.0:4) + st2 = st(1:4.0) + st2 = st(1.5:4) + END