procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/27997 (Fortran 2003: Support type-spec for array constructor)

Browse source 
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
This commit is contained in:
Daniel Kraft 2008-05-16 21:50:04 +02:00 • committed by Tobias Burnus
parent c62b365920
commit c03fc95db3
23 changed files with 488 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/fortran/ChangeLog
View file

@ -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

111
gcc/fortran/array.c
View file

@ -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, &current_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);
}
}
}

1
gcc/fortran/gfortran.h
View file

@ -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;

35
gcc/fortran/trans-array.c
View file

@ -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. */

22
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,25 @@
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
2008-05-16 Uros Bizjak <ubizjak@gmail.com>
PR target/36246

17
gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 Normal file
View file

@ -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

23
gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 Normal file
View file

@ -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

11
gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 Normal file
View file

@ -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

12
gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 Normal file
View file

@ -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

14
gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 Normal file
View file

@ -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

24
gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 Normal file
View file

@ -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

22
gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 Normal file
View file

@ -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

25
gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 Normal file
View file

@ -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

12
gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 Normal file
View file

@ -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

12
gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 Normal file
View file

@ -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

20
gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 Normal file
View file

@ -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

16
gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 Normal file
View file

@ -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

15
gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 Normal file
View file

@ -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

18
gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 Normal file
View file

@ -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

30
gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 Normal file
View file

@ -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

23
gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 Normal file
View file

@ -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

13
gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 Normal file
View file

@ -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

10
gcc/testsuite/gfortran.dg/array_constructor_type_9.f Normal file
View file

@ -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