F2PY G3: Impl. F90 module subprogram support and simple tests.

2 files changed, 143 insertions, 10 deletions

diff --git a/numpy/f2py/lib/py_wrap_subprogram.py b/numpy/f2py/lib/py_wrap_subprogram.py
index 012eac2a8..719d3fb29 100644
--- a/numpy/f2py/lib/py_wrap_subprogram.py
+++ b/numpy/f2py/lib/py_wrap_subprogram.py
@@ -3,7 +3,7 @@ __all__ = ['PythonCAPISubProgram']
 
 import sys
 
-from parser.api import TypeDecl, TypeStmt
+from parser.api import TypeDecl, TypeStmt, Module
 from wrapper_base import *
 from py_wrap_type import *
 
@@ -12,20 +12,18 @@ class PythonCAPISubProgram(WrapperBase):
     Fortran subprogram hooks.
     """
 
-    header_template = '''\
+    header_template_f77 = '''\
 #define %(name)s_f F_FUNC(%(name)s, %(NAME)s)
 '''
-    typedef_template = ''
-    extern_template = '''\
+    extern_template_f77 = '''\
 extern void %(name)s_f();
 '''
-    objdecl_template = '''\
+    objdecl_template_doc = '''\
 static char %(cname)s__doc[] = "";
 '''
-    module_init_template = ''
     module_method_template = '''\
 {"%(pyname)s", (PyCFunction)%(cname)s, METH_VARARGS | METH_KEYWORDS, %(cname)s__doc},'''
-    c_code_template = ''
+
     capi_code_template = '''\
 static PyObject* %(cname)s(PyObject *capi_self, PyObject *capi_args, PyObject *capi_keywds) {
   PyObject * volatile capi_buildvalue = NULL;
@@ -50,8 +48,35 @@ static PyObject* %(cname)s(PyObject *capi_self, PyObject *capi_args, PyObject *c
   return capi_buildvalue;
 }
 '''
-    fortran_code_template = ''
-    
+
+    header_template_module = '''
+#define %(name)s_f (*%(name)s_func_ptr)
+#define %(init_func)s_f F_FUNC(%(init_func)s, %(INIT_FUNC)s)
+'''
+    typedef_template_module = '''
+typedef void (*%(name)s_functype)();
+'''
+    extern_template_module = '''\
+static %(name)s_functype %(name)s_func_ptr;
+'''
+    objdecl_template_module = '''
+'''
+    fortran_code_template_module = '''
+    subroutine %(init_func)s(init_func_c)
+      use %(mname)s
+      external init_func_c
+      call init_func_c(%(name)s)
+    end
+'''
+    c_code_template_module = '''
+static void %(init_func)s_c(%(name)s_functype func_ptr) {
+  %(name)s_func_ptr = func_ptr;
+}
+'''
+    module_init_template_module = '''
+%(init_func)s_f(%(init_func)s_c);
+'''
+
     _defined = []
     def __init__(self, parent, block):
         WrapperBase.__init__(self)
@@ -66,6 +91,30 @@ static PyObject* %(cname)s(PyObject *capi_self, PyObject *capi_args, PyObject *c
             pyname = pyname[9:]
         self.pyname = pyname
 
+        self.header_template = ''
+        self.extern_template = ''
+        self.module_init_template = ''
+        self.typedef_template = ''
+        self.c_code_template = ''
+        self.objdecl_template =  ''
+        self.fortran_code_template = ''
+
+        if isinstance(block.parent, Module):
+            self.mname = block.parent.name
+            self.init_func = '%s_init' % (name)
+            self.typedef_template += self.typedef_template_module
+            self.header_template += self.header_template_module
+            self.fortran_code_template += self.fortran_code_template_module
+            self.module_init_template += self.module_init_template_module
+            self.objdecl_template += self.objdecl_template_module
+            self.c_code_template += self.c_code_template_module
+            self.extern_template += self.extern_template_module
+        else:
+            self.extern_template += self.extern_template_f77
+            self.header_template += self.header_template_f77
+
+        self.objdecl_template += self.objdecl_template_doc
+
         self.decl_list = []
         self.kw_list = []
         self.optkw_list = []
@@ -111,7 +160,8 @@ static PyObject* %(cname)s(PyObject *capi_self, PyObject *capi_args, PyObject *c
                     self.pyarg_obj_list.append('\npyobj_to_%s, &%s' % (ti.ctype, argname))
                 assert not isinstance(typedecl, TypeDecl)
                 if ti.ctype=='f2py_string0':
-                    assert not var.is_intent_out(),'intent(out) not implemented for "%s"' % (var)
+                    if not var.is_intent_in():
+                        assert not var.is_intent_out(),'intent(out) not implemented for "%s"' % (var)
                     self.decl_list.append('%s %s = {NULL,0};' % (ti.ctype, argname))
                     args_f.append('%s.data' % argname)  # is_scalar
                     extra_args_f.append('%s.len' % argname)
diff --git a/numpy/f2py/lib/test_module_scalar.py b/numpy/f2py/lib/test_module_scalar.py
new file mode 100644
index 000000000..cd04a0b23
--- /dev/null
+++ b/numpy/f2py/lib/test_module_scalar.py
@@ -0,0 +1,83 @@
+#!/usr/bin/env python
+"""
+Tests for module with scalar derived types and subprograms.
+
+-----
+Permission to use, modify, and distribute this software is given under the
+terms of the NumPy License. See http://scipy.org.
+
+NO WARRANTY IS EXPRESSED OR IMPLIED.  USE AT YOUR OWN RISK.
+Author: Pearu Peterson <pearu@cens.ioc.ee>
+Created: Oct 2006
+-----
+"""
+
+import os
+import sys
+from numpy.testing import *
+
+def build(fortran_code, rebuild=True):
+    modulename = os.path.splitext(os.path.basename(__file__))[0] + '_ext'
+    try:
+        exec ('import %s as m' % (modulename))
+        if rebuild and os.stat(m.__file__)[8] < os.stat(__file__)[8]:
+            del sys.modules[m.__name__] # soft unload extension module
+            os.remove(m.__file__)
+            raise ImportError,'%s is newer than %s' % (__file__, m.__file__)
+    except ImportError,msg:
+        assert str(msg)==('No module named %s' % (modulename)),str(msg)
+        print msg, ', recompiling %s.' % (modulename)
+        import tempfile
+        fname = tempfile.mktemp() + '.f90'
+        f = open(fname,'w')
+        f.write(fortran_code)
+        f.close()
+        sys_argv = []
+        sys_argv.extend(['--build-dir','tmp'])
+        #sys_argv.extend(['-DF2PY_DEBUG_PYOBJ_TOFROM'])
+        from main import build_extension
+        sys_argv.extend(['-m',modulename, fname])
+        build_extension(sys_argv)
+        os.remove(fname)
+        status = os.system(' '.join([sys.executable] + sys.argv))
+        sys.exit(status)
+    return m
+
+fortran_code = '''
+module test_module_scalar_ext
+
+  contains
+    subroutine foo(a)
+    integer a
+!f2py intent(in,out) a
+    a = a + 1
+    end subroutine foo
+    function foo2(a)
+    integer a
+    integer foo2
+    foo2 = a + 2
+    end function foo2
+end module test_module_scalar_ext
+'''
+
+# tester note: set rebuild=True when changing fortan_code and for SVN
+m = build(fortran_code, rebuild=True)
+
+from numpy import *
+
+class test_m(NumpyTestCase):
+
+    def check_foo_simple(self, level=1):
+        foo = m.foo
+        r = foo(2)
+        assert isinstance(r,int32),`type(r)`
+        assert_equal(r,3)
+
+    def check_foo2_simple(self, level=1):
+        foo2 = m.foo2
+        r = foo2(2)
+        assert isinstance(r,int32),`type(r)`
+        assert_equal(r,4)
+
+if __name__ == "__main__":
+    NumpyTest().run()