From f1ce7f3e1e87543427f10979a133863c18fa51cf Mon Sep 17 00:00:00 2001 From: pault Date: Sun, 20 Jan 2008 08:22:56 +0000 Subject: [PATCH] 2008-01-20 Paul Thomas PR fortran/34784 * array.c (gfc_check_constructor_type): Clear the expression ts so that the checking starts from the deepest level of array constructor. * primary.c (match_varspec): If an unknown type is changed to default character and the attempt to match a substring fails, change it back to unknown. PR fortran/34785 * trans-array.c (gfc_add_loop_ss_code) : If ss->string_length is NULL for an array constructor, use the cl.length expression to build it. (gfc_conv_array_parameter): Change call to gfc_evaluate_now to a tree assignment. 2008-01-20 Paul Thomas PR fortran/34784 * gfortran.dg/array_constructor_20.f90: New test. * gfortran.dg/mapping_2.f90: Correct ubound expression for h4. PR fortran/34785 * gfortran.dg/array_constructor_21.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131675 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 17 ++++++++++ gcc/fortran/array.c | 1 + gcc/fortran/primary.c | 5 +++ gcc/fortran/trans-array.c | 14 ++++++++- gcc/testsuite/ChangeLog | 9 ++++++ gcc/testsuite/gfortran.dg/array_constructor_20.f90 | 22 +++++++++++++ gcc/testsuite/gfortran.dg/array_constructor_21.f90 | 36 ++++++++++++++++++++++ 7 files changed, 103 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_20.f90 create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_21.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 11d9c23..41fc1ad 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,20 @@ +2008-01-20 Paul Thomas + + PR fortran/34784 + * array.c (gfc_check_constructor_type): Clear the expression ts + so that the checking starts from the deepest level of array + constructor. + * primary.c (match_varspec): If an unknown type is changed to + default character and the attempt to match a substring fails, + change it back to unknown. + + PR fortran/34785 + * trans-array.c (gfc_add_loop_ss_code) : If ss->string_length is + NULL for an array constructor, use the cl.length expression to + build it. + (gfc_conv_array_parameter): Change call to gfc_evaluate_now to + a tree assignment. + 2008-01-19 Thomas Koenig PR fortran/34817 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 0c30b33..116937b 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1025,6 +1025,7 @@ gfc_check_constructor_type (gfc_expr *e) cons_state = CONS_START; gfc_clear_ts (&constructor_ts); + gfc_clear_ts (&e->ts); t = check_constructor_type (e->value.constructor); if (t == SUCCESS && e->ts.type == BT_UNKNOWN) diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 4e7d4a1..1895ca0 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1676,6 +1676,7 @@ match_varspec (gfc_expr *primary, int equiv_flag) gfc_component *component; gfc_symbol *sym = primary->symtree->n.sym; match m; + bool unknown; tail = NULL; @@ -1753,12 +1754,14 @@ match_varspec (gfc_expr *primary, int equiv_flag) } check_substring: + unknown = false; if (primary->ts.type == BT_UNKNOWN) { if (gfc_get_default_type (sym, sym->ns)->type == BT_CHARACTER) { gfc_set_default_type (sym, 0, sym->ns); primary->ts = sym->ts; + unknown = true; } } @@ -1781,6 +1784,8 @@ check_substring: break; case MATCH_NO: + if (unknown) + gfc_clear_ts (&primary->ts); break; case MATCH_ERROR: diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 1718ba9..08c2a80 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1906,6 +1906,18 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript) break; case GFC_SS_CONSTRUCTOR: + if (ss->expr->ts.type == BT_CHARACTER + && ss->string_length== NULL + && ss->expr->ts.cl + && ss->expr->ts.cl->length) + { + gfc_init_se (&se, NULL); + gfc_conv_expr_type (&se, ss->expr->ts.cl->length, + gfc_charlen_type_node); + ss->string_length = se.expr; + gfc_add_block_to_block (&loop->pre, &se.pre); + gfc_add_block_to_block (&loop->post, &se.post); + } gfc_trans_array_constructor (loop, ss); break; @@ -5042,7 +5054,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77) { get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp); expr->ts.cl->backend_decl = tmp; - se->string_length = gfc_evaluate_now (tmp, &se->pre); + se->string_length = tmp; } /* Is this the result of the enclosing procedure? */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 03aa014..c64655f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2008-01-20 Paul Thomas + + PR fortran/34784 + * gfortran.dg/array_constructor_20.f90: New test. + * gfortran.dg/mapping_2.f90: Correct ubound expression for h4. + + PR fortran/34785 + * gfortran.dg/array_constructor_21.f90: New test. + 2008-01-20 Jerry DeLisle PR libfortran/34795 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_20.f90 b/gcc/testsuite/gfortran.dg/array_constructor_20.f90 new file mode 100644 index 0000000..de7246d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_20.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } +! +! PR fortran/34784, in which the intrinsic expression would be +! given the implicit type. +! +! Contributed by Dick Hendrickson +! +MODULE m + implicit character(s) + INTEGER :: I(1) = (/ (SELECTED_INT_KIND(J),J=1,1) /) +END MODULE m + +MODULE s_TESTS + IMPLICIT CHARACTER (P) +CONTAINS + subroutine simple (u,j1) + optional :: j1 + if (present (j1)) stop + end subroutine +END MODULE s_TESTS + +! { dg-final { cleanup-modules "m s_TESTS" } } diff --git a/gcc/testsuite/gfortran.dg/array_constructor_21.f90 b/gcc/testsuite/gfortran.dg/array_constructor_21.f90 new file mode 100644 index 0000000..f9e612c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_21.f90 @@ -0,0 +1,36 @@ +! { dg-do compile } +! +! PR fortran/34785, in which the character length of BA_T was not +! passed on to the array constructor argument of SEQ. +! +! Contributed by Dick Hendrickson +! + MODULE o_TYPE_DEFS + implicit none + TYPE SEQ + SEQUENCE + CHARACTER(len = 9) :: BA(2) + END TYPE SEQ + CHARACTER(len = 9) :: BA_T(2) + CHARACTER(LEN = 9) :: CA_T(1,2) + END MODULE o_TYPE_DEFS + + MODULE TESTS + use o_type_defs + implicit none + CONTAINS + SUBROUTINE OG0015(UDS0L) + TYPE(SEQ) UDS0L + integer :: j1 + UDS0L = SEQ((/ (BA_T(J1),J1=1,2) /)) + END SUBROUTINE + END MODULE TESTS + + use o_type_defs + CONTAINS + SUBROUTINE OG0015(UDS0L) + TYPE(SEQ) UDS0L + UDS0L = SEQ(RESHAPE ( (/ ((CA_T(J1,J2), J1 = 1, 1), J2 = 1, 2)/),(/2/))) + END SUBROUTINE + END +! { dg-final { cleanup-modules "o_TYPE_DEFS TESTS" } } -- 2.7.4