diff options
author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-10-06 12:20:09 +0000 |
---|---|---|
committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-10-06 12:20:09 +0000 |
commit | 697e174506f3c1b17e6c34332821f790a0d07056 (patch) | |
tree | 187f0ab5e166b729754e62a8ee2c9145efe1f7f2 /gcc/fortran | |
parent | 76a666c10fd1533de1c85b80e2d78a29c8828d79 (diff) | |
download | ppe42-gcc-697e174506f3c1b17e6c34332821f790a0d07056.tar.gz ppe42-gcc-697e174506f3c1b17e6c34332821f790a0d07056.zip |
2012-10-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/45521
* interface.c (generic_correspondence): Implement additional
distinguishability criteria of F08.
(compare_actual_formal): Reject data object as actual argument for
procedure formal argument.
2012-10-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/45521
* gfortran.dg/generic_25.f90: New.
* gfortran.dg/generic_26.f90: New.
* gfortran.dg/generic_27.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@192157 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/interface.c | 39 |
2 files changed, 30 insertions, 17 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a861601e0c2..c8f5c2bb9c4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2012-10-06 Janus Weil <janus@gcc.gnu.org> + + PR fortran/45521 + * interface.c (generic_correspondence): Implement additional + distinguishability criteria of F08. + (compare_actual_formal): Reject data object as actual argument for + procedure formal argument. + 2012-10-04 Tobias Burnus <burnus@net-b.de> * expr.c (scalarize_intrinsic_call): Plug memory leak. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index fb3da1fb7ba..4822149cc0b 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -932,9 +932,9 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, } -/* Perform the correspondence test in rule 3 of section F03:16.2.3. - Returns zero if no argument is found that satisfies rule 3, nonzero - otherwise. 'p1' and 'p2' are the PASS arguments of both procedures +/* Perform the correspondence test in rule (3) of F08:C1215. + Returns zero if no argument is found that satisfies this rule, + nonzero otherwise. 'p1' and 'p2' are the PASS arguments of both procedures (if applicable). This test is also not symmetric in f1 and f2 and must be called @@ -942,13 +942,13 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2, argument list with keywords. For example: INTERFACE FOO - SUBROUTINE F1(A, B) - INTEGER :: A ; REAL :: B - END SUBROUTINE F1 + SUBROUTINE F1(A, B) + INTEGER :: A ; REAL :: B + END SUBROUTINE F1 - SUBROUTINE F2(B, A) - INTEGER :: A ; REAL :: B - END SUBROUTINE F1 + SUBROUTINE F2(B, A) + INTEGER :: A ; REAL :: B + END SUBROUTINE F1 END INTERFACE FOO At this point, 'CALL FOO(A=1, B=1.0)' is ambiguous. */ @@ -973,7 +973,10 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, f2 = f2->next; if (f2 != NULL && (compare_type_rank (f1->sym, f2->sym) - || compare_type_rank (f2->sym, f1->sym))) + || compare_type_rank (f2->sym, f1->sym)) + && !((gfc_option.allow_std & GFC_STD_F2008) + && ((f1->sym->attr.allocatable && f2->sym->attr.pointer) + || (f2->sym->attr.allocatable && f1->sym->attr.pointer)))) goto next; /* Now search for a disambiguating keyword argument starting at @@ -984,7 +987,10 @@ generic_correspondence (gfc_formal_arglist *f1, gfc_formal_arglist *f2, continue; sym = find_keyword_arg (g->sym->name, f2_save); - if (sym == NULL || !compare_type_rank (g->sym, sym)) + if (sym == NULL || !compare_type_rank (g->sym, sym) + || ((gfc_option.allow_std & GFC_STD_F2008) + && ((sym->attr.allocatable && g->sym->attr.pointer) + || (sym->attr.pointer && g->sym->attr.allocatable)))) return 1; } @@ -2551,8 +2557,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, skip_size_check: - /* Satisfy 12.4.1.3 by ensuring that a procedure pointer actual argument - is provided for a procedure pointer formal argument. */ + /* Satisfy F03:12.4.1.3 by ensuring that a procedure pointer actual + argument is provided for a procedure pointer formal argument. */ if (f->sym->attr.proc_pointer && !((a->expr->expr_type == EXPR_VARIABLE && a->expr->symtree->n.sym->attr.proc_pointer) @@ -2566,11 +2572,10 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, return 0; } - /* Satisfy 12.4.1.2 by ensuring that a procedure actual argument is + /* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is provided for a procedure formal argument. */ - if (a->expr->ts.type != BT_PROCEDURE && !gfc_is_proc_ptr_comp (a->expr) - && a->expr->expr_type == EXPR_VARIABLE - && f->sym->attr.flavor == FL_PROCEDURE) + if (f->sym->attr.flavor == FL_PROCEDURE + && gfc_expr_attr (a->expr).flavor != FL_PROCEDURE) { if (where) gfc_error ("Expected a procedure for argument '%s' at %L", |