From: Steven G. Kargl Date: Thu, 22 Mar 2018 21:42:07 +0000 (+0000) Subject: re PR fortran/84922 (fortran reports inconsistency in rank of arguments in interface... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b74fa12697a7b369368b8792ea8217ba5fcfaf85;p=gcc.git re PR fortran/84922 (fortran reports inconsistency in rank of arguments in interface and contained procedures) 2018-03-22 Steven G. Kargl PR fortran/84922 * decl.c (get_proc_name): If the MODULE prefix appears in interface body, then it must appear on the contained subroutine or function. While here, fix nearby mis-indented code. 2018-03-22 Steven G. Kargl + + PR fortran/84922 + * decl.c (get_proc_name): If the MODULE prefix appears in interface + body, then it must appear on the contained subroutine or function. + While here, fix nearby mis-indented code. + 2018-03-21 Thomas Koenig Harald Anlauf diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f6649cf9500..a82689069d4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1245,15 +1245,26 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) "from a previous declaration", name); } - if (sym && !sym->gfc_new - && sym->attr.flavor != FL_UNKNOWN - && sym->attr.referenced == 0 && sym->attr.subroutine == 1 - && gfc_state_stack->state == COMP_CONTAINS - && gfc_state_stack->previous->state == COMP_SUBROUTINE) - { - gfc_error_now ("Procedure %qs at %C is already defined at %L", - name, &sym->declared_at); - } + /* C1246 (R1225) MODULE shall appear only in the function-stmt or + subroutine-stmt of a module subprogram or of a nonabstract interface + body that is declared in the scoping unit of a module or submodule. */ + if (sym->attr.external + && (sym->attr.subroutine || sym->attr.function) + && sym->attr.if_source == IFSRC_IFBODY + && !current_attr.module_procedure + && sym->attr.proc == PROC_MODULE + && gfc_state_stack->state == COMP_CONTAINS) + gfc_error_now ("Procedure %qs defined in interface body at %L " + "clashes with internal procedure defined at %C", + name, &sym->declared_at); + + if (sym && !sym->gfc_new + && sym->attr.flavor != FL_UNKNOWN + && sym->attr.referenced == 0 && sym->attr.subroutine == 1 + && gfc_state_stack->state == COMP_CONTAINS + && gfc_state_stack->previous->state == COMP_SUBROUTINE) + gfc_error_now ("Procedure %qs at %C is already defined at %L", + name, &sym->declared_at); if (gfc_current_ns->parent == NULL || *result == NULL) return rc; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d1ddb79a809..d4b8c275d55 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-03-22 Steven G. Kargl PR target/84826 diff --git a/gcc/testsuite/gfortran.dg/interface_42.f90 b/gcc/testsuite/gfortran.dg/interface_42.f90 new file mode 100644 index 00000000000..1fd47b920df --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_42.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-fmax-errors=1" } +! PR fortran/84922 +! Original code contributed by William Clodius. +module copy + + interface + module subroutine foo_da(da, copy) ! { dg-error "(1)" } + integer, intent(in) :: da(:) + integer, allocatable, intent(out) :: copy(:) + end subroutine foo_da + end interface + + contains + + subroutine foo_da(da, copy) ! { dg-error "defined in interface body" } + integer, intent(in) :: da(:) + integer, allocatable, intent(out) :: copy(:) + allocate( copy( size(da) ) ) + copy = da + end subroutine foo_da + +end module copy +{ dg-prune-output "compilation terminated" } diff --git a/gcc/testsuite/gfortran.dg/interface_43.f90 b/gcc/testsuite/gfortran.dg/interface_43.f90 new file mode 100644 index 00000000000..5a5294f99b9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_43.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! PR fortran/84922 +! This should compile without error. +module foom + + implicit none + + interface foo + module procedure foo_sngl + module procedure foo_dble + end interface foo + + contains + + subroutine foo_sngl(n, f, g, h) + integer n + real f, g, h + end subroutine foo_sngl + + subroutine foo_dble(n, f, g, h) + integer n + double precision f, g, h + end subroutine foo_dble + +end module foom