diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2009-06-22 23:02:19 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2009-06-22 23:02:19 +0200 |
| commit | 03bd096b3b14d8980130c6c6ee5eccf63fca9e37 (patch) | |
| tree | 520241a9afb08809d3512d9abdd9b26c088438a3 | |
| parent | 34481f289c6844b496ead2a34200c5a6e13c3216 (diff) | |
| download | gcc-03bd096b3b14d8980130c6c6ee5eccf63fca9e37.zip gcc-03bd096b3b14d8980130c6c6ee5eccf63fca9e37.tar.gz gcc-03bd096b3b14d8980130c6c6ee5eccf63fca9e37.tar.bz2 | |
re PR fortran/37254 (Reject valid PROCEDURE statement with implicit interface)
2009-06-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/37254
PR fortran/39850
* interface.c (compare_parameter): Set implicit type for function
actual arguments with BT_UNKNOWN.
2009-06-22 Janus Weil <janus@gcc.gnu.org>
PR fortran/37254
PR fortran/39850
* gfortran.dg/interface_30.f90: Modified error message.
* gfortran.dg/proc_decl_22.f90: New.
From-SVN: r148816
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 11 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/interface_30.f90 | 4 | ||||
| -rwxr-xr-x | gcc/testsuite/gfortran.dg/proc_decl_22.f90 | 25 |
5 files changed, 49 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b502caf..cda349d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2009-06-22 Janus Weil <janus@gcc.gnu.org> + + PR fortran/37254 + PR fortran/39850 + * interface.c (compare_parameter): Set implicit type for function + actual arguments with BT_UNKNOWN. + 2009-06-22 Tobias Burnus <burnus@net-b.de> PR fortran/40472 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 53cc95f..c6da6f8 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1407,9 +1407,14 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, } if (formal->attr.function && !act_sym->attr.function) - gfc_add_function (&act_sym->attr, act_sym->name, &act_sym->declared_at); - - if (formal->attr.subroutine && !act_sym->attr.subroutine) + { + gfc_add_function (&act_sym->attr, act_sym->name, + &act_sym->declared_at); + if (act_sym->ts.type == BT_UNKNOWN + && gfc_set_default_type (act_sym, 1, act_sym->ns) == FAILURE) + return 0; + } + else if (formal->attr.subroutine && !act_sym->attr.subroutine) gfc_add_subroutine (&act_sym->attr, act_sym->name, &act_sym->declared_at); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2bb9f6f..59918e1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2009-06-22 Janus Weil <janus@gcc.gnu.org> + + PR fortran/37254 + PR fortran/39850 + * gfortran.dg/interface_30.f90: Modified error message. + * gfortran.dg/proc_decl_22.f90: New. + 2009-06-22 Ian Lance Taylor <iant@google.com> * gcc.dg/Wcxx-compat-19.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/interface_30.f90 b/gcc/testsuite/gfortran.dg/interface_30.f90 index 0576a42..cfea706 100644 --- a/gcc/testsuite/gfortran.dg/interface_30.f90 +++ b/gcc/testsuite/gfortran.dg/interface_30.f90 @@ -15,9 +15,9 @@ program test call sub1(func1) call sub2(func2) call sub1(func3) - call sub2(func3) ! { dg-error "Type mismatch in argument" } + call sub2(func3) ! { dg-error "is not a subroutine" } call sub2(func4) - call sub1(func4) ! { dg-error "Interface mismatch in dummy procedure" } + call sub1(func4) ! { dg-error "is not a function" } contains subroutine sub1(a1) interface diff --git a/gcc/testsuite/gfortran.dg/proc_decl_22.f90 b/gcc/testsuite/gfortran.dg/proc_decl_22.f90 new file mode 100755 index 0000000..4006006 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_decl_22.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! +! PR 37254: Reject valid PROCEDURE statement with implicit interface +! +! Original test case by Dominique d'Humieres <dominiq@lps.ens.fr> +! Modified by Janus Weil <janus@gcc.gnu.org> + + real function proc3( arg1 ) + integer :: arg1 + proc3 = arg1+7 + end function proc3 + +program myProg + PROCEDURE () :: proc3 + call proc4( proc3 ) + +contains + + subroutine proc4( arg1 ) + PROCEDURE(real) :: arg1 + print*, 'the func: ', arg1(0) + end subroutine proc4 + +end program myProg + |