From a99288e554007c0ac5ecfdc7733de19f1a1965dc Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Wed, 5 Sep 2007 13:34:25 +0000 Subject: [PATCH] re PR fortran/31564 (Error: Type/rank mismatch in argument) 2007-09-05 Paul Thomas PR fortran/31564 * primary.c (gfc_match_rvalue): Make expressions that refer to derived type parameters that have array references into variable expressions. Remove references to use association from the symbol. PR fortran/33241 * decl.c (add_init_expr_to_sym): Provide assumed character length parameters with the length of the initialization expression, if a constant, or that of the first element of an array. 2007-09-05 Paul Thomas PR fortran/31564 * gfortran.dg/derived_comp_array_ref_2.f90: New test. PR fortran/33241 * gfortran.dg/char_length_10.f90: New test. From-SVN: r128130 --- gcc/fortran/ChangeLog | 14 ++++++++ gcc/fortran/decl.c | 21 ++++++++++-- gcc/fortran/primary.c | 29 +++++++++++++++++ gcc/testsuite/ChangeLog | 8 +++++ gcc/testsuite/gfortran.dg/char_length_10.f90 | 17 ++++++++++ .../gfortran.dg/derived_comp_array_ref_2.f90 | 32 +++++++++++++++++++ 6 files changed, 118 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/char_length_10.f90 create mode 100644 gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6ac59b6ba6e..e1d6ecf0777 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2007-09-05 Paul Thomas + + PR fortran/31564 + * primary.c (gfc_match_rvalue): Make expressions that refer + to derived type parameters that have array references into + variable expressions. Remove references to use association + from the symbol. + + PR fortran/33241 + * decl.c (add_init_expr_to_sym): Provide assumed character + length parameters with the length of the initialization + expression, if a constant, or that of the first element of + an array. + 2007-09-04 Janus Weil Paul Thomas diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 470cbfa4154..f9f92ad91b7 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1173,15 +1173,30 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) /* Update symbol character length according initializer. */ if (sym->ts.cl->length == NULL) { + int clen; /* If there are multiple CHARACTER variables declared on the same line, we don't want them to share the same length. */ sym->ts.cl = gfc_get_charlen (); sym->ts.cl->next = gfc_current_ns->cl_list; gfc_current_ns->cl_list = sym->ts.cl; - if (sym->attr.flavor == FL_PARAMETER - && init->expr_type == EXPR_ARRAY) - sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length); + if (sym->attr.flavor == FL_PARAMETER) + { + if (init->expr_type == EXPR_CONSTANT) + { + clen = init->value.character.length; + sym->ts.cl->length = gfc_int_expr (clen); + } + else if (init->expr_type == EXPR_ARRAY) + { + gfc_expr *p = init->value.constructor->expr; + clen = p->value.character.length; + sym->ts.cl->length = gfc_int_expr (clen); + } + else if (init->ts.cl && init->ts.cl->length) + sym->ts.cl->length = + gfc_copy_expr (sym->value->ts.cl->length); + } } /* Update initializer character length according symbol. */ else if (sym->ts.cl->length->expr_type == EXPR_CONSTANT) diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 2be27d7df41..f62299613fb 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2046,6 +2046,7 @@ gfc_match_rvalue (gfc_expr **result) int i; gfc_typespec *ts; bool implicit_char; + gfc_ref *ref; m = gfc_match_name (name); if (m != MATCH_YES) @@ -2143,6 +2144,34 @@ gfc_match_rvalue (gfc_expr **result) e->symtree = symtree; m = match_varspec (e, 0); + + if (sym->ts.is_c_interop || sym->ts.is_iso_c) + break; + + /* Variable array references to derived type parameters cause + all sorts of headaches in simplification. Make them variable + and scrub any module identity because they do not appear to + be referencable from the module. */ + if (sym->value && sym->ts.type == BT_DERIVED && e->ref) + { + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + break; + + if (ref == NULL) + break; + + ref = e->ref; + e->ref = NULL; + gfc_free_expr (e); + e = gfc_get_expr (); + e->expr_type = EXPR_VARIABLE; + e->symtree = symtree; + e->ref = ref; + sym->attr.use_assoc = 0; + sym->module = NULL; + } + break; case FL_DERIVED: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index aa4306bcb41..c6ba699c47f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-09-05 Paul Thomas + + PR fortran/31564 + * gfortran.dg/derived_comp_array_ref_2.f90: New test. + + PR fortran/33241 + * gfortran.dg/char_length_10.f90: New test. + 2007-09-05 Paolo Carlini PR c++/29731 diff --git a/gcc/testsuite/gfortran.dg/char_length_10.f90 b/gcc/testsuite/gfortran.dg/char_length_10.f90 new file mode 100644 index 00000000000..23bb37ff4fd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_length_10.f90 @@ -0,0 +1,17 @@ +{ dg-do compile } +! Checks the fix for PR33241, in which the assumed character +! length of the parameter was never filled in with that of +! the initializer. +! +! Contributed by Victor Prosolin +! +PROGRAM fptest + IMPLICIT NONE + CHARACTER (LEN=*), DIMENSION(1), PARAMETER :: var = 'a' + CALL parsef (var) +contains + SUBROUTINE parsef (Var) + IMPLICIT NONE + CHARACTER (LEN=*), DIMENSION(:), INTENT(in) :: Var + END SUBROUTINE parsef +END PROGRAM fptest diff --git a/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90 b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90 new file mode 100644 index 00000000000..0530b0e6ea6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_comp_array_ref_2.f90 @@ -0,0 +1,32 @@ +! { dg-do run } +! Tests the fix for PR31564, in which the actual argument to +! the call for set_bound was simplified when it should not be. +! +! Contributed by Michael Richmond +! +MODULE cdf_aux_mod + TYPE :: the_distribution + INTEGER :: parameters(2) + END TYPE the_distribution + TYPE (the_distribution), PARAMETER :: the_beta = the_distribution((/99,999/)) +CONTAINS + SUBROUTINE set_bound(arg_name, test) + INTEGER, INTENT (IN) :: arg_name, test + if (arg_name .ne. test) call abort () + END SUBROUTINE set_bound +END MODULE cdf_aux_mod + +MODULE cdf_beta_mod +CONTAINS + SUBROUTINE cdf_beta(which, test) + USE cdf_aux_mod + INTEGER :: which, test + CALL set_bound(the_beta%parameters(which), test) + END SUBROUTINE cdf_beta +END MODULE cdf_beta_mod + + use cdf_beta_mod + call cdf_beta (1, 99) + call cdf_beta (2, 999) +end +! { dg-final { cleanup-modules "cdf_aux_mod cdf_beta_mod" } }