WIP: implemented assumed shape support for Fortran subroutines.

5 files changed, 157 insertions, 32 deletions

diff --git a/numpy/f2py/auxfuncs.py b/numpy/f2py/auxfuncs.py
index ac95669b7..a12d92b7e 100644
--- a/numpy/f2py/auxfuncs.py
+++ b/numpy/f2py/auxfuncs.py
@@ -206,6 +206,21 @@ def isfunction_wrap(rout):
 def issubroutine(rout):
     return ('block' in rout and 'subroutine'==rout['block'])
 
+def issubroutine_wrap(rout):
+    if isintent_c(rout):
+        return 0
+    return issubroutine(rout) and hasassumedshape(rout)
+
+def hasassumedshape(rout):
+    if rout.get('hasassumedshape'):
+        return True
+    for a in rout['args']:
+        for d in rout['vars'].get(a,{}).get('dimension',[]):
+            if d==':':
+                rout['hasassumedshape'] = True
+                return True
+    return False
+
 def isroutine(rout):
     return isfunction(rout) or issubroutine(rout)
 
diff --git a/numpy/f2py/func2subr.py b/numpy/f2py/func2subr.py
index 6ef8da3cb..4fee8c3c1 100644
--- a/numpy/f2py/func2subr.py
+++ b/numpy/f2py/func2subr.py
@@ -164,32 +164,107 @@ def createfuncwrapper(rout,signature=0):
     #print '**'*10
     return ret[0]
 
-def assubr(rout):
-    if not isfunction_wrap(rout):
-        return rout,''
-    fortranname = getfortranname(rout)
+def createsubrwrapper(rout,signature=0):
+    assert issubroutine(rout)
+
+    extra_args = []
+    vars = rout['vars']
+    for a in rout['args']:
+        v = rout['vars'][a]
+        for i,d in enumerate(v.get('dimension',[])):
+            if d==':':
+                dn = 'f2py_%s_d%s' % (a, i)
+                dv = dict(typespec='integer', intent=['hide'])
+                dv['='] = 'shape(%s, %s)' % (a, i)
+                extra_args.append(dn)
+                vars[dn] = dv
+                v['dimension'][i] = dn
+    rout['args'].extend(extra_args)
+    need_interface = bool(extra_args)
+    
+    ret = ['']
+    def add(line,ret=ret):
+        ret[0] = '%s\n      %s'%(ret[0],line)
     name = rout['name']
-    outmess('\t\tCreating wrapper for Fortran function "%s"("%s")...\n'%(name,fortranname))
-    rout = copy.copy(rout)
-    fname = name
-    rname = fname
-    if 'result' in rout:
-        rname = rout['result']
-        rout['vars'][fname]=rout['vars'][rname]
-    fvar = rout['vars'][fname]
-    if not isintent_out(fvar):
-        if 'intent' not in fvar:
-            fvar['intent']=[]
-        fvar['intent'].append('out')
-        flag=1
-        for i in fvar['intent']:
-            if i.startswith('out='):
-                flag = 0
-                break
-        if flag:
-            fvar['intent'].append('out=%s' % (rname))
-
-    rout['args'] = [fname] + rout['args']
-    return rout,createfuncwrapper(rout)
+    fortranname = getfortranname(rout)
+    f90mode = ismoduleroutine(rout)
+
+    args = rout['args']
+
+    sargs = ', '.join(args)
+    if f90mode:
+        add('subroutine f2pywrap_%s_%s (%s)'%(rout['modulename'],name,sargs))
+        if not signature:
+            add('use %s, only : %s'%(rout['modulename'],fortranname))
+    else:
+        add('subroutine f2pywrap%s (%s)'%(name,sargs))
+        if not need_interface:
+            add('external %s'%(fortranname))
+
+    dumped_args = []
+    for a in args:
+        if isexternal(vars[a]):
+            add('external %s'%(a))
+            dumped_args.append(a)
+    for a in args:
+        if a in dumped_args: continue
+        if isscalar(vars[a]):
+            add(var2fixfortran(vars,a,f90mode=f90mode))
+            dumped_args.append(a)
+    for a in args:
+        if a in dumped_args: continue
+        add(var2fixfortran(vars,a,f90mode=f90mode))
+
+    if need_interface:
+        add('interface')
+        add(rout['saved_interface'].lstrip())
+        add('end interface')
+
+    sargs = ', '.join([a for a in args if a not in extra_args])
+
+    if not signature:
+        add('call %s(%s)'%(fortranname,sargs))
+    if f90mode:
+        add('end subroutine f2pywrap_%s_%s'%(rout['modulename'],name))
+    else:
+        add('end')
+    #print '**'*10
+    #print ret[0]
+    #print '**'*10
+    return ret[0]
+
+
+def assubr(rout):
+    if isfunction_wrap(rout):
+        fortranname = getfortranname(rout)
+        name = rout['name']
+        outmess('\t\tCreating wrapper for Fortran function "%s"("%s")...\n'%(name,fortranname))
+        rout = copy.copy(rout)
+        fname = name
+        rname = fname
+        if 'result' in rout:
+            rname = rout['result']
+            rout['vars'][fname]=rout['vars'][rname]
+        fvar = rout['vars'][fname]
+        if not isintent_out(fvar):
+            if 'intent' not in fvar:
+                fvar['intent']=[]
+            fvar['intent'].append('out')
+            flag=1
+            for i in fvar['intent']:
+                if i.startswith('out='):
+                    flag = 0
+                    break
+            if flag:
+                fvar['intent'].append('out=%s' % (rname))
 
