numpy · charris · Nov 16, 2024 · Nov 9, 2024 · Nov 9, 2024 · Nov 9, 2024
diff --git a/doc/source/f2py/python-usage.rst b/doc/source/f2py/python-usage.rst
@@ -243,6 +243,13 @@ In Python:
 .. literalinclude:: ./code/results/extcallback_session.dat
   :language: python
 
+.. note::
+
+   When using modified Fortran code via ``callstatement`` or other directives,
+   the wrapped Python function must be called as a callback, otherwise only the
+   bare Fortran routine will be used. For more details, see
+   https://github.com/numpy/numpy/issues/26681#issuecomment-2466460943
+
 Resolving arguments to call-back functions
 ------------------------------------------
 

diff --git a/numpy/f2py/crackfortran.py b/numpy/f2py/crackfortran.py
@@ -425,11 +425,14 @@ def readfortrancode(ffile, dowithline=show, istop=1):
             if l[-1] not in "\n\r\f":
                 break
             l = l[:-1]
+        # Do not lower for directives, gh-2547, gh-27697, gh-26681
+        is_f2py_directive = False
         # Unconditionally remove comments
         (l, rl) = split_by_unquoted(l, '!')
         l += ' '
         if rl[:5].lower() == '!f2py':  # f2py directive
             l, _ = split_by_unquoted(l + 4 * ' ' + rl[5:], '!')
+            is_f2py_directive = True
         if l.strip() == '':  # Skip empty line
             if sourcecodeform == 'free':
                 # In free form, a statement continues in the next line
@@ -449,8 +452,10 @@ def readfortrancode(ffile, dowithline=show, istop=1):
             if l[0] in ['*', 'c', '!', 'C', '#']:
                 if l[1:5].lower() == 'f2py':  # f2py directive
                     l = '     ' + l[5:]
+                    is_f2py_directive = True
                 else:  # Skip comment line
                     cont = False
+                    is_f2py_directive = False
                     continue
             elif strictf77:
                 if len(l) > 72:
@@ -476,6 +481,7 @@ def readfortrancode(ffile, dowithline=show, istop=1):
                 else:
                     # clean up line beginning from possible digits.
                     l = '     ' + l[5:]
+                    # f2py directives are already stripped by this point
                     if localdolowercase:
                         finalline = ll.lower()
                     else:
@@ -505,7 +511,11 @@ def readfortrancode(ffile, dowithline=show, istop=1):
                 origfinalline = ''
             else:
                 if localdolowercase:
-                    finalline = ll.lower()
+                    # lines with intent() should be lowered otherwise
+                    # TestString::test_char fails due to mixed case
+                    # f2py directives without intent() should be left untouched
+                    # gh-2547, gh-27697, gh-26681
+                    finalline = ll.lower() if "intent" in ll.lower() or not is_f2py_directive else ll
                 else:
                     finalline = ll
                 origfinalline = ll
@@ -537,6 +547,7 @@ def readfortrancode(ffile, dowithline=show, istop=1):
         else:
             dowithline(finalline)
         l1 = ll
+    # Last line should never have an f2py directive anyway
     if localdolowercase:
         finalline = ll.lower()
     else:

diff --git a/numpy/f2py/tests/src/callback/gh26681.f90 b/numpy/f2py/tests/src/callback/gh26681.f90
@@ -0,0 +1,18 @@
+module utils
+    implicit none
+  contains
+    subroutine my_abort(message)
+      implicit none
+      character(len=*), intent(in) :: message
+      !f2py callstatement PyErr_SetString(PyExc_ValueError, message);f2py_success = 0;
+      !f2py callprotoargument char*
+      write(0,*) "THIS SHOULD NOT APPEAR"
+      stop 1
+    end subroutine my_abort
+
+    subroutine do_something(message)
+        !f2py    intent(callback, hide) mypy_abort
+        character(len=*), intent(in) :: message
+        call mypy_abort(message)
+    end subroutine do_something
+end module utils
diff --git a/numpy/f2py/tests/src/crackfortran/gh27697.f90 b/numpy/f2py/tests/src/crackfortran/gh27697.f90
@@ -0,0 +1,12 @@
+module utils
+    implicit none
+  contains
+    subroutine my_abort(message)
+      implicit none
+      character(len=*), intent(in) :: message
+      !f2py callstatement PyErr_SetString(PyExc_ValueError, message);f2py_success = 0;
+      !f2py callprotoargument char*
+      write(0,*) "THIS SHOULD NOT APPEAR"
+      stop 1
+    end subroutine my_abort
+end module utils
diff --git a/numpy/f2py/tests/test_callback.py b/numpy/f2py/tests/test_callback.py
@@ -5,6 +5,7 @@
 import threading
 import traceback
 import time
+import platform
 
 import numpy as np
 from numpy.testing import IS_PYPY
@@ -244,3 +245,17 @@ def bar(x):
 
         res = self.module.foo(bar)
         assert res == 110
+
+
+@pytest.mark.slow
+@pytest.mark.xfail(condition=(platform.system().lower() == 'darwin'),
+                   run=False,
+                   reason="Callback aborts cause CI failures on macOS")
+class TestCBFortranCallstatement(util.F2PyTest):
+    sources = [util.getpath("tests", "src", "callback", "gh26681.f90")]
+    options = ['--lower']
+
+    def test_callstatement_fortran(self):
+        with pytest.raises(ValueError, match='helpme') as exc:
+            self.module.mypy_abort = self.module.utils.my_abort
+            self.module.utils.do_something('helpme')
diff --git a/numpy/f2py/tests/test_crackfortran.py b/numpy/f2py/tests/test_crackfortran.py
@@ -403,3 +403,12 @@ def test_param_eval_too_many_dims(self):
         dimspec = '(0:4, 3:12, 5)'
         pytest.raises(ValueError, crackfortran.param_eval, v, g_params, params,
                       dimspec=dimspec)
+
+@pytest.mark.slow
+class TestLowerF2PYDirective(util.F2PyTest):
+    sources = [util.getpath("tests", "src", "crackfortran", "gh27697.f90")]
+    options = ['--lower']
+
+    def test_no_lower_fail(self):
+        with pytest.raises(ValueError, match='aborting directly') as exc:
+            self.module.utils.my_abort('aborting directly')