From 0335cc372c9849c61b9a5583655820d88ecf829e Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Tue, 15 Jan 2019 22:18:55 +0000 Subject: [PATCH] re PR fortran/43072 (unneeded temporary (s=s+f(a))) 2019-01-15 Thomas Koenig PR fortran/43072 * resolve.c (resolve_array_ref): Add equal_length argument; set it if the length of the substring equals that of the orignal variable. (resolve_ref): Remove the substring if it is equal in length to the original variable, unless it is an EXPR_SUBSTRING). 2019-01-15 Thomas Koenig PR fortran/43072 * gfortran.dg/actual_array_substr_3.f90: New test. From-SVN: r267953 --- gcc/fortran/ChangeLog | 9 ++++++ gcc/fortran/resolve.c | 28 ++++++++++++++++--- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/actual_array_substr_3.f90 | 11 ++++++++ 4 files changed, 49 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/actual_array_substr_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 76a840db864..574f50a4a1e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2019-01-15 Thomas Koenig + + PR fortran/43072 + * resolve.c (resolve_array_ref): Add equal_length argument; set it + if the length of the substring equals that of the orignal + variable. + (resolve_ref): Remove the substring if it is equal in length to + the original variable, unless it is an EXPR_SUBSTRING). + 2019-01-15 Steven G. Kargl PR fortran/81849 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7fbfa693526..b1c92929003 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4873,7 +4873,7 @@ resolve_array_ref (gfc_array_ref *ar) static bool -resolve_substring (gfc_ref *ref) +resolve_substring (gfc_ref *ref, bool *equal_length) { int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false); @@ -4944,6 +4944,13 @@ resolve_substring (gfc_ref *ref) &ref->u.ss.end->where); return false; } + /* If the substring has the same length as the original + variable, the reference itself can be deleted. */ + + if (ref->u.ss.length != NULL + && compare_bound (ref->u.ss.end, ref->u.ss.length->length) == CMP_EQ + && compare_bound_int (ref->u.ss.start, 1) == CMP_EQ) + *equal_length = true; } return true; @@ -5037,7 +5044,8 @@ static bool resolve_ref (gfc_expr *expr) { int current_part_dimension, n_components, seen_part_dimension; - gfc_ref *ref; + gfc_ref *ref, **prev; + bool equal_length; for (ref = expr->ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->u.ar.as == NULL) @@ -5046,7 +5054,8 @@ resolve_ref (gfc_expr *expr) break; } - for (ref = expr->ref; ref; ref = ref->next) + + for (ref = expr->ref, prev = &expr->ref; ref; prev = &ref->next, ref = ref->next) switch (ref->type) { case REF_ARRAY: @@ -5059,8 +5068,19 @@ resolve_ref (gfc_expr *expr) break; case REF_SUBSTRING: - if (!resolve_substring (ref)) + equal_length = false; + if (!resolve_substring (ref, &equal_length)) return false; + + if (expr->expr_type != EXPR_SUBSTRING && equal_length) + { + /* Remove the reference and move the charlen, if any. */ + *prev = ref->next; + ref->next = NULL; + expr->ts.u.cl = ref->u.ss.length; + ref->u.ss.length = NULL; + gfc_free_ref_list (ref); + } break; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 56265c8641b..9c9299e074c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-01-15 Thomas Koenig + + PR fortran/43072 + * gfortran.dg/actual_array_substr_3.f90: New test. + 2019-01-15 Steven G. Kargl PR fortran/81849 diff --git a/gcc/testsuite/gfortran.dg/actual_array_substr_3.f90 b/gcc/testsuite/gfortran.dg/actual_array_substr_3.f90 new file mode 100644 index 00000000000..30d8edf2d42 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/actual_array_substr_3.f90 @@ -0,0 +1,11 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } +! PR 43072 - no temporary needed because the substring +! is of equal length to the string. +subroutine foo2 + implicit none + external foo + character(len=20) :: str(2) = '1234567890' + call foo(str(:)(1:20)) +end +! { dg-final { scan-tree-dump-not "memmove" "original" } } -- 2.30.2