+        rout['args'] = [fname] + rout['args']
+        return rout,createfuncwrapper(rout)
+    if issubroutine_wrap(rout):
+        fortranname = getfortranname(rout)
+        name = rout['name']
+        outmess('\t\tCreating wrapper for Fortran subroutine "%s"("%s")...\n'%(name,fortranname))
+        rout = copy.copy(rout)
+        return rout,createsubrwrapper(rout)
+    return rout,''
 
diff --git a/numpy/f2py/rules.py b/numpy/f2py/rules.py
index 62a80e25f..83f5811e5 100644
--- a/numpy/f2py/rules.py
+++ b/numpy/f2py/rules.py
@@ -408,7 +408,7 @@ rout_rules=[
         {isthreadsafe:'\t\t\tPy_END_ALLOW_THREADS'},
         {hasexternals:"""\t\t}"""}
          ],
-    '_check':issubroutine,
+    '_check':l_and(issubroutine,l_not(issubroutine_wrap)),
     },{ # Wrapped function
     'functype':'void',
     'declfortranroutine':{l_not(l_or(ismoduleroutine,isdummyroutine)):'extern void #F_WRAPPEDFUNC#(#name_lower#,#NAME#)(#callprotoargument#);',
@@ -444,6 +444,41 @@ rout_rules=[
     {hasexternals:'\t}'}
     ],
     '_check':isfunction_wrap,
+    },{ # Wrapped subroutine
+    'functype':'void',
+    'declfortranroutine':{l_not(l_or(ismoduleroutine,isdummyroutine)):'extern void #F_WRAPPEDFUNC#(#name_lower#,#NAME#)(#callprotoargument#);',
+                          isdummyroutine:'',
+                          },
+
+    'routine_def':{l_not(l_or(ismoduleroutine,isdummyroutine)):'\t{\"#name#\",-1,{{-1}},0,(char *)#F_WRAPPEDFUNC#(#name_lower#,#NAME#),(f2py_init_func)#apiname#,doc_#apiname#},',
+                   isdummyroutine:'\t{\"#name#\",-1,{{-1}},0,NULL,(f2py_init_func)#apiname#,doc_#apiname#},',
+                   },
+    'initf2pywraphook':{l_not(l_or(ismoduleroutine,isdummyroutine)):'''
+    {
+      extern void #F_FUNC#(#name_lower#,#NAME#)(void);
+      PyObject* o = PyDict_GetItemString(d,"#name#");
+      PyObject_SetAttrString(o,"_cpointer", F2PyCapsule_FromVoidPtr((void*)#F_FUNC#(#name_lower#,#NAME#),NULL));
+#if PY_VERSION_HEX >= 0x03000000
+      PyObject_SetAttrString(o,"__name__", PyUnicode_FromString("#name#"));
+#else
+      PyObject_SetAttrString(o,"__name__", PyString_FromString("#name#"));
+#endif
+    }
+    '''},
+    'need':{l_not(l_or(ismoduleroutine,isdummyroutine)):['F_WRAPPEDFUNC','F_FUNC']},
+    'callfortranroutine':[
+    {debugcapi:["""\tfprintf(stderr,\"debug-capi:Fortran subroutine `f2pywrap#name_lower#(#callfortran#)\'\\n\");"""]},
+    {hasexternals:"""\
+\tif (#setjmpbuf#) {
+\t\tf2py_success = 0;
+\t} else {"""},
+    {isthreadsafe:'\tPy_BEGIN_ALLOW_THREADS'},
+    {l_not(l_or(hascallstatement,isdummyroutine)):'\t(*f2py_func)(#callfortran#);'},
+    {hascallstatement:'\t#callstatement#;\n\t/*(*f2py_func)(#callfortran#);*/'},
+    {isthreadsafe:'\tPy_END_ALLOW_THREADS'},
+    {hasexternals:'\t}'}
+    ],
+    '_check':issubroutine_wrap,
     },{ # Function
     'functype':'#ctype#',
     'docreturn':{l_not(isintent_hide):'#rname#,'},
diff --git a/numpy/f2py/tests/src/assumed_shape/foo_free.f90 b/numpy/f2py/tests/src/assumed_shape/foo_free.f90
index 43c076f15..b301710f5 100644
--- a/numpy/f2py/tests/src/assumed_shape/foo_free.f90
+++ b/numpy/f2py/tests/src/assumed_shape/foo_free.f90
@@ -6,12 +6,12 @@ subroutine sum(x, res)
 
   integer :: i
 
-  print *, "sum: size(x) = ", size(x)
+  !print *, "sum: size(x) = ", size(x)
 
   res = 0.0
 
   do i = 1, size(x)
-    res = x(i)
+    res = res + x(i)
   enddo
 
 end subroutine sum
@@ -23,7 +23,7 @@ function fsum(x) result (res)
 
   integer :: i
 
-  print *, "fsum: size(x) = ", size(x)
+  !print *, "fsum: size(x) = ", size(x)
 
   res = 0.0
 
diff --git a/numpy/f2py/tests/test_assumed_shape.py b/numpy/f2py/tests/test_assumed_shape.py
index 5784c54f9..6a562ebdc 100644
--- a/numpy/f2py/tests/test_assumed_shape.py
+++ b/numpy/f2py/tests/test_assumed_shape.py
@@ -17,8 +17,8 @@ class TestMixed(util.F2PyTest):
         print self.module.__doc__
         r = self.module.fsum([1,2])
         assert r==3,`r`
-        #r = self.module.sum([1,2])
-        #assert r==3,`r`
+        r = self.module.sum([1,2])
+        assert r==3,`r`
 
 if __name__ == "__main__":
     import nose