From 15ca386589c818417731fb096d1d65048760976b Mon Sep 17 00:00:00 2001 From: kargl Date: Thu, 10 Sep 2009 21:22:08 +0000 Subject: [PATCH] 2009-09-10 Steven G. Kargl PR fortran/31292 * fortran/decl.c(gfc_match_modproc): Check that module procedures from a module can USEd in module procedure statements in other program units. Update locus for better error message display. Detect intrinsic procedures in module procedure statements. 2009-09-10 Steven G. Kargl PR fortran/31292 * gfortran.dg/module_procedure_1.f90: New test. * gfortran.dg/module_procedure_2.f90: Ditto. * gfortran.dg/generic_14.f90: Move dg-error to new location. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@151616 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/decl.c | 14 ++++++- gcc/testsuite/ChangeLog | 7 ++++ gcc/testsuite/gfortran.dg/generic_14.f90 | 8 ++-- gcc/testsuite/gfortran.dg/module_procedure_1.f90 | 53 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/module_procedure_2.f90 | 8 ++++ 6 files changed, 93 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/module_procedure_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/module_procedure_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c01c4b351b0..d134e2cadcf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2009-09-10 Steven G. Kargl + + PR fortran/31292 + * fortran/decl.c(gfc_match_modproc): Check that module procedures + from a module can USEd in module procedure statements in other + program units. Update locus for better error message display. + Detect intrinsic procedures in module procedure statements. + 2009-09-09 Richard Guenther PR fortran/41297 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 52796a65575..3ce7fd4a337 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -6485,7 +6485,10 @@ gfc_match_modproc (void) module_ns = gfc_current_ns->parent; for (; module_ns; module_ns = module_ns->parent) - if (module_ns->proc_name->attr.flavor == FL_MODULE) + if (module_ns->proc_name->attr.flavor == FL_MODULE + || module_ns->proc_name->attr.flavor == FL_PROGRAM + || (module_ns->proc_name->attr.flavor == FL_PROCEDURE + && !module_ns->proc_name->attr.contained)) break; if (module_ns == NULL) @@ -6497,6 +6500,7 @@ gfc_match_modproc (void) for (;;) { + locus old_locus = gfc_current_locus; bool last = false; m = gfc_match_name (name); @@ -6517,6 +6521,13 @@ gfc_match_modproc (void) if (gfc_get_symbol (name, module_ns, &sym)) return MATCH_ERROR; + if (sym->attr.intrinsic) + { + gfc_error ("Intrinsic procedure at %L cannot be a MODULE " + "PROCEDURE", &old_locus); + return MATCH_ERROR; + } + if (sym->attr.proc != PROC_MODULE && gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL) == FAILURE) @@ -6526,6 +6537,7 @@ gfc_match_modproc (void) return MATCH_ERROR; sym->attr.mod_proc = 1; + sym->declared_at = old_locus; if (last) break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3a6e97a8ea4..7b23648297d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2009-09-10 Steven G. Kargl + + PR fortran/31292 + * gfortran.dg/module_procedure_1.f90: New test. + * gfortran.dg/module_procedure_2.f90: Ditto. + * gfortran.dg/generic_14.f90: Move dg-error to new location. + 2009-09-10 Rainer Orth James A. Morrison diff --git a/gcc/testsuite/gfortran.dg/generic_14.f90 b/gcc/testsuite/gfortran.dg/generic_14.f90 index 3198da1dafc..e95f6f2edeb 100644 --- a/gcc/testsuite/gfortran.dg/generic_14.f90 +++ b/gcc/testsuite/gfortran.dg/generic_14.f90 @@ -85,18 +85,18 @@ end module f module g implicit none - external wrong_b ! { dg-error "has no explicit interface" } + external wrong_b interface gen_wrong_5 - module procedure wrong_b ! wrong, see above + module procedure wrong_b ! { dg-error "has no explicit interface" } end interface gen_wrong_5 end module g module h implicit none - external wrong_c ! { dg-error "has no explicit interface" } + external wrong_c real wrong_c interface gen_wrong_6 - module procedure wrong_c ! wrong, see above + module procedure wrong_c ! { dg-error "has no explicit interface" } end interface gen_wrong_6 end module h diff --git a/gcc/testsuite/gfortran.dg/module_procedure_1.f90 b/gcc/testsuite/gfortran.dg/module_procedure_1.f90 new file mode 100644 index 00000000000..5e1fa15c729 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/module_procedure_1.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! Modified program from http://groups.google.com/group/\ +! comp.lang.fortran/browse_frm/thread/423e4392dc965ab7# +! +module myoperator + contains + function dadd(arg1,arg2) + integer ::dadd(2) + integer, intent(in) :: arg1(2), arg2(2) + dadd(1)=arg1(1)+arg2(1) + dadd(2)=arg1(2)+arg2(2) + end function dadd +end module myoperator + +program test_interface + + use myoperator + + implicit none + + interface operator (.myadd.) + module procedure dadd + end interface + + integer input1(2), input2(2), mysum(2) + + input1 = (/0,1/) + input2 = (/3,3/) + mysum = input1 .myadd. input2 + if (mysum(1) /= 3 .and. mysum(2) /= 4) call abort + + call test_sub(input1, input2) + +end program test_interface + +subroutine test_sub(input1, input2) + + use myoperator + + implicit none + + interface operator (.myadd.) + module procedure dadd + end interface + + integer, intent(in) :: input1(2), input2(2) + integer mysum(2) + + mysum = input1 .myadd. input2 + if (mysum(1) /= 3 .and. mysum(2) /= 4) call abort + +end subroutine test_sub +! { dg-final { cleanup-modules "myoperator" } } diff --git a/gcc/testsuite/gfortran.dg/module_procedure_2.f90 b/gcc/testsuite/gfortran.dg/module_procedure_2.f90 new file mode 100644 index 00000000000..8f6db25fb13 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/module_procedure_2.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +program test + implicit none + intrinsic sin + interface gen2 + module procedure sin ! { dg-error "cannot be a MODULE PROCEDURE" } + end interface gen2 +end program test -- 2.11.4.GIT