From a8006d0933c8c954b134152c1fb60a379c7fb846 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Sat, 6 Aug 2005 12:00:53 +0200 Subject: [PATCH] re PR fortran/18833 (ICE 'missing spec' on integer/char equivalence) PR fortran/18833 PR fortran/20850 * primary.c (match_varspec): If equiv_flag, don't look at sym's attributes, call gfc_match_array_ref up to twice and don't do any substring or component processing. * resolve.c (resolve_equivalence): Transform REF_ARRAY into REF_SUBSTRING or nothing if needed. Check that substrings don't have zero length. * gfortran.dg/equiv_1.f90: New test. * gfortran.dg/equiv_2.f90: New test. * gfortran.fortran-torture/execute/equiv_2.f90: New test. * gfortran.fortran-torture/execute/equiv_3.f90: New test. * gfortran.fortran-torture/execute/equiv_4.f90: New test. From-SVN: r102801 --- gcc/fortran/ChangeLog | 11 +++ gcc/fortran/primary.c | 30 ++++-- gcc/fortran/resolve.c | 96 ++++++++++++++++--- gcc/testsuite/ChangeLog | 10 ++ gcc/testsuite/gfortran.dg/equiv_1.f90 | 9 ++ gcc/testsuite/gfortran.dg/equiv_2.f90 | 17 ++++ .../execute/equiv_2.f90 | 46 +++++++++ .../execute/equiv_3.f90 | 13 +++ .../execute/equiv_4.f90 | 54 +++++++++++ 9 files changed, 267 insertions(+), 19 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/equiv_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/equiv_2.f90 create mode 100644 gcc/testsuite/gfortran.fortran-torture/execute/equiv_2.f90 create mode 100644 gcc/testsuite/gfortran.fortran-torture/execute/equiv_3.f90 create mode 100644 gcc/testsuite/gfortran.fortran-torture/execute/equiv_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index be0e9c992ac..49d9f1d5d8c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2005-08-06 Jakub Jelinek + + PR fortran/18833 + PR fortran/20850 + * primary.c (match_varspec): If equiv_flag, don't look at sym's + attributes, call gfc_match_array_ref up to twice and don't do any + substring or component processing. + * resolve.c (resolve_equivalence): Transform REF_ARRAY into + REF_SUBSTRING or nothing if needed. Check that substrings + don't have zero length. + 2005-08-05 Thomas Koenig * trans-expr.c (gfc_build_builtin_function_decls): Mark diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 888caffa5c2..34cc908ce95 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1517,28 +1517,42 @@ match_varspec (gfc_expr * primary, int equiv_flag) char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_ref *substring, *tail; gfc_component *component; - gfc_symbol *sym; + gfc_symbol *sym = primary->symtree->n.sym; match m; tail = NULL; - if (primary->symtree->n.sym->attr.dimension - || (equiv_flag - && gfc_peek_char () == '(')) + if ((equiv_flag && gfc_peek_char () == '(') + || sym->attr.dimension) { - + /* In EQUIVALENCE, we don't know yet whether we are seeing + an array, character variable or array of character + variables. We'll leave the decision till resolve + time. */ tail = extend_ref (primary, tail); tail->type = REF_ARRAY; - m = gfc_match_array_ref (&tail->u.ar, primary->symtree->n.sym->as, - equiv_flag); + m = gfc_match_array_ref (&tail->u.ar, equiv_flag ? NULL : sym->as, + equiv_flag); if (m != MATCH_YES) return m; + + if (equiv_flag && gfc_peek_char () == '(') + { + tail = extend_ref (primary, tail); + tail->type = REF_ARRAY; + + m = gfc_match_array_ref (&tail->u.ar, NULL, equiv_flag); + if (m != MATCH_YES) + return m; + } } - sym = primary->symtree->n.sym; primary->ts = sym->ts; + if (equiv_flag) + return MATCH_YES; + if (sym->ts.type != BT_DERIVED || gfc_match_char ('%') != MATCH_YES) goto check_substring; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8718f4d4529..5910a1b0aaf 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4757,7 +4757,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) sequence derived type containing a pointer at any level of component selection, an automatic object, a function name, an entry name, a result name, a named constant, a structure component, or a subobject of any of - the preceding objects. */ + the preceding objects. A substring shall not have length zero. */ static void resolve_equivalence (gfc_equiv *eq) @@ -4770,6 +4770,69 @@ resolve_equivalence (gfc_equiv *eq) for (; eq; eq = eq->eq) { e = eq->expr; + + e->ts = e->symtree->n.sym->ts; + /* match_varspec might not know yet if it is seeing + array reference or substring reference, as it doesn't + know the types. */ + if (e->ref && e->ref->type == REF_ARRAY) + { + gfc_ref *ref = e->ref; + sym = e->symtree->n.sym; + + if (sym->attr.dimension) + { + ref->u.ar.as = sym->as; + ref = ref->next; + } + + /* For substrings, convert REF_ARRAY into REF_SUBSTRING. */ + if (e->ts.type == BT_CHARACTER + && ref + && ref->type == REF_ARRAY + && ref->u.ar.dimen == 1 + && ref->u.ar.dimen_type[0] == DIMEN_RANGE + && ref->u.ar.stride[0] == NULL) + { + gfc_expr *start = ref->u.ar.start[0]; + gfc_expr *end = ref->u.ar.end[0]; + void *mem = NULL; + + /* Optimize away the (:) reference. */ + if (start == NULL && end == NULL) + { + if (e->ref == ref) + e->ref = ref->next; + else + e->ref->next = ref->next; + mem = ref; + } + else + { + ref->type = REF_SUBSTRING; + if (start == NULL) + start = gfc_int_expr (1); + ref->u.ss.start = start; + if (end == NULL && e->ts.cl) + end = gfc_copy_expr (e->ts.cl->length); + ref->u.ss.end = end; + ref->u.ss.length = e->ts.cl; + e->ts.cl = NULL; + } + ref = ref->next; + gfc_free (mem); + } + + /* Any further ref is an error. */ + if (ref) + { + gcc_assert (ref->type == REF_ARRAY); + gfc_error ("Syntax error in EQUIVALENCE statement at %L", + &ref->u.ar.where); + continue; + } + } + if (gfc_resolve_expr (e) == FAILURE) continue; @@ -4832,19 +4895,30 @@ resolve_equivalence (gfc_equiv *eq) continue; } - /* Shall not be a structure component. */ r = e->ref; while (r) { - if (r->type == REF_COMPONENT) - { - gfc_error ("Structure component '%s' at %L cannot be an " - "EQUIVALENCE object", - r->u.c.component->name, &e->where); - break; - } - r = r->next; - } + /* Shall not be a structure component. */ + if (r->type == REF_COMPONENT) + { + gfc_error ("Structure component '%s' at %L cannot be an " + "EQUIVALENCE object", + r->u.c.component->name, &e->where); + break; + } + + /* A substring shall not have length zero. */ + if (r->type == REF_SUBSTRING) + { + if (compare_bound (r->u.ss.start, r->u.ss.end) == CMP_GT) + { + gfc_error ("Substring at %L has length zero", + &r->u.ss.start->where); + break; + } + } + r = r->next; + } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8b37d466490..5f0466a84d0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2005-08-06 Jakub Jelinek + + PR fortran/18833 + PR fortran/20850 + * gfortran.dg/equiv_1.f90: New test. + * gfortran.dg/equiv_2.f90: New test. + * gfortran.fortran-torture/execute/equiv_2.f90: New test. + * gfortran.fortran-torture/execute/equiv_3.f90: New test. + * gfortran.fortran-torture/execute/equiv_4.f90: New test. + 2005-08-05 James A. Morrison * gcc.c-torture/execute/vrp-5.c: New test. diff --git a/gcc/testsuite/gfortran.dg/equiv_1.f90 b/gcc/testsuite/gfortran.dg/equiv_1.f90 new file mode 100644 index 00000000000..8a8a8b97b8b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/equiv_1.f90 @@ -0,0 +1,9 @@ + program broken_equiv + real d (2) ! { dg-error "Inconsistent equivalence rules" "d" } + real e ! { dg-error "Inconsistent equivalence rules" "e" } + equivalence (d (1), e), (d (2), e) + + real f (2) ! { dg-error "Inconsistent equivalence rules" "f" } + double precision g (2) ! { dg-error "Inconsistent equivalence rules" "g" } + equivalence (f (1), g (1)), (f (2), g (2)) ! Not standard conforming + end diff --git a/gcc/testsuite/gfortran.dg/equiv_2.f90 b/gcc/testsuite/gfortran.dg/equiv_2.f90 new file mode 100644 index 00000000000..4bcdca1afc8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/equiv_2.f90 @@ -0,0 +1,17 @@ + subroutine broken_equiv1 + character*4 h + character*3 i + equivalence (h(1:3), i(2:1)) ! { dg-error "has length zero" } + end subroutine + + subroutine broken_equiv2 + character*4 j + character*2 k + equivalence (j(2:3), k(1:5)) ! { dg-error "out of bounds" } + end subroutine + + subroutine broken_equiv3 + character*4 l + character*2 m + equivalence (l(2:3:4), m(1:2)) ! { dg-error "\[Ss\]yntax error" } + end subroutine diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/equiv_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/equiv_2.f90 new file mode 100644 index 00000000000..1c88ff99643 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/equiv_2.f90 @@ -0,0 +1,46 @@ + subroutine test1 + character*8 c + character*1 d, f + dimension d(2), f(2) + character*4 e + equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2)) + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort + if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort + end subroutine test1 + subroutine test2 + equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2)) + character*8 c + character*1 d, f + dimension d(2), f(2) + character*4 e + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort + if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort + end subroutine test2 + subroutine test3 + character*8 c + character*1 d, f + character*4 e + equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2)) + dimension d(2), f(2) + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort + if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort + end subroutine test3 + subroutine test4 + dimension d(2), f(2) + equivalence (c(1:1), d(1)), (c(3:5), e(2:4)), (c(6:6), f(2)) + character*8 c + character*1 d, f + character*4 e + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'a'.or.d(2).ne.'b') call abort + if (e.ne.'bcde'.or.f(1).ne.'e'.or.f(2).ne.'f') call abort + end subroutine test4 + program main + call test1 + call test2 + call test3 + call test4 + end program main diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/equiv_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/equiv_3.f90 new file mode 100644 index 00000000000..75103e200fb --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/equiv_3.f90 @@ -0,0 +1,13 @@ + subroutine test1 + type t + sequence + character(8) c + end type t + type(t) :: tc, td + equivalence (tc, td) + tc%c='abcdefgh' + if (tc%c.ne.'abcdefgh'.or.td%c(1:1).ne.'a') call abort + end subroutine test1 + program main + call test1 + end program main diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/equiv_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/equiv_4.f90 new file mode 100644 index 00000000000..9c232786dbb --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/execute/equiv_4.f90 @@ -0,0 +1,54 @@ + subroutine test1 + character*8 c + character*2 d, f + dimension d(2), f(2) + character*4 e + equivalence (c(1:1), d(1)(2:)), (c(3:5), e(2:4)) + equivalence (c(6:6), f(2)(:)) + d(1)='AB' + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort + if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort + end subroutine test1 + subroutine test2 + equivalence (c(1:1), d(1)(2:2)), (c(3:5), e(2:4)) + equivalence (c(6:6), f(2)(1:)) + character*8 c + character*2 d, f + dimension d(2), f(2) + character*4 e + d(1)='AB' + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort + if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort + end subroutine test2 + subroutine test3 + character*8 c + character*2 d, f + character*4 e + equivalence (c(1:1), d(1)(2:)), (c(3:5), e(2:4)) + equivalence (c(6:6), f(2)(:1)) + dimension d(2), f(2) + d(1)='AB' + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort + if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort + end subroutine test3 + subroutine test4 + dimension d(2), f(2) + equivalence (c(1:1), d(1)(2:2)), (c(3:5), e(2:4)) + equivalence (c(6:6), f(2)(1:2)) + character*8 c + character*2 d, f + character*4 e + d(1)='AB' + c='abcdefgh' + if (c.ne.'abcdefgh'.or.d(1).ne.'Aa'.or.d(2).ne.'bc') call abort + if (e.ne.'bcde'.or.f(1).ne.'de'.or.f(2).ne.'fg') call abort + end subroutine test4 + program main + call test1 + call test2 + call test3 + call test4 + end program main -- 2.30.2