diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2006-02-09 23:23:28 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2006-02-09 23:23:28 +0000 |
| commit | c4bbc105641ea61b0d4e5a826d639f1051a00667 (patch) | |
| tree | 00c734869e76676429a0a682e4ca72bdc7c46b7e /gcc/fortran/interface.c | |
| parent | 95c029c30c717127d0120154eff20232ecb9f3c8 (diff) | |
| download | gcc-c4bbc105641ea61b0d4e5a826d639f1051a00667.zip gcc-c4bbc105641ea61b0d4e5a826d639f1051a00667.tar.gz gcc-c4bbc105641ea61b0d4e5a826d639f1051a00667.tar.bz2 | |
re PR fortran/26038 (ICE on allocation of assumed length CHARACTER dummy.)
2006-02-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/26038
* trans-stmt.c (gfc_trans_allocate): Provide assumed character length
scalar with missing backend_decl for the hidden dummy charlen.
PR fortran/25059
* interface.c (gfc_extend_assign): Remove detection of non-PURE
subroutine in assignment interface, with gfc_error, and put it in
* resolve.c (resolve_code).
PR fortran/25070
* interface.c (gfc_procedure_use): Flag rank checking for non-
elemental, contained or interface procedures in call to
(compare_actual_formal), where ranks are checked for assumed
shape arrays..
2006-02-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/26038
* gfortran.dg/allocate_char_star_scalar_1.f90: New test.
PR fortran/25059
* gfortran.dg/impure_assignment_1.f90: New test.
PR fortran/25070
* gfortran.dg/assumed_shape_ranks_1.f90: New test.
From-SVN: r110816
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 20 |
1 files changed, 10 insertions, 10 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 93e3657..7c86279 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1241,7 +1241,10 @@ compare_actual_formal (gfc_actual_arglist ** ap, } if (!compare_parameter - (f->sym, a->expr, ranks_must_agree, is_elemental)) + (f->sym, a->expr, + ranks_must_agree && f->sym->as + && f->sym->as->type == AS_ASSUMED_SHAPE, + is_elemental)) { if (where) gfc_error ("Type/rank mismatch in argument '%s' at %L", @@ -1563,6 +1566,10 @@ check_intents (gfc_formal_arglist * f, gfc_actual_arglist * a) void gfc_procedure_use (gfc_symbol * sym, gfc_actual_arglist ** ap, locus * where) { + int ranks_must_agree; + ranks_must_agree = !sym->attr.elemental && (sym->attr.contained + || sym->attr.if_source == IFSRC_IFBODY); + /* Warn about calls with an implicit interface. */ if (gfc_option.warn_implicit_interface && sym->attr.if_source == IFSRC_UNKNOWN) @@ -1570,8 +1577,8 @@ gfc_procedure_use (gfc_symbol * sym, gfc_actual_arglist ** ap, locus * where) sym->name, where); if (sym->attr.if_source == IFSRC_UNKNOWN - || !compare_actual_formal (ap, sym->formal, 0, - sym->attr.elemental, where)) + || !compare_actual_formal (ap, sym->formal, ranks_must_agree, + sym->attr.elemental, where)) return; check_intents (sym->formal, *ap); @@ -1796,13 +1803,6 @@ gfc_extend_assign (gfc_code * c, gfc_namespace * ns) c->expr2 = NULL; c->ext.actual = actual; - if (gfc_pure (NULL) && !gfc_pure (sym)) - { - gfc_error ("Subroutine '%s' called in lieu of assignment at %L must be " - "PURE", sym->name, &c->loc); - return FAILURE; - } - return SUCCESS; } |