Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fortran oo support with unittest #243

Merged
merged 6 commits into from
Jan 7, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/build-wheels.yml
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ jobs:
matrix:
buildplat:
- [ubuntu-latest, manylinux, x86_64]
- [macos-latest, macosx, x86_64]
- [macos-13, macosx, x86_64]
- [windows-latest, win, AMD64]
- [macos-latest, macosx, arm64]

Expand Down
3 changes: 1 addition & 2 deletions examples/fortran_oo/Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,6 @@ F2PY = f2py-f90wrap
.PHONY: all clean

all: test

clean:
rm -rf *.mod *.smod *.o f90wrap*.f90 ${PY_MOD}.py _${PY_MOD}*.so __pycache__/ .f2py_f2cmap build ${PY_MOD}/

Expand All @@ -35,4 +34,4 @@ f2py: ${F90WRAP_SRC}
CFLAGS="${CFLAGS}" ${F2PY} -c -m _${PY_MOD} ${F2PYFLAGS} f90wrap_*.f90 *.o

test: f2py
pytest
${PYTHON} oowrap_test.py
2 changes: 1 addition & 1 deletion examples/fortran_oo/Makefile.meson
Original file line number Diff line number Diff line change
Expand Up @@ -4,4 +4,4 @@ NAME := pywrapper
WRAPFLAGS += --type-check --kind-map kind.map

test: build
$(PYTHON) tests.py
$(PYTHON) oowrap_test.py
39 changes: 19 additions & 20 deletions examples/fortran_oo/main-oo.f90
Original file line number Diff line number Diff line change
Expand Up @@ -2,11 +2,11 @@ module m_geometry
use m_base_poly, only : Polygone
implicit none
private
real(kind=8) :: pi = 3.1415926535897931d0 ! Class-wide private constant
real(kind=8), parameter :: pi = atan(1.d0)*4.0d0 ! Class-wide private constant

type, public, abstract, extends(Polygone) :: Rectangle
real :: length
real :: width
real(kind=8) :: length
real(kind=8) :: width
contains
procedure :: perimeter => rectangle_perimeter
procedure :: is_square => rectangle_is_square
Expand All @@ -20,8 +20,9 @@ module m_geometry
end type Square

abstract interface
function abstract_area(this)
function abstract_area(this) result(area)
import Rectangle
real(kind=8) :: area
class(Rectangle), intent(in) :: this
end function abstract_area
end interface
Expand All @@ -31,7 +32,7 @@ end function abstract_area
end interface Square

type, public :: Circle
real :: radius
real(kind=8) :: radius
contains
procedure :: area => circle_area
procedure :: print => circle_print
Expand Down Expand Up @@ -88,31 +89,31 @@ end function construct_ball

function get_circle_radius(my_circle) result(radius)
class(Circle), intent(in) :: my_circle
real :: radius
real(kind=8) :: radius
radius = my_circle%radius
end function get_circle_radius

function get_ball_radius(my_ball) result(radius)
class(Ball), intent(in) :: my_ball
real :: radius
real(kind=8) :: radius
radius = my_ball%radius
end function get_ball_radius

function circle_area(this) result(area)
class(Circle), intent(in) :: this
real :: area
real(kind=8) :: area
area = pi * this%radius**2
end function circle_area

subroutine circle_print(this)
class(Circle), intent(in) :: this
real :: area
real(kind=8) :: area
area = this%area() ! Call the type-bound function
end subroutine circle_print

subroutine circle_obj_name(obj)
class(Circle), intent(in) :: obj
real :: area
real(kind=8) :: area
area = obj%area() ! Call the type-bound function
end subroutine circle_obj_name

Expand All @@ -132,14 +133,14 @@ end subroutine circle_free

function ball_area(this) result(area)
class(Ball), intent(in) :: this
real :: area
area = 4. * pi * this%radius**2
real(kind=8) :: area
area = 4.0d0 * pi * this%radius**2
end function ball_area

function ball_volume(this) result(volume)
class(Ball), intent(in) :: this
real :: volume
volume = 4./3. * pi * this%radius**3
real(kind=8) :: volume
volume = 4.0d0/3.0d0 * pi * this%radius**3
end function ball_volume

subroutine ball_private(this)
Expand All @@ -150,25 +151,25 @@ function circle_perimeter_4(this, radius) result(perimeter)
class(Circle), intent(in) :: this
real(kind=4), intent(in) :: radius
real(kind=4) :: perimeter
perimeter = 2. * pi * radius
perimeter = 2.0 * pi * radius
end function circle_perimeter_4

function circle_perimeter_8(this, radius) result(perimeter)
class(Circle), intent(in) :: this
real(kind=8), intent(in) :: radius
real(kind=8) :: perimeter
perimeter = 2. * pi * radius
perimeter = 2.0d0 * pi * radius
end function circle_perimeter_8

function rectangle_perimeter(this) result(perimeter)
class(Rectangle), intent(in) :: this
real :: perimeter
real(kind=8) :: perimeter
perimeter = 2*this%length + 2*this%width
end function rectangle_perimeter

function square_area(this) result(area)
class(Square), intent(in) :: this
real :: area
real(kind=8) :: area
area = this%length * this%length
end function square_area

Expand All @@ -185,5 +186,3 @@ function square_is_square(this) result(is_square)
end function square_is_square

end module m_geometry


Loading
Loading