From 28d08315ed4962e850886887085d35e135d6a34e Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 9 Dec 2007 09:17:24 +0000 Subject: [PATCH] re PR fortran/32129 (ICE: Procedure call with array-section-actual to scalar dummy) 2007-12-09 Paul Thomas PR fortran/32129 * dump-parse-tree.c (gfc_show_expr_n): New function for debugging. * gfortran.h : Add prototype for gfc_show_expr_n. * expr.c (simplify_constructor): Copy the constructor expression and try to simplify that. If success, replace the original. Otherwise discard the copy, keep going through the structure and return success. PR fortran/31487 * decl.c (build_struct): Pad out default initializers with spaces to the component character length. 2007-12-09 Paul Thomas PR fortran/32129 * gfortran.dg/derived_comp_array_ref_6.f90: New test. * gfortran.dg/derived_comp_array_ref_7.f90: New test. PR fortran/31487 * gfortran.dg/char_component_initializer_1.f90: New test. From-SVN: r130719 --- gcc/fortran/ChangeLog | 15 +++++++++++ gcc/fortran/decl.c | 18 +++++++++++++ gcc/fortran/dump-parse-tree.c | 9 +++++++ gcc/fortran/expr.c | 19 +++++++++++-- gcc/fortran/gfortran.h | 1 + gcc/testsuite/ChangeLog | 11 +++++++- .../char_component_initializer_1.f90 | 18 +++++++++++++ .../gfortran.dg/derived_comp_array_ref_6.f90 | 27 +++++++++++++++++++ .../gfortran.dg/derived_comp_array_ref_7.f90 | 25 +++++++++++++++++ 9 files changed, 140 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/char_component_initializer_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90 create mode 100644 gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 290005f3398..4a02e5c2f05 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2007-12-09 Paul Thomas + + PR fortran/32129 + * dump-parse-tree.c (gfc_show_expr_n): New function for + debugging. + * gfortran.h : Add prototype for gfc_show_expr_n. + * expr.c (simplify_constructor): Copy the constructor + expression and try to simplify that. If success, replace the + original. Otherwise discard the copy, keep going through + the structure and return success. + + PR fortran/31487 + * decl.c (build_struct): Pad out default initializers with + spaces to the component character length. + 2007-12-08 Tobias Burnus PR fortran/34342 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index e9b7651c534..584bb19b4a4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1394,6 +1394,24 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, c->dimension = 1; *as = NULL; + /* Should this ever get more complicated, combine with similar section + in add_init_expr_to_sym into a separate function. */ + if (c->ts.type == BT_CHARACTER && !c->pointer && c->initializer) + { + int len = mpz_get_si (c->ts.cl->length->value.integer); + + if (c->initializer->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, c->initializer, false); + else if (mpz_cmp (c->ts.cl->length->value.integer, + c->initializer->ts.cl->length->value.integer)) + { + gfc_constructor *ctor = c->initializer->value.constructor; + for (;ctor ; ctor = ctor->next) + if (ctor->expr->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, ctor->expr, true); + } + } + /* Check array components. */ if (!c->dimension) { diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index e1e463f7fcd..f9c92b272e6 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -540,6 +540,15 @@ gfc_show_expr (gfc_expr *p) } } +/* Show an expression for diagnostic purposes. */ +void +gfc_show_expr_n (const char * msg, gfc_expr *e) +{ + if (msg) + gfc_status (msg); + gfc_show_expr (e); + gfc_status_char ('\n'); +} /* Show symbol attributes. The flavor and intent are followed by whatever single bit attributes are present. */ diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 1242e5eb0a9..255acb6f188 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -963,6 +963,8 @@ simplify_intrinsic_op (gfc_expr *p, int type) static try simplify_constructor (gfc_constructor *c, int type) { + gfc_expr *p; + for (; c; c = c->next) { if (c->iterator @@ -971,8 +973,21 @@ simplify_constructor (gfc_constructor *c, int type) || gfc_simplify_expr (c->iterator->step, type) == FAILURE)) return FAILURE; - if (c->expr && gfc_simplify_expr (c->expr, type) == FAILURE) - return FAILURE; + if (c->expr) + { + /* Try and simplify a copy. Replace the original if successful + but keep going through the constructor at all costs. Not + doing so can make a dog's dinner of complicated things. */ + p = gfc_copy_expr (c->expr); + + if (gfc_simplify_expr (p, type) == FAILURE) + { + gfc_free_expr (p); + continue; + } + + gfc_replace_expr (c->expr, p); + } } return SUCCESS; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 10453389dfe..f1fe8729735 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2359,6 +2359,7 @@ void gfc_show_components (gfc_symbol *); void gfc_show_constructor (gfc_constructor *); void gfc_show_equiv (gfc_equiv *); void gfc_show_expr (gfc_expr *); +void gfc_show_expr_n (const char *, gfc_expr *); void gfc_show_namelist (gfc_namelist *); void gfc_show_namespace (gfc_namespace *); void gfc_show_ref (gfc_ref *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cbf82bf38eb..c56d1efa7ce 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,13 @@ -2007-12-06 Tobias Burnus +2007-12-09 Paul Thomas + + PR fortran/32129 + * gfortran.dg/derived_comp_array_ref_6.f90: New test. + * gfortran.dg/derived_comp_array_ref_7.f90: New test. + + PR fortran/31487 + * gfortran.dg/char_component_initializer_1.f90: New test. + +2007-12-09 Tobias Burnus PR fortran/34342 PR fortran/34345 diff --git a/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90 b/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90 new file mode 100644 index 00000000000..8642ddfca41 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_component_initializer_1.f90 @@ -0,0 +1,18 @@ +! { dg-do run } +! Check the fix for PR31487 in which the derived type default initializer +! would be padded out with nulls instead of spaces. +! +! Reported by Harald Anlauf +! +program gfcbug62 + implicit none + character(len=16) :: tdefi(2) = (/'0z1jan0000','1hr '/) + type t_ctl + character(len=16) :: tdefi(2) = (/'0z1jan0000','1hr '/) + end type t_ctl + + type(t_ctl) :: ctl + integer :: i,k + + if (tdefi(1) .ne. ctl%tdefi(1)) call abort () +end program gfcbug62 diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90 new file mode 100644 index 00000000000..b8a2a819b51 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_6.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! Check the fix for PR32129 in which the argument 'vec(vy(i, :))' was +! incorrectly simplified, resulting in an ICE and a missed error. +! +! Reported by Tobias Burnus +! + MODULE cdf_aux_mod + TYPE :: the_distribution + INTEGER :: parameters(1) + END TYPE the_distribution + TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/0/)) + CONTAINS + SUBROUTINE set_bound(arg_name) + INTEGER, INTENT (IN) :: arg_name + END SUBROUTINE set_bound + END MODULE cdf_aux_mod + MODULE cdf_beta_mod + CONTAINS + SUBROUTINE cdf_beta() + USE cdf_aux_mod + INTEGER :: which + which = 1 + CALL set_bound(the_beta%parameters(1:which)) ! { dg-error "Type/rank mismatch" } + END SUBROUTINE cdf_beta + END MODULE cdf_beta_mod + +! { dg-final { cleanup-modules "cdf_aux_mod" } } diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90 new file mode 100644 index 00000000000..89005658989 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_7.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! Check the fix for PR32129 #4 in which the argument 'vec(vy(i, :))' was +! incorrectly simplified, resulting in an ICE. +! +! Reported by Francois-Xavier Coudert +! +program testCode + implicit none + type vec + real, dimension(2) :: coords + end type + integer :: i + real, dimension(2,2), parameter :: vy = reshape ((/1,2,3,4/),(/2,2/)) + i = 1 + if (any (foo(vec(vy(i, :))) /= vy(i, :))) call abort () + +contains + + function foo (xin) + type(vec) :: xin + real, dimension (2) :: foo + intent(in) xin + foo = xin%coords + end function +end program -- 2.30.2