Skip to content

Commit 1905c80

Browse files
committed
Merge branch 'pullreq_727' into support-sorting-bitsets
2 parents 7d6d979 + 96763e1 commit 1905c80

File tree

2 files changed

+48
-1
lines changed

2 files changed

+48
-1
lines changed

README.md

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -199,6 +199,14 @@ To use `stdlib` within your `fpm` project, add the following lines to your `fpm.
199199
stdlib = { git="https://github.com/fortran-lang/stdlib", branch="stdlib-fpm" }
200200
```
201201

202+
> **Warning**
203+
>
204+
> Fpm 0.9.0 and later implements stdlib as a *metapackage*.
205+
> To include the standard library metapackage, change the dependency to:
206+
> `stdlib = "*"`.
207+
>
208+
> [see also](https://fpm.fortran-lang.org/en/spec/metapackages.html)
209+
202210
## Using stdlib in your project
203211

204212
The stdlib project exports CMake package files and pkg-config files to make stdlib usable for other projects.

test/bitsets/test_stdlib_bitset_large.f90

Lines changed: 40 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,15 @@
11
module test_stdlib_bitset_large
22
use testdrive, only : new_unittest, unittest_type, error_type, check
33
use :: stdlib_kinds, only : int8, int16, int32, int64
4-
use stdlib_bitsets
4+
use stdlib_bitsets, only: bitset_large, bits_kind&
5+
, bits &
6+
, success &
7+
, and, and_not, or, xor&
8+
, extract&
9+
, assignment(=)&
10+
, operator(<), operator(<=)&
11+
, operator(>), operator(>=)&
12+
, operator(/=), operator(==)
513
implicit none
614
character(*), parameter :: &
715
bitstring_0 = '000000000000000000000000000000000', &
@@ -20,6 +28,7 @@ subroutine collect_stdlib_bitset_large(testsuite)
2028
new_unittest("string-operations", test_string_operations), &
2129
new_unittest("io", test_io), &
2230
new_unittest("initialization", test_initialization), &
31+
new_unittest("bitset-assignment-array", test_assignment_array), &
2332
new_unittest("bitset-inquiry", test_bitset_inquiry), &
2433
new_unittest("bit-operations", test_bit_operations), &
2534
new_unittest("bitset-comparisons", test_bitset_comparisons), &
@@ -550,6 +559,36 @@ subroutine test_initialization(error)
550559

551560
end subroutine test_initialization
552561

562+
subroutine test_assignment_array(error)
563+
!> Error handling
564+
type(error_type), allocatable, intent(out) :: error
565+
566+
logical(int8) :: log1(64) = .true.
567+
568+
integer :: i
569+
type(bitset_large) :: set1(0:4)
570+
571+
do i = 0, size(set1) - 1
572+
set1(i) = log1
573+
enddo
574+
575+
do i = 0, size(set1) - 1
576+
call check(error, set1(i) % bits(), 64, &
577+
' initialization with logical(int8) failed to set' // &
578+
' the right size in a bitset array.')
579+
if (allocated(error)) return
580+
enddo
581+
582+
!Test added following issue https://github.com/fortran-lang/stdlib/issues/726
583+
set1(0) = set1(0)
584+
585+
call check(error, set1(0) % bits(), 64, &
586+
' initialization from bitset_large failed to set' // &
587+
' the right size in a bitset array.')
588+
if (allocated(error)) return
589+
590+
end subroutine test_assignment_array
591+
553592
subroutine test_bitset_inquiry(error)
554593
!> Error handling
555594
type(error_type), allocatable, intent(out) :: error

0 commit comments

Comments
 (0)