Abstract classes

examples/issue206_subroutine_oldstyle/Makefile

@@ -8,8 +8,7 @@ PYTHON = python
 
 all: subroutine_oldstyle.o
 	f90wrap -m itest -P subroutine_oldstyle.f -v
-	f2py-f90wrap --fcompiler=$(FC) --build-dir . -c -m _itest f90wrap_toplevel.f90 \
-		subroutine_oldstyle.o
+	f2py-f90wrap --build-dir . -c -m _itest f90wrap_toplevel.f90 subroutine_oldstyle.o
 
 test: all
 	$(PYTHON) run.py

examples/issue41_abstract_classes/Makefile

@@ -0,0 +1,26 @@
+FC = gfortran
+FCFLAGS = -fPIC
+PYTHON = python
+
+all: wrapper test_abstract_classes.x
+
+test: wrapper
+	$(PYTHON) run.py
+
+test_abstract_classes.x: main.f90 myclass_base.o myclass_impl.o myclass_impl2.o myclass_factory.o
+	$(FC) $(FCFLAGS) -o $@ $^
+
+wrapper: myclass_base.o myclass_impl.o myclass_impl2.o myclass_factory.o
+	f90wrap -m itest -P myclass_base.f90 myclass_impl.f90 myclass_impl2.f90 myclass_factory.f90 -v
+	f2py-f90wrap --build-dir . -c -m _itest --opt="-O0 -g" \
+		f90wrap_myclass_base.f90 f90wrap_myclass_impl.f90 f90wrap_myclass_impl2.f90 f90wrap_myclass_factory.f90 \
+		myclass_base.o myclass_impl.o myclass_impl2.o myclass_factory.o
+
+%.o : %.f90
+	$(FC) $(FCFLAGS) -c -g -O0 $< -o $@
+
+clean:
+	rm -f *.o f90wrap*.f90 *.so *.mod *.x
+	rm -rf src.*/
+	rm -rf itest/
+	-rm -rf src.*/ .f2py_f2cmap .libs/ __pycache__/

examples/issue41_abstract_classes/Makefile.meson

@@ -0,0 +1,6 @@
+include ../make.meson.inc
+
+NAME     := itest
+
+test: build
+	$(PYTHON) run.py

examples/issue41_abstract_classes/main.f90

@@ -0,0 +1,24 @@
+program main
+    use myclass_factory, only: create_myclass
+    use myclass_base, only: myclass_t
+    implicit none
+
+    print *, "Start"
+
+    call test()
+
+    print *, "Done"
+
+contains
+
+subroutine test
+    real :: x
+    class(myclass_t), allocatable :: myobject
+
+    myobject = create_myclass("impl")
+    call myobject%get_value(x)
+
+    print *, "Value: ", x
+end subroutine test
+
+end program main

examples/issue41_abstract_classes/myclass_base.f90

@@ -0,0 +1,17 @@
+module myclass_base
+implicit none
+
+type, abstract :: myclass_t
+contains
+    procedure(get_value_i), deferred :: get_value
+end type myclass_t
+
+abstract interface
+    subroutine get_value_i(self, value)
+        import myclass_t
+        class(myclass_t), intent(in) :: self
+        real, intent(out) :: value
+    end subroutine get_value_i
+end interface
+
+end module myclass_base

examples/issue41_abstract_classes/myclass_factory.f90

@@ -0,0 +1,26 @@
+module myclass_factory
+
+use myclass_base, only: myclass_t
+use myclass_impl, only: myclass_impl_t
+use myclass_impl2, only: myclass_impl2_t
+implicit none
+
+contains
+
+function create_myclass(impl_type) result(myobject)
+    class(myclass_t), allocatable :: myobject
+
+    character(*), intent(in) :: impl_type
+
+    select case(impl_type)
+        case("impl")
+            allocate(myclass_impl_t :: myobject)
+        case("impl2")
+            allocate(myclass_impl2_t :: myobject)
+        case default
+            print *, "create_field_can: Unknown implementation: ", impl_type
+            error stop
+    end select
+end function create_myclass
+
+end module myclass_factory

examples/issue41_abstract_classes/myclass_impl.f90

