From d28480827e3674794d7d6793148c737d491bc9ba Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Wed, 18 Jun 2008 15:53:32 +0200 Subject: [PATCH] PR fortran/36517, fortran/36492 2008-06-18 Daniel Kraft PR fortran/36517, fortran/36492 * gfortran.dg/array_constructor_25.f03: New test. * gfortran.dg/array_constructor_26.f03: New test. * gfortran.dg/array_constructor_27.f03: New test. * gfortran.dg/array_constructor_28.f03: New test. * gfortran.dg/array_constructor_29.f03: New test. * gfortran.dg/array_constructor_30.f03: New test. * gfortran.dg/array_constructor_type_19.f03: New test. * gfortran.dg/array_constructor_type_20.f03: New test. * gfortran.dg/array_constructor_type_21.f03: New test. 2008-06-18 Daniel Kraft PR fortran/36517, fortran/36492 * array.c (gfc_resolve_character_array_constructor): Call gfc_set_constant_character_len with changed length-chec argument. * decl.c (gfc_set_constant_character_len): Changed array argument to be a generic length-checking argument that can be used for correct checking with typespec and in special cases where the should-be length is different from the target length. (build_struct): Call gfc_set_constant_character_len with changed length checking argument and introduced additional checks for exceptional conditions on invalid code. (add_init_expr_to_sym), (do_parm): Call gfc_set_constant_character_len with changed argument. * match.h (gfc_set_constant_character_len): Changed third argument to int for the should-be length rather than bool. From-SVN: r136894 --- gcc/fortran/ChangeLog | 17 ++++++ gcc/fortran/array.c | 42 ++++++++------ gcc/fortran/decl.c | 58 ++++++++++++++----- gcc/fortran/match.h | 2 +- gcc/testsuite/ChangeLog | 13 +++++ .../gfortran.dg/array_constructor_25.f03 | 12 ++++ .../gfortran.dg/array_constructor_26.f03 | 18 ++++++ .../gfortran.dg/array_constructor_27.f03 | 15 +++++ .../gfortran.dg/array_constructor_28.f03 | 11 ++++ .../gfortran.dg/array_constructor_29.f03 | 13 +++++ .../gfortran.dg/array_constructor_30.f03 | 16 +++++ .../gfortran.dg/array_constructor_type_19.f03 | 9 +++ .../gfortran.dg/array_constructor_type_20.f03 | 11 ++++ .../gfortran.dg/array_constructor_type_21.f03 | 11 ++++ 14 files changed, 215 insertions(+), 33 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_25.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_26.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_27.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_28.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_29.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_30.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_19.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_20.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_21.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e83c3cb0c95..63620393898 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2008-06-18 Daniel Kraft + + PR fortran/36517, fortran/36492 + * array.c (gfc_resolve_character_array_constructor): Call + gfc_set_constant_character_len with changed length-chec argument. + * decl.c (gfc_set_constant_character_len): Changed array argument to + be a generic length-checking argument that can be used for correct + checking with typespec and in special cases where the should-be length + is different from the target length. + (build_struct): Call gfc_set_constant_character_len with changed length + checking argument and introduced additional checks for exceptional + conditions on invalid code. + (add_init_expr_to_sym), (do_parm): Call gfc_set_constant_character_len + with changed argument. + * match.h (gfc_set_constant_character_len): Changed third argument to + int for the should-be length rather than bool. + 2008-06-17 Daniel Kraft PR fortran/36112 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 73b78c3f2fc..a34695e4241 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1680,25 +1680,29 @@ got_charlen: (without typespec) all elements are verified to have the same length anyway. */ if (found_length != -1) - for (p = expr->value.constructor; p; p = p->next) - if (p->expr->expr_type == EXPR_CONSTANT) - { - gfc_expr *cl = NULL; - int current_length = -1; - - if (p->expr->ts.cl && p->expr->ts.cl->length) - { - cl = p->expr->ts.cl->length; - gfc_extract_int (cl, ¤t_length); - } - - /* If gfc_extract_int above set current_length, we implicitly - know the type is BT_INTEGER and it's EXPR_CONSTANT. */ - - if (! cl - || (current_length != -1 && current_length < found_length)) - gfc_set_constant_character_len (found_length, p->expr, true); - } + for (p = expr->value.constructor; p; p = p->next) + if (p->expr->expr_type == EXPR_CONSTANT) + { + gfc_expr *cl = NULL; + int current_length = -1; + bool has_ts; + + if (p->expr->ts.cl && p->expr->ts.cl->length) + { + cl = p->expr->ts.cl->length; + gfc_extract_int (cl, ¤t_length); + } + + /* If gfc_extract_int above set current_length, we implicitly + know the type is BT_INTEGER and it's EXPR_CONSTANT. */ + + has_ts = (expr->ts.cl && expr->ts.cl->length_from_typespec); + + if (! cl + || (current_length != -1 && current_length < found_length)) + gfc_set_constant_character_len (found_length, p->expr, + has_ts ? -1 : found_length); + } } return SUCCESS; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index a1c7d5aa44e..57db93fd8e1 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1084,10 +1084,12 @@ build_sym (const char *name, gfc_charlen *cl, /* Set character constant to the given length. The constant will be padded or - truncated. */ + truncated. If we're inside an array constructor without a typespec, we + additionally check that all elements have the same length; check_len -1 + means no checking. */ void -gfc_set_constant_character_len (int len, gfc_expr *expr, bool array) +gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len) { gfc_char_t *s; int slen; @@ -1110,10 +1112,11 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, bool array) /* Apply the standard by 'hand' otherwise it gets cleared for initializers. */ - if (array && slen < len && !(gfc_option.allow_std & GFC_STD_GNU)) + if (check_len != -1 && slen != check_len + && !(gfc_option.allow_std & GFC_STD_GNU)) gfc_error_now ("The CHARACTER elements of the array constructor " "at %L must have the same length (%d/%d)", - &expr->where, slen, len); + &expr->where, slen, check_len); s[len] = '\0'; gfc_free (expr->value.character.string); @@ -1269,7 +1272,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) gfc_constructor * p; if (init->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, init, false); + gfc_set_constant_character_len (len, init, -1); else if (init->expr_type == EXPR_ARRAY) { /* Build a new charlen to prevent simplification from @@ -1280,7 +1283,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) init->ts.cl->length = gfc_copy_expr (sym->ts.cl->length); for (p = init->value.constructor; p; p = p->next) - gfc_set_constant_character_len (len, p->expr, false); + gfc_set_constant_character_len (len, p->expr, -1); } } } @@ -1402,19 +1405,48 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, /* Should this ever get more complicated, combine with similar section in add_init_expr_to_sym into a separate function. */ - if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer) + if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer && c->ts.cl + && c->ts.cl->length && c->ts.cl->length->expr_type == EXPR_CONSTANT) { - int len = mpz_get_si (c->ts.cl->length->value.integer); + int len; + + gcc_assert (c->ts.cl && c->ts.cl->length); + gcc_assert (c->ts.cl->length->expr_type == EXPR_CONSTANT); + gcc_assert (c->ts.cl->length->ts.type == BT_INTEGER); + + len = mpz_get_si (c->ts.cl->length->value.integer); if (c->initializer->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, c->initializer, false); + gfc_set_constant_character_len (len, c->initializer, -1); else if (mpz_cmp (c->ts.cl->length->value.integer, c->initializer->ts.cl->length->value.integer)) { + bool has_ts; gfc_constructor *ctor = c->initializer->value.constructor; - for (;ctor ; ctor = ctor->next) - if (ctor->expr->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, ctor->expr, true); + + bool first = true; + int first_len; + + has_ts = (c->initializer->ts.cl + && c->initializer->ts.cl->length_from_typespec); + + for (; ctor; ctor = ctor->next) + { + /* Remember the length of the first element for checking that + all elements *in the constructor* have the same length. This + need not be the length of the LHS! */ + if (first) + { + gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT); + gcc_assert (ctor->expr->ts.type == BT_CHARACTER); + first_len = ctor->expr->value.character.length; + first = false; + } + + if (ctor->expr->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, ctor->expr, + has_ts ? -1 : first_len); + } } } @@ -5822,7 +5854,7 @@ do_parm (void) && init->expr_type == EXPR_CONSTANT && init->ts.type == BT_CHARACTER) gfc_set_constant_character_len ( - mpz_get_si (sym->ts.cl->length->value.integer), init, false); + mpz_get_si (sym->ts.cl->length->value.integer), init, -1); else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL && sym->ts.cl->length == NULL) { diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 5ee91fb62de..cf30b2730dc 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -147,7 +147,7 @@ match gfc_match_final_decl (void); match gfc_match_implicit_none (void); match gfc_match_implicit (void); -void gfc_set_constant_character_len (int, gfc_expr *, bool); +void gfc_set_constant_character_len (int, gfc_expr *, int); /* Matchers for attribute declarations. */ match gfc_match_allocatable (void); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8b2d63c2979..ff03e2f9668 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2008-06-18 Daniel Kraft + + PR fortran/36517, fortran/36492 + * gfortran.dg/array_constructor_25.f03: New test. + * gfortran.dg/array_constructor_26.f03: New test. + * gfortran.dg/array_constructor_27.f03: New test. + * gfortran.dg/array_constructor_28.f03: New test. + * gfortran.dg/array_constructor_29.f03: New test. + * gfortran.dg/array_constructor_30.f03: New test. + * gfortran.dg/array_constructor_type_19.f03: New test. + * gfortran.dg/array_constructor_type_20.f03: New test. + * gfortran.dg/array_constructor_type_21.f03: New test. + 2008-06-17 Daniel Kraft PR fortran/36112 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_25.f03 b/gcc/testsuite/gfortran.dg/array_constructor_25.f03 new file mode 100644 index 00000000000..b18746815c5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_25.f03 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } + +! PR fortran/36492 +! Check for incorrect error message with -std=f2003. +! Reduced test based on the one from comment #4, PR 36492. + +type t + character (2) :: arr (1) = [ "a" ] +end type t + +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_26.f03 b/gcc/testsuite/gfortran.dg/array_constructor_26.f03 new file mode 100644 index 00000000000..a226f6ae00c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_26.f03 @@ -0,0 +1,18 @@ +! { dg-do compile } + +! PR fortran/36492 +! Check for incorrect error message with -std=f2003. +! Test from comment #4, PR 36492 causing ICE. + +MODULE WinData + IMPLICIT NONE + INTEGER (1), PARAMETER :: MAXFLD = 25_1, MAXHED = 5_1, MAXCHR = 80_1 + integer :: i + TYPE TWindowData + CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)] + ! { dg-error "no IMPLICIT type" "" { target *-*-* } 12 } + ! { dg-error "specification expression" "" { target *-*-* } 12 } + END TYPE TWindowData +END MODULE WinData + +! { dg-final { cleanup-modules "WinData" } } diff --git a/gcc/testsuite/gfortran.dg/array_constructor_27.f03 b/gcc/testsuite/gfortran.dg/array_constructor_27.f03 new file mode 100644 index 00000000000..6cd4d62dac7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_27.f03 @@ -0,0 +1,15 @@ +! { dg-do compile } + +! PR fortran/36492 +! Check for incorrect error message with -std=f2003. +! Reduced test triggering the ICE mentioned in comment #4, PR 36492. + +implicit none + +type t + character (a) :: arr (1) = [ "a" ] + ! { dg-error "no IMPLICIT type" "" { target *-*-* } 10 } + ! { dg-error "specification expression" "" { target *-*-* } 10 } +end type t + +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_28.f03 b/gcc/testsuite/gfortran.dg/array_constructor_28.f03 new file mode 100644 index 00000000000..382e49aef88 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_28.f03 @@ -0,0 +1,11 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } + +! PR fortran/36492 +! Check that the error is still emitted for really incorrect constructor. + +type t + character (2) :: arr (2) = [ "a", "ab" ] ! { dg-error "Different CHARACTER" } +end type t + +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_29.f03 b/gcc/testsuite/gfortran.dg/array_constructor_29.f03 new file mode 100644 index 00000000000..03534fa81ed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_29.f03 @@ -0,0 +1,13 @@ +! { dg-do compile } + +! PR fortran/36492 +! Similar to the ICE-test, but now test it works for real constants. + +implicit none + +integer, parameter :: a = 42 +type t + character (a) :: arr (1) = [ "a" ] +end type t + +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_30.f03 b/gcc/testsuite/gfortran.dg/array_constructor_30.f03 new file mode 100644 index 00000000000..587ce03977d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_30.f03 @@ -0,0 +1,16 @@ +! { dg-do compile } + +! PR fortran/36492 +! Similar to the ICE-test, but now test for complaint about constant +! specification expression. + +implicit none + +integer :: a = 42 +type t + character (a) :: arr (1) = [ "a" ] + ! { dg-error "in the expression" "" { target *-*-* } 11 } + ! { dg-error "specification expression" "" { target *-*-* } 11 } +end type t + +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_19.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_19.f03 new file mode 100644 index 00000000000..f3c8fd5ef4f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_19.f03 @@ -0,0 +1,9 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } + +! PR fortran/36517 +! Check for incorrect error message with -std=f2003. +! This is the test of comment #1, PR 36517. + +print *, [ character(len=2) :: 'a', 'bb' ] +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_20.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_20.f03 new file mode 100644 index 00000000000..9702669d4a8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_20.f03 @@ -0,0 +1,11 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } + +! PR fortran/36517 +! Check for incorrect error message with -std=f2003. +! This is the original test from PR 36517. + +CHARACTER (len=*) MY_STRING(1:3) +PARAMETER ( MY_STRING = (/ CHARACTER (len=3) :: "AC", "B", "C" /) ) +CHARACTER (len=*), PARAMETER :: str(2) = [ CHARACTER (len=3) :: 'A', 'cc' ] +END diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_21.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_21.f03 new file mode 100644 index 00000000000..41e4da346c9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_21.f03 @@ -0,0 +1,11 @@ +! { dg-do compile } +! { dg-options "-std=f2003" } + +! PR fortran/36492 +! Check that it works with a typespec even for not-the-same-length elements. + +type t + character (1) :: arr (2) = [ character(len=2) :: "a", "ab" ] +end type t + +end -- 2.30.2