+2008-06-18 Daniel Kraft <d@domob.eu>
+
+ 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 <d@domob.eu>
PR fortran/36112
(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;
/* 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;
/* 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);
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
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);
}
}
}
/* 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);
+ }
}
}
&& 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)
{
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);
+2008-06-18 Daniel Kraft <d@domob.eu>
+
+ 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 <d@domob.eu>
PR fortran/36112
--- /dev/null
+! { 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
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
projects / gcc.git / commitdiff