This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: PING: [patch, fortran] PR 27997: Implement F2003-style array constructor with typespec
Hi FX,
here's a new version of my patch with (some of) your comments addressed;
I'll comment what I changed below.
I apologize for some of my prior comments, I did misunderstand some of
your points.
BTW, is it generally ok to have as many testcases as possible, or is
there some "upper limit" on the number you think reasonable for one
special feature? And BTW, is there a way to make dejagnu run single
tests so I can test my dejagnu-testcase without having to do a full
check-gfortran?
Thank you for all your help so far,
Daniel
FX wrote:
I am wondering: could you add some testcases with failing conversion to
the constructor type. I see four cases I'd like covered: a too long
string, like that:
I did add new testcases for range-check conversion of big integers,
nested array constructors with typespec and both valid and invalid array
constructor for derived types. The whole testsuite succeeds for me.
static void
gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
@@ -999,7 +1000,7 @@
se->string_length,
se->expr);
}
- if (flag_bounds_check)
+ if (flag_bounds_check && !typespec_ctor)
{
if (first_len)
{
I've tried to trigger that code and could not see it work. I cannot see
a runtime error, neither with
For this I didn't do anything by now, if it is ok I suggest we look at
this separatly?
@@ -1681,7 +1682,11 @@
tree type;
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_ctor = (ss->expr->ts.cl &&
ss->expr->ts.cl->length_from_typespec);
This means you only ever set typespec_ctor for character arrays. This is
fine with me, because that's the information we need, but I suggest
giving the variable a name that indicates this fact (lest someone uses
it for other type).
Renamed the variable to typespec_chararray_ctor; is this what you meant?
+ /* XXX: This works for my tests, but is this the correct way to
+ transform the gfc_expr into a tree? */
Ah... well, it rather depends... you've got the right function, but I'd
suggest here using the variant with a type, gfc_conv_expr_type():
Now using gfc_conv_expr_type and adding the pre- and post blocks.
+ if (expr->ts.cl->length->ts.type == BT_INTEGER)
+ {
+ if (expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+ {
+ /* Got a constant character length, pad according to this. */
+ max_length = mpz_get_si (expr->ts.cl->length->value.integer);
+ }
+ }
+ }
I imagine this is written that way for historical reasons. The proper
style would be:
Did adapt comments and code.
As for the use of mpz_get_si() directly on the value, it is done too
often in currently existing code but is not a good coding practice: the
expr->ts.cl->length->value.integer might not fit in a host integer.
Please use gfc_extract_int() instead. (It is m project, at some point,
to audit all uses of mpz_get_si in the front-end, but I never got around
to it; we should also have a function gfc_extract_hwint that returns a
HOST_WIDE_INT instead of a gfc_extract_int, for that matter).
Did this, too (if I used gfc_extract_int correctly).
+ if (generated_length || ! cl
+ || (cl->expr_type == EXPR_CONSTANT
+ && cl->ts.type == BT_INTEGER
+ && mpz_get_si (cl->value.integer) < max_length))
+ {
+ gfc_set_constant_character_len (max_length, p->expr, true);
+ }
Unneeded braces. It looks like we could easily emit an error for strings
of constant length that are too long, couldn't we?
Removed the braces (and the use of mpz_get_si here, too). For the
error, I believe this is what you talked about with Tobias, right (i.e.,
no need as reducing length is valid)?
--
Done: Bar-Sam-Val-Wiz, Dwa-Elf-Hum-Orc, Cha-Law, Fem-Mal
Underway: Ran-Gno-Neu-Fem
To go: Arc-Cav-Hea-Kni-Mon-Pri-Rog-Tou
Index: gcc/testsuite/gfortran.dg/array_constructor_type_5.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_5.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_6.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_6.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_10.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_10.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_7.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_7.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_11.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_11.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_8.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_8.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_12.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_12.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_14.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_14.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_15.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_15.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_9.f
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_9.f (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_9.f (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_13.f90
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_13.f90 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_16.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_16.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_17.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_17.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_18.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_18.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_1.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_2.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_3.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_3.f03 (revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/array_constructor_type_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_4.f03 (revision 0)
@@ -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
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 134669)
+++ gcc/fortran/trans-array.c (working copy)
@@ -959,9 +959,10 @@ gfc_put_offset_into_var (stmtblock_t * p
}
-/* 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_
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_loopinf
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,30 @@ gfc_trans_array_constructor (gfc_loopinf
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. */
+ /* XXX: Adding typespec_chararray_ctor here was merely a hack to make
+ gfortran.dg/array_constructor_17.f90 work (ICE otherwise). Is this
+ ok anyway or should I look for another solution? */
+ 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. */
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 134669)
+++ gcc/fortran/array.c (working copy)
@@ -877,9 +877,11 @@ gfc_match_array_constructor (gfc_expr **
{
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 **
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 **
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 **
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
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
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);
+ }
+ }
}
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 134669)
+++ gcc/fortran/gfortran.h (working copy)
@@ -762,6 +762,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;