Skip to content

Commit

Permalink
add bitset support
Browse files Browse the repository at this point in the history
  • Loading branch information
jalvesz committed Sep 11, 2024
1 parent 6a30b2f commit 1993d62
Show file tree
Hide file tree
Showing 4 changed files with 68 additions and 4 deletions.
4 changes: 2 additions & 2 deletions doc/specs/stdlib_math.md
Original file line number Diff line number Diff line change
Expand Up @@ -82,8 +82,8 @@ Elemental subroutine.

#### Argument(s)

`lhs`: scalar or array of any of the intrinsic types `integer`, `real`, `complex`, `logical`, `character`, `string_type` type. This argument is `intent(inout)`.
`rhs`: scalar or array of any of the intrinsic types `integer`, `real`, `complex`, `logical`, `character`, `string_type` type. This argument is `intent(inout)`.
`lhs`: scalar or array of any of the intrinsic types `integer`, `real`, `complex`, `logical`, `character`, `string_type`, `bitset` type. This argument is `intent(inout)`.
`rhs`: scalar or array of any of the intrinsic types `integer`, `real`, `complex`, `logical`, `character`, `string_type`, `bitset` type. This argument is `intent(inout)`.

Note: All arguments must have same `type` and same `kind`.

Expand Down
8 changes: 8 additions & 0 deletions example/math/example_math_swap.f90
Original file line number Diff line number Diff line change
Expand Up @@ -38,4 +38,12 @@ program example_math_swap
call swap(x,y)
end block

block
use stdlib_bitsets
type(bitset_64) :: x, y
call x%from_string('0000')
call y%from_string('1111')
call swap(x,y)
end block

end program example_math_swap
14 changes: 12 additions & 2 deletions src/stdlib_math.fypp
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
#:include "common.fypp"
#:set IR_KINDS_TYPES = INT_KINDS_TYPES + REAL_KINDS_TYPES
#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES

#:set BITSET_KINDS_TYPES = list(zip(BITSET_KINDS, BITSET_TYPES))
module stdlib_math
use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp
use stdlib_optval, only: optval
Expand Down Expand Up @@ -47,7 +47,7 @@ module stdlib_math
!>
!> Version: experimental
interface swap
#:for k1, t1 in INT_KINDS_TYPES + REAL_KINDS_TYPES
#:for k1, t1 in INT_KINDS_TYPES + REAL_KINDS_TYPES + BITSET_KINDS_TYPES
module procedure :: swap_${k1}$
#:endfor
#:for k1, t1 in CMPLX_KINDS_TYPES
Expand Down Expand Up @@ -562,5 +562,15 @@ contains
type(string_type) :: temp
temp = lhs ; lhs = rhs ; rhs = temp
end subroutine

#:for k1, t1 in BITSET_KINDS_TYPES
elemental subroutine swap_${k1}$(lhs,rhs)
use stdlib_bitsets
${t1}$, intent(inout) :: lhs, rhs
${t1}$ :: temp
temp = lhs ; lhs = rhs ; rhs = temp
end subroutine

#:endfor

end module stdlib_math
46 changes: 46 additions & 0 deletions test/math/test_stdlib_math.fypp
Original file line number Diff line number Diff line change
Expand Up @@ -345,6 +345,52 @@ contains
if (allocated(error)) return
end subroutine test_swap_stt

subroutine test_swap_bitset_64(error)
use stdlib_bitsets
type(error_type), allocatable, intent(out) :: error
type(bitset_64) :: x, y, u, v

x = [.true.,.false.,.true.,.false.]
u = x
y = [.false.,.true.,.false.,.true.]
v = y
call swap(x,y)

call check(error, x == v )
if (allocated(error)) return
call check(error, y == u )
if (allocated(error)) return

! check self swap
call swap(x,x)

call check(error, x == v )
if (allocated(error)) return
end subroutine test_swap_bitset_64

subroutine test_swap_bitset_large(error)
use stdlib_bitsets
type(error_type), allocatable, intent(out) :: error
type(bitset_large) :: x, y, u, v

x = [.true.,.false.,.true.,.false.]
u = x
y = [.false.,.true.,.false.,.true.]
v = y
call swap(x,y)

call check(error, x == v )
if (allocated(error)) return
call check(error, y == u )
if (allocated(error)) return

! check self swap
call swap(x,x)

call check(error, x == v )
if (allocated(error)) return
end subroutine test_swap_bitset_large

#:for k1 in CMPLX_KINDS
subroutine test_arg_${k1}$(error)
type(error_type), allocatable, intent(out) :: error
Expand Down

0 comments on commit 1993d62

Please sign in to comment.