diff options
author | Daniel Kraft <d@domob.eu> | 2008-05-16 21:50:04 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2008-05-16 21:50:04 +0200 |
commit | c03fc95db39f7eefe676d2bff9a7c99b5ec01ed9 (patch) | |
tree | c7e366c619e4465a3a807a4d48e072cb8c58d1aa /gcc/fortran | |
parent | c62b365920ac525ceabcfe7eb9cd6a9f9539d78c (diff) | |
download | gcc-c03fc95db39f7eefe676d2bff9a7c99b5ec01ed9.zip gcc-c03fc95db39f7eefe676d2bff9a7c99b5ec01ed9.tar.gz gcc-c03fc95db39f7eefe676d2bff9a7c99b5ec01ed9.tar.bz2 |
re PR fortran/27997 (Fortran 2003: Support type-spec for array constructor)
2008-04-16 Daniel Kraft <d@domob.eu>
PR fortran/27997
* gfortran.h: Added field "length_from_typespec" to gfc_charlength.
* aray.c (gfc_match_array_constructor): Added code to parse
* typespec.
(check_element_type, check_constructor_type, gfc_check_constructor_type):
Extended to support explicit typespec on constructor.
(gfc_resolve_character_array_constructor): Pad strings correctly for
explicit, constant character length.
* trans-array.c: New static global variable
* "typespec_chararray_ctor"
(gfc_trans_array_constructor): New code to support explicit but dynamic
character lengths.
2008-04-16 Daniel Kraft <d@domob.eu>
PR fortran/27997
* gfortran.dg/array_constructor_type_1.f03: New test
* gfortran.dg/array_constructor_type_2.f03: New test
* gfortran.dg/array_constructor_type_3.f03: New test
* gfortran.dg/array_constructor_type_4.f03: New test
* gfortran.dg/array_constructor_type_5.f03: New test
* gfortran.dg/array_constructor_type_6.f03: New test
* gfortran.dg/array_constructor_type_7.f03: New test
* gfortran.dg/array_constructor_type_8.f03: New test
* gfortran.dg/array_constructor_type_9.f: New test
* gfortran.dg/array_constructor_type_10.f03: New test
* gfortran.dg/array_constructor_type_11.f03: New test
* gfortran.dg/array_constructor_type_12.f03: New test
* gfortran.dg/array_constructor_type_13.f90: New test
* gfortran.dg/array_constructor_type_14.f03: New test
* gfortran.dg/array_constructor_type_15.f03: New test
* gfortran.dg/array_constructor_type_16.f03: New test
* gfortran.dg/array_constructor_type_17.f03: New test
* gfortran.dg/array_constructor_type_18.f03: New test
From-SVN: r135439
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 27 | ||||
-rw-r--r-- | gcc/fortran/array.c | 111 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 35 |
4 files changed, 149 insertions, 25 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 73bd3e2..ef9f1cf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,12 +1,25 @@ +2008-04-16 Daniel Kraft <d@domob.eu> + + PR fortran/27997 + * gfortran.h: Added field "length_from_typespec" to gfc_charlength. + * aray.c (gfc_match_array_constructor): Added code to parse typespec. + (check_element_type, check_constructor_type, gfc_check_constructor_type): + Extended to support explicit typespec on constructor. + (gfc_resolve_character_array_constructor): Pad strings correctly for + explicit, constant character length. + * trans-array.c: New static global variable "typespec_chararray_ctor" + (gfc_trans_array_constructor): New code to support explicit but dynamic + character lengths. + 2008-05-16 Jerry DeLisle <jvdelisle@gcc.gnu.org> - PR fortran/34325 - * decl.c (match_attr_spec): Check for matching pairs of parenthesis. - * expr.c (gfc_specification_expr): Supplement the error message with the - type that was found. - * resolve.c (gfc_resolve_index): Likewise. - * match.c (gfc_match_parens): Clarify error message with "at or before". - (gfc_match_do): Check for matching pairs of parenthesis. + PR fortran/34325 + * decl.c (match_attr_spec): Check for matching pairs of parenthesis. + * expr.c (gfc_specification_expr): Supplement the error message with the + type that was found. + * resolve.c (gfc_resolve_index): Likewise. + * match.c (gfc_match_parens): Clarify error message with "at or before". + (gfc_match_do): Check for matching pairs of parenthesis. 2008-05-16 Tobias Burnus <burnus@net-b.de diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index adc3f3f..71c8b5d 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -877,9 +877,11 @@ gfc_match_array_constructor (gfc_expr **result) { gfc_constructor *head, *tail, *new; gfc_expr *expr; + gfc_typespec ts; locus where; match m; const char *end_delim; + bool seen_ts; if (gfc_match (" (/") == MATCH_NO) { @@ -898,11 +900,33 @@ gfc_match_array_constructor (gfc_expr **result) where = gfc_current_locus; head = tail = NULL; + seen_ts = false; + + /* Try to match an optional "type-spec ::" */ + if (gfc_match_type_spec (&ts, 0) == MATCH_YES) + { + seen_ts = (gfc_match (" ::") == MATCH_YES); + + if (seen_ts) + { + if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor " + "including type specification at %C") == FAILURE) + goto cleanup; + } + } + + if (! seen_ts) + gfc_current_locus = where; if (gfc_match (end_delim) == MATCH_YES) { - gfc_error ("Empty array constructor at %C is not allowed"); - goto cleanup; + if (seen_ts) + goto done; + else + { + gfc_error ("Empty array constructor at %C is not allowed"); + goto cleanup; + } } for (;;) @@ -927,6 +951,7 @@ gfc_match_array_constructor (gfc_expr **result) if (gfc_match (end_delim) == MATCH_NO) goto syntax; +done: expr = gfc_get_expr (); expr->expr_type = EXPR_ARRAY; @@ -934,6 +959,14 @@ gfc_match_array_constructor (gfc_expr **result) expr->value.constructor = head; /* Size must be calculated at resolution time. */ + if (seen_ts) + expr->ts = ts; + else + expr->ts.type = BT_UNKNOWN; + + if (expr->ts.cl) + expr->ts.cl->length_from_typespec = seen_ts; + expr->where = where; expr->rank = 1; @@ -964,7 +997,7 @@ static enum cons_state; static int -check_element_type (gfc_expr *expr) +check_element_type (gfc_expr *expr, bool convert) { if (cons_state == CONS_BAD) return 0; /* Suppress further errors */ @@ -985,6 +1018,9 @@ check_element_type (gfc_expr *expr) if (gfc_compare_types (&constructor_ts, &expr->ts)) return 0; + if (convert) + return gfc_convert_type (expr, &constructor_ts, 1) == SUCCESS ? 0 : 1; + gfc_error ("Element in %s array constructor at %L is %s", gfc_typename (&constructor_ts), &expr->where, gfc_typename (&expr->ts)); @@ -997,7 +1033,7 @@ check_element_type (gfc_expr *expr) /* Recursive work function for gfc_check_constructor_type(). */ static try -check_constructor_type (gfc_constructor *c) +check_constructor_type (gfc_constructor *c, bool convert) { gfc_expr *e; @@ -1007,13 +1043,13 @@ check_constructor_type (gfc_constructor *c) if (e->expr_type == EXPR_ARRAY) { - if (check_constructor_type (e->value.constructor) == FAILURE) + if (check_constructor_type (e->value.constructor, convert) == FAILURE) return FAILURE; continue; } - if (check_element_type (e)) + if (check_element_type (e, convert)) return FAILURE; } @@ -1029,10 +1065,20 @@ gfc_check_constructor_type (gfc_expr *e) { try t; - cons_state = CONS_START; - gfc_clear_ts (&constructor_ts); + if (e->ts.type != BT_UNKNOWN) + { + cons_state = CONS_GOOD; + constructor_ts = e->ts; + } + else + { + cons_state = CONS_START; + gfc_clear_ts (&constructor_ts); + } - t = check_constructor_type (e->value.constructor); + /* If e->ts.type != BT_UNKNOWN, the array constructor included a + typespec, and we will now convert the values on the fly. */ + t = check_constructor_type (e->value.constructor, e->ts.type != BT_UNKNOWN); if (t == SUCCESS && e->ts.type == BT_UNKNOWN) e->ts = constructor_ts; @@ -1526,13 +1572,15 @@ resolve_array_list (gfc_constructor *p) /* Resolve character array constructor. If it is a constant character array and not specified character length, update character length to the maximum of - its element constructors' length. */ + its element constructors' length. For arrays with fixed length, pad the + elements as necessary with needed_length. */ void gfc_resolve_character_array_constructor (gfc_expr *expr) { gfc_constructor *p; int max_length; + bool generated_length; gcc_assert (expr->expr_type == EXPR_ARRAY); gcc_assert (expr->ts.type == BT_CHARACTER); @@ -1557,6 +1605,7 @@ gfc_resolve_character_array_constructor (gfc_expr *expr) got_charlen: + generated_length = false; if (expr->ts.cl->length == NULL) { /* Find the maximum length of the elements. Do nothing for variable @@ -1596,12 +1645,46 @@ got_charlen: { /* Update the character length of the array constructor. */ expr->ts.cl->length = gfc_int_expr (max_length); - /* Update the element constructors. */ - for (p = expr->value.constructor; p; p = p->next) - if (p->expr->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (max_length, p->expr, true); + generated_length = true; + /* Real update follows below. */ } } + else + { + /* We've got a character length specified. It should be an integer, + otherwise an error is signalled elsewhere. */ + gcc_assert (expr->ts.cl->length); + + /* If we've got a constant character length, pad according to this. + gfc_extract_int does check for BT_INTEGER and EXPR_CONSTANT and sets + max_length only if they pass. */ + gfc_extract_int (expr->ts.cl->length, &max_length); + } + + /* Found a length to update to, do it for all element strings shorter than + the target length. */ + if (max_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 (generated_length || ! cl + || (current_length != -1 && current_length < max_length)) + gfc_set_constant_character_len (max_length, p->expr, true); + } + } } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index bf80847..5fa3bc1 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -784,6 +784,7 @@ typedef struct gfc_charlen { struct gfc_expr *length; struct gfc_charlen *next; + bool length_from_typespec; /* Length from explicit array ctor typespec? */ tree backend_decl; int resolved; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3c099dd..d6464ca 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -959,9 +959,10 @@ gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset, } -/* Assign an element of an array constructor. */ +/* Variables needed for bounds-checking. */ static bool first_len; static tree first_len_val; +static bool typespec_chararray_ctor; static void gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, @@ -998,7 +999,7 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc, se->string_length, se->expr); } - if (flag_bounds_check) + if (flag_bounds_check && !typespec_chararray_ctor) { if (first_len) { @@ -1677,7 +1678,13 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) tree loopfrom; bool dynamic; - if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER) + /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no + typespec was given for the array constructor. */ + typespec_chararray_ctor = (ss->expr->ts.cl + && ss->expr->ts.cl->length_from_typespec); + + if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER + && !typespec_chararray_ctor) { first_len_val = gfc_create_var (gfc_charlen_type_node, "len"); first_len = true; @@ -1688,7 +1695,27 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss) c = ss->expr->value.constructor; if (ss->expr->ts.type == BT_CHARACTER) { - bool const_string = get_array_ctor_strlen (&loop->pre, c, &ss->string_length); + bool const_string; + + /* get_array_ctor_strlen walks the elements of the constructor, if a + typespec was given, we already know the string length and want the one + specified there. */ + if (typespec_chararray_ctor && ss->expr->ts.cl->length + && ss->expr->ts.cl->length->expr_type != EXPR_CONSTANT) + { + gfc_se length_se; + + const_string = false; + gfc_init_se (&length_se, NULL); + gfc_conv_expr_type (&length_se, ss->expr->ts.cl->length, + gfc_charlen_type_node); + ss->string_length = length_se.expr; + gfc_add_block_to_block (&loop->pre, &length_se.pre); + gfc_add_block_to_block (&loop->post, &length_se.post); + } + else + const_string = get_array_ctor_strlen (&loop->pre, c, + &ss->string_length); /* Complex character array constructors should have been taken care of and not end up here. */ |