From 43dfd40c1d5934d5850dcfd2c9a1b9e856bf32a7 Mon Sep 17 00:00:00 2001
From: "Steven G. Kargl" <kargl@gcc.gnu.org>
Date: Thu, 10 Sep 2009 21:22:08 +0000
Subject: [PATCH] re PR fortran/31292 (ICE with module procedure interface in a
procedure body)
2009-09-10 Steven G. Kargl <kargl@gcc.gnu.org>
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 <kargl@gcc.gnu.org>
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.
From-SVN: r151616
---
gcc/fortran/ChangeLog | 8 +++
gcc/fortran/decl.c | 14 ++++-
gcc/testsuite/ChangeLog | 7 +++
gcc/testsuite/gfortran.dg/generic_14.f90 | 8 +--
.../gfortran.dg/module_procedure_1.f90 | 53 +++++++++++++++++++
.../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 c01c4b351b0d..d134e2cadcfe 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-09-10 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ 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 <rguenther@suse.de>
PR fortran/41297
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 52796a655750..3ce7fd4a3375 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 3a6e97a8ea4e..7b23648297d5 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-09-10 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ 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 <ro@CeBiTec.Uni-Bielefeld.DE>
James A. Morrison <phython@gcc.gnu.org>
diff --git a/gcc/testsuite/gfortran.dg/generic_14.f90 b/gcc/testsuite/gfortran.dg/generic_14.f90
index 3198da1dafc1..e95f6f2edebc 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 000000000000..5e1fa15c729f
--- /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 000000000000..8f6db25fb13d
--- /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
--
GitLab