From 67aef262311d6a746786ee0f59748ccaa7e1e711 Mon Sep 17 00:00:00 2001 From: Mark Eggleston 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.cc | 1 + gcc/fortran/resolve.cc | 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.cc b/gcc/fortran/options.cc index f19ba87f8a0..9a042f64881 100644 --- a/gcc/fortran/options.cc +++ b/gcc/fortran/options.cc @@ -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.cc b/gcc/fortran/resolve.cc index 4b90cb59902..bc0df0fdb99 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -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 +! + 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 +! + 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 +! + 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