From c03fc95db39f7eefe676d2bff9a7c99b5ec01ed9 Mon Sep 17 00:00:00 2001 From: Daniel Kraft Date: Fri, 16 May 2008 21:50:04 +0200 Subject: [PATCH] re PR fortran/27997 (Fortran 2003: Support type-spec for array constructor) 2008-04-16 Daniel Kraft 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 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 --- gcc/fortran/ChangeLog | 27 +++-- gcc/fortran/array.c | 111 +++++++++++++++--- gcc/fortran/gfortran.h | 1 + gcc/fortran/trans-array.c | 35 +++++- gcc/testsuite/ChangeLog | 22 ++++ .../gfortran.dg/array_constructor_type_1.f03 | 17 +++ .../gfortran.dg/array_constructor_type_10.f03 | 23 ++++ .../gfortran.dg/array_constructor_type_11.f03 | 11 ++ .../gfortran.dg/array_constructor_type_12.f03 | 12 ++ .../gfortran.dg/array_constructor_type_13.f90 | 14 +++ .../gfortran.dg/array_constructor_type_14.f03 | 24 ++++ .../gfortran.dg/array_constructor_type_15.f03 | 22 ++++ .../gfortran.dg/array_constructor_type_16.f03 | 25 ++++ .../gfortran.dg/array_constructor_type_17.f03 | 12 ++ .../gfortran.dg/array_constructor_type_18.f03 | 12 ++ .../gfortran.dg/array_constructor_type_2.f03 | 20 ++++ .../gfortran.dg/array_constructor_type_3.f03 | 16 +++ .../gfortran.dg/array_constructor_type_4.f03 | 15 +++ .../gfortran.dg/array_constructor_type_5.f03 | 18 +++ .../gfortran.dg/array_constructor_type_6.f03 | 30 +++++ .../gfortran.dg/array_constructor_type_7.f03 | 23 ++++ .../gfortran.dg/array_constructor_type_8.f03 | 13 ++ .../gfortran.dg/array_constructor_type_9.f | 10 ++ 23 files changed, 488 insertions(+), 25 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_9.f diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 73bd3e295a65..ef9f1cfe35c1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,12 +1,25 @@ +2008-04-16 Daniel Kraft + + 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 - 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 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 bf80847391e1..5fa3bc1f2c74 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 3c099ddcc9d0..d6464ca93e08 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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 88c26192c048..4b2dace4dfe6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,25 @@ +2008-04-16 Daniel Kraft + + 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 + 2008-05-16 Uros Bizjak PR target/36246 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 new file mode 100644 index 000000000000..fc8813cc5618 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 @@ -0,0 +1,17 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Simple array constructor with typespec. +! +PROGRAM test + IMPLICIT NONE + INTEGER :: array(5) + + array = (/ INTEGER :: 18, 12, 31, 3, 42.4 /) + + IF (array(1) /= 18 .OR. array(2) /= 12 .OR. & + array(3) /= 31 .OR. array(4) /= 3 .OR. array(5) /= 42) THEN + CALL abort() + END IF +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 new file mode 100644 index 000000000000..f4dfae2bd798 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 @@ -0,0 +1,23 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! +! PR fortran/27997 +! +! Array constructor with typespec and dynamic +! character length. +! +PROGRAM test + CALL foo(8, "short", "short") + CALL foo(2, "lenghty", "le") +CONTAINS + SUBROUTINE foo (n, s, shouldBe) + CHARACTER(len=*) :: s + CHARACTER(len=*) :: shouldBe + CHARACTER(len=16) :: arr(2) + INTEGER :: n + arr = [ character(len=n) :: s, s ] + IF (arr(1) /= shouldBe .OR. arr(2) /= shouldBe) THEN + CALL abort () + END IF + END SUBROUTINE foo +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 new file mode 100644 index 000000000000..e27515c7d7a8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 @@ -0,0 +1,11 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Empty array constructor with typespec. +! + integer :: i(3) + i(3:2) = (/ integer :: /) + if (len((/ character(5) :: /)) /= 5) call abort() + if (kind((/ integer(8) :: /)) /= 8) call abort() +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 new file mode 100644 index 000000000000..e06fd47991a7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 @@ -0,0 +1,12 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Array constructor with typespec. +! +real :: a(3) +integer :: j(3) +a = (/ integer :: 1.4, 2.2, 3.33 /) +j = (/ 1.4, 2.2, 3.33 /) +if( any(a /= j )) call abort() +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 b/gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 new file mode 100644 index 000000000000..eab35ccd191f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-options "-std=f95" } +! +! PR fortran/27997 +! +! Array constructor with typespec +! should be rejected for Fortran 95. +! +real :: a(3) +integer :: j(3) +a = (/ integer :: 1.4, 2.2, 3.33 /) ! { dg-error "Fortran 2003" } +j = (/ 1.4, 2.2, 3.33 /) +if( any(a /= j )) call abort() +end diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 new file mode 100644 index 000000000000..04ac728010a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 @@ -0,0 +1,24 @@ +! { dg-do run } +! PR fortran/27997 +! +! Array constructor with typespec +! for derived types. + +PROGRAM test + IMPLICIT NONE + + TYPE foo + INTEGER :: i + REAL :: x + END TYPE foo + + TYPE(foo), PARAMETER :: x = foo(42, 42.) + + TYPE(foo), DIMENSION(2) :: arr + + arr = (/ TYPE(foo) :: x, foo(0, 1.) /) + IF (arr(1)%i /= 42 .OR. arr(1)%x /= 42. .OR. & + arr(2)%i /= 0 .OR. arr(2)%x /= 1.) THEN + CALL abort() + END IF +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 new file mode 100644 index 000000000000..20736988b5ae --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 @@ -0,0 +1,22 @@ +! { dg-do compile } +! PR fortran/27997 +! +! Array constructor with typespec +! for derived types, failing conversion. + +PROGRAM test + IMPLICIT NONE + + TYPE foo + INTEGER :: i + REAL :: x + END TYPE foo + + TYPE bar + LOGICAL :: logos + END TYPE bar + + TYPE(foo), PARAMETER :: x = foo(42, 42.) + + WRITE (*,*) (/ TYPE(foo) :: x, foo(0, 1.), bar(.TRUE.) /) ! { dg-error "convert TYPE" } +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 new file mode 100644 index 000000000000..a6950997e56f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 @@ -0,0 +1,25 @@ +! { dg-do run } +! PR fortran/27997 +! +! Nested array constructors with typespec. + +PROGRAM test + IMPLICIT NONE + + INTEGER(KIND=8) :: arr(3) + CHARACTER(len=6) :: carr(3) + + arr = (/ INTEGER(KIND=8) :: 4, [ INTEGER(KIND=4) :: 42, 12 ] /) + IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort() + arr = (/ INTEGER(KIND=8) :: [ INTEGER(KIND=4) :: 4, 42, 12 ] /) + IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort() + arr = (/ INTEGER(KIND=8) :: [ INTEGER(KIND=4) :: 4, 42 ], 12 /) + IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort() + arr = (/ INTEGER(KIND=8) :: [ INTEGER(KIND=4) :: ], 4, 42, 12 /) + IF (arr(1) /= 4 .OR. arr(2) /= 42 .OR. arr(3) /= 12) CALL abort() + + carr = [ CHARACTER(len=6) :: "foo", [ CHARACTER(len=4) :: "foobar", "xyz" ] ] + IF (carr(1) /= "foo" .OR. carr(2) /= "foob" .OR. carr(3) /= "xyz") THEN + CALL abort() + END IF +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 new file mode 100644 index 000000000000..365d43e3f756 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-fno-range-check -Wconversion" } +! PR fortran/27997 +! +! Range check on array-constructors with typespec. + +PROGRAM test + IMPLICIT NONE + + INTEGER(KIND=4) :: arr(1) + arr = (/ INTEGER(KIND=4) :: HUGE(0_8) /) ! { dg-warning "Conversion from" } +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 new file mode 100644 index 000000000000..d88b3227c4db --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-options "-frange-check" } +! PR fortran/27997 +! +! Range check on array-constructors with typespec. + +PROGRAM test + IMPLICIT NONE + + INTEGER(KIND=4) :: arr(1) + arr = (/ INTEGER(KIND=4) :: HUGE(0_8) /) ! { dg-error "overflow converting" } +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 new file mode 100644 index 000000000000..49255505552b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 @@ -0,0 +1,20 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Array constructor with typespec, length parameter. +! +program test + implicit none + character(15) :: a(3) + a = (/ character(len=7) :: 'Takata', 'Tanaka', 'Hayashi' /) + if ( len([ character(len=7) :: ]) /= 7) call abort() + if ( size([ integer :: ]) /= 0) call abort() + if( a(1) /= 'Takata' .or. a(1)(7:7) /= achar(32) & + .or. a(1)(15:15) /= achar(32) & + .or. a(2) /= 'Tanaka' .or. a(2)(7:7) /= achar(32) & + .or. a(2)(15:15) /= achar(32) & + .or. a(3) /= 'Hayashi' .or. a(3)(8:8) /= achar(32) & + .or. a(3)(15:15) /= achar(32))& + call abort() +end program test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 new file mode 100644 index 000000000000..bebaea5c5d9c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 @@ -0,0 +1,16 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Test empty array constructor with typespec. +! +PROGRAM test + IMPLICIT NONE + INTEGER :: array(2) + + array = (/ 5, [INTEGER ::], 6 /) + + IF (array(1) /= 5 .OR. array(2) /= 6) THEN + CALL abort() + END IF +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 new file mode 100644 index 000000000000..d804bfada1b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 @@ -0,0 +1,15 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Ensure that :: is present when a typespec is deduced. +! +PROGRAM test + INTEGER :: array(1) + INTEGER = 42 + + array = [ INTEGER ] + IF (array(1) /= 42) THEN + CALL abort() + END IF +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 new file mode 100644 index 000000000000..98ddfa38e49c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 @@ -0,0 +1,18 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Array constructor with typespec and small length value. +! +program test + implicit none + character(15) :: a(3) + a = (/ character(len=3) :: 'Takata', 'Tanaka', 'Hayashi' /) + if( a(1) /= 'Tak' .or. a(1)(4:4) /= achar(32) & + .or. a(1)(15:15) /= achar(32) & + .or. a(2) /= 'Tan' .or. a(2)(4:4) /= achar(32) & + .or. a(2)(15:15) /= achar(32) & + .or. a(3) /= 'Hay' .or. a(3)(4:4) /= achar(32) & + .or. a(3)(15:15) /= achar(32))& + call abort() +end program test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 new file mode 100644 index 000000000000..df784f872bad --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 @@ -0,0 +1,30 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! +! PR fortran/27997 +! +! Array constructor with typespec. +! +program test + character(15) :: a(3) + character(10), volatile :: b(3) + b(1) = 'Takata' + b(2) = 'Tanaka' + b(3) = 'Hayashi' + + a = (/ character(len=7) :: trim(b(1)), trim(b(2)), trim(b(3)) /) + if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then + call abort () + end if + + a = (/ character(len=2) :: trim(b(1)), trim(b(2)), trim(b(3)) /) + if (a(1) /= 'Ta' .or. a(2) /= 'Ta' .or. a(3) /= 'Ha') then + call abort () + end if + + a = (/ character(len=8) :: trim(b(1)), trim(b(2)), trim(b(3)) /) + if (a(1) /= 'Takata' .or. a(2) /= 'Tanaka' .or. a(3) /= 'Hayashi') then + call abort () + end if + +end program test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 new file mode 100644 index 000000000000..8fb210a68c63 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 @@ -0,0 +1,23 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! +! PR fortran/27997 +! +! Array constructor with typespec and dynamic +! character length. +! +PROGRAM test + CALL foo(8, "short", "test", "short") + CALL foo(2, "lenghty", "te", "le") +CONTAINS + SUBROUTINE foo (n, s, a1, a2) + CHARACTER(len=*) :: s + CHARACTER(len=*) :: a1, a2 + CHARACTER(len=n) :: arr(2) + INTEGER :: n + arr = [ character(len=n) :: 'test', s ] + IF (arr(1) /= a1 .OR. arr(2) /= a2) THEN + CALL abort () + END IF + END SUBROUTINE foo +END PROGRAM test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 new file mode 100644 index 000000000000..9be467def677 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 @@ -0,0 +1,13 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Array constructor with typespec, check for regression +! +program test + implicit none + type :: real_info + integer :: kind + end type real_info + type (real_info) :: real_infos(1) = (/ real_info (4) /) +end program test diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_9.f b/gcc/testsuite/gfortran.dg/array_constructor_type_9.f new file mode 100644 index 000000000000..c2a2bd1d8145 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_9.f @@ -0,0 +1,10 @@ +! { dg-do run } +! +! PR fortran/27997 +! +! Array constructor with typespec, check for regression +! with fixed form. +! + integer :: a(2), realabc, real_abc2 + a = [ realabc, real_abc2 ] + end -- 2.43.5