@@ -0,0 +1,27 @@
+module myclass_impl
+
+use myclass_base, only: myclass_t
+implicit none
+
+type, extends(myclass_t) :: myclass_impl_t
+contains
+    procedure :: get_value => get_value_impl
+    final :: myclass_impl_destroy
+end type myclass_impl_t
+
+contains
+
+subroutine get_value_impl(self, value)
+    class(myclass_impl_t), intent(in) :: self
+    real, intent(out) :: value
+
+    value = 1.0
+end subroutine get_value_impl
+
+subroutine myclass_impl_destroy(self)
+    type(myclass_impl_t), intent(inout) :: self
+
+    print *, "Finalising myclass_impl_t"
+end subroutine myclass_impl_destroy
+
+end module myclass_impl

examples/issue41_abstract_classes/myclass_impl2.f90

@@ -0,0 +1,27 @@
+module myclass_impl2
+
+use myclass_base, only: myclass_t
+implicit none
+
+type, extends(myclass_t) :: myclass_impl2_t
+contains
+    procedure :: get_value => get_value_impl2
+    final :: myclass_impl2_destroy
+end type myclass_impl2_t
+
+contains
+
+subroutine get_value_impl2(self, value)
+    class(myclass_impl2_t), intent(in) :: self
+    real, intent(out) :: value
+
+    value = 2.0
+end subroutine get_value_impl2
+
+subroutine myclass_impl2_destroy(self)
+    type(myclass_impl2_t), intent(inout) :: self
+
+    print *, "Finalising myclass_impl2_t"
+end subroutine myclass_impl2_destroy
+
+end module myclass_impl2

examples/issue41_abstract_classes/run.py

@@ -0,0 +1,19 @@
+#!/usr/bin/env python
+import itest
+
+REF = 1.0
+TOL = 1.0e-6
+
+obj = itest.myclass_factory.create_myclass("impl")
+
+output = obj.get_value()
+assert(abs(output-REF)<TOL)
+print(f"OK: {output} == {REF}")
+
+del obj
+
+REF2 = 2.0
+obj2 = itest.myclass_factory.create_myclass("impl2")
+output2 = obj2.get_value()
+assert(abs(output-REF)<TOL)
+print(f"OK: {output2} == {REF2}")

examples/issue41_abstract_classes/test_parser_abstract_iface.py

@@ -0,0 +1,50 @@
+import unittest
+
+from io import StringIO
+import f90wrap.parser
+from f90wrap.parser import check_abstract_interface
+
+f90wrap.parser.doc_plugin_module = None
+
+class MockF90File:
+    def __init__(self, lines):
+        self.filename = 'mock_file.f90'
+        self.lineno = 4
+        self.lines = StringIO(lines)
+
+    def next(self):
+        self.lineno += 1
+        return self.lines.readline().strip()
+
+    def close(self):
+        pass
+
+class TestParserAbstractInterface(unittest.TestCase):
+    def test_check_abstract_interface(self):
+        lines = """
+        abstract interface
+            subroutine get_value_i(value)
+                real, intent(out) :: value
+            end subroutine get_value_i
+            real function f(x)
+                real, intent(in) :: x
+            end function f
+            subroutine no_args
+            end subroutine no_args
+        end interface
+        """.strip()
+        f90file = MockF90File(lines)
+        check = check_abstract_interface(f90file.next(), f90file)
+        interface = check[0]
+        current_line = check[1]
+        assert current_line == ''
+        assert interface is not None
+        assert 'abstract' in interface.attributes
+        assert len(interface.procedures) == 3
+        assert interface.procedures[0].name == 'get_value_i'
+        assert interface.procedures[1].name == 'f'
+        assert interface.procedures[2].name == 'no_args'
+
+
+if __name__ == '__main__':
+    unittest.main()

f90wrap/f90wrapgen.py

@@ -514,6 +514,9 @@ def visit_Procedure(self, node):
         """
         Write wrapper code necessary for a Fortran subroutine or function
         """
+        if "abstract" in node.attributes and not "method" in node.attributes:
+            return
+
         call_name = node.orig_name
         if hasattr(node, "call_name"):
             call_name = node.call_name