Skip to content

Commit 20a15e5

Browse files
wclodius2wclodius2
committed
Numerous changes suggested by Jeremie
Jeremie suggested numerous changes. I implemented most of them. [ticket: X]
1 parent 523dbc6 commit 20a15e5

File tree

2 files changed

+89
-37
lines changed

2 files changed

+89
-37
lines changed

‎src/tests/bitsets/test_stdlib_bitset_64.f90‎

Lines changed: 42 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -28,9 +28,8 @@ program test_stdlib_bitset_64
2828
subroutine test_string_operations()
2929
character(*), parameter:: procedure = 'TEST_STRING_OPERATIONS'
3030

31-
write(*,*)
32-
write(*,*) 'Test string operations: from_string, read_bitset, ' // &
33-
'to_string, and write_bitset'
31+
write(*,'(/a)') 'Test string operations: from_string, ' // &
32+
'read_bitset, to_string, and write_bitset'
3433

3534
call set0 % from_string( bitstring_0 )
3635
if ( bits(set0) /= 33 ) then
@@ -67,6 +66,9 @@ subroutine test_string_operations()
6766
call set3 % read_bitset( bitstring_0, status )
6867
if ( status /= success ) then
6968
write(*,*) 'read_bitset_string failed with bitstring_0 as expected.'
69+
else
70+
error stop procedure // ' read_bitset_string did not fail ' // &
71+
'with bitstring_0 as expected.'
7072
end if
7173

7274
call set3 % read_bitset( 's33b' // bitstring_0, status )
@@ -209,6 +211,27 @@ subroutine test_io()
209211
'output and input succeeded.'
210212
end if
211213

214+
open( newunit=unit, file='test.bin', status='replace', &
215+
form='unformatted', access='stream', action='write' )
216+
call set2 % output(unit)
217+
call set1 % output(unit)
218+
call set0 % output(unit)
219+
close( unit )
220+
open( newunit=unit, file='test.bin', status='old', &
221+
form='unformatted', access='stream', action='read' )
222+
call set5 % input(unit)
223+
call set4 % input(unit)
224+
call set3 % input(unit)
225+
close( unit )
226+
227+
if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
228+
error stop procedure // ' transfer to and from units using ' // &
229+
' stream output and input failed.'
230+
else
231+
write(*,*) 'Transfer to and from units using ' // &
232+
'stream output and input succeeded.'
233+
end if
234+
212235
end subroutine test_io
213236

214237
subroutine test_initialization()
@@ -404,56 +427,41 @@ subroutine test_bitset_inquiry()
404427

405428
call set0 % not()
406429
do i=0, set0 % bits() - 1
407-
if ( set0 % test(i) ) go to 100
430+
if ( set0 % test(i) ) then
431+
error stop procedure // ' against expectations set0 has ' // &
432+
'at least 1 bit set.'
433+
end if
408434
end do
409435

410436
write(*,*) 'As expected set0 had no bits set.'
411437

412-
go to 110
413-
414-
100 error stop procedure // ' against expectations set0 has ' // &
415-
'at least 1 bit set.'
416-
417-
110 continue
418-
419438
do i=0, set1 % bits() - 1
420-
if ( .not. set1 % test(i) ) go to 200
439+
if ( .not. set1 % test(i) ) then
440+
error stop procedure // ' against expectations set1 has ' // &
441+
'at least 1 bit unset.'
442+
end if
421443
end do
422444

423445
write(*,*) 'As expected set1 had all bits set.'
424446

425-
go to 210
426-
427-
200 error stop procedure // ' against expectations set1 has ' // &
428-
'at least 1 bit unset.'
429-
210 continue
430-
431447
do i=0, set0 % bits() - 1
432-
if ( set0 % value(i) /= 0 ) go to 300
448+
if ( set0 % value(i) /= 0 ) then
449+
error stop procedure // ' against expectations set0 has ' // &
450+
'at least 1 bit set.'
451+
end if
433452
end do
434453

435454
write(*,*) 'As expected set0 had no bits set.'
436455

437-
go to 310
438-
439-
300 error stop procedure // ' against expectations set0 has ' // &
440-
'at least 1 bit set.'
441-
442-
310 continue
443-
444456
do i=0, set1 % bits() - 1
445-
if ( set1 % value(i) /= 1 ) go to 400
457+
if ( set1 % value(i) /= 1 ) then
458+
error stop procedure // ' against expectations set1 has ' // &
459+
'at least 1 bit unset.'
460+
end if
446461
end do
447462

448463
write(*,*) 'As expected set1 had all bits set.'
449464

450-
go to 410
451-
452-
400 error stop procedure // ' against expectations set1 has ' // &
453-
'at least 1 bit unset.'
454-
455-
410 continue
456-
457465
if ( set0 % bits() == 33 ) then
458466
write(*,*) 'set0 has 33 bits as expected.'
459467
else

‎src/tests/bitsets/test_stdlib_bitset_large.f90‎

Lines changed: 47 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -30,9 +30,8 @@ program test_stdlib_bitset_large
3030
subroutine test_string_operations()
3131
character(*), parameter:: procedure = 'TEST_STRING_OPERATIONS'
3232

33-
write(*,*)
34-
write(*,*) 'Test string operations: from_string, read_bitset, ' // &
35-
'to_string, and write_bitset'
33+
write(*,'(/a)') 'Test string operations: from_string, ' // &
34+
'read_bitset, to_string, and write_bitset'
3635

3736
call set0 % from_string( bitstring_0 )
3837
if ( bits(set0) /= 33 ) then
@@ -101,6 +100,9 @@ subroutine test_string_operations()
101100
call set3 % read_bitset( bitstring_0, status )
102101
if ( status /= success ) then
103102
write(*,*) 'read_bitset_string failed with bitstring_0 as expected.'
103+
else
104+
error stop procedure // ' read_bitset_string did not fail ' // &
105+
'with bitstring_0 as expected.'
104106
end if
105107

106108
call set13 % read_bitset( bitstring_0 // bitstring_0, status )
@@ -358,6 +360,27 @@ subroutine test_io()
358360

359361
close( unit )
360362

363+
open( newunit=unit, file='test.bin', status='replace', &
364+
form='unformatted', access='stream', action='write' )
365+
call set2 % output(unit)
366+
call set1 % output(unit)
367+
call set0 % output(unit)
368+
close( unit )
369+
open( newunit=unit, file='test.bin', status='old', &
370+
form='unformatted', access='stream', action='read' )
371+
call set5 % input(unit)
372+
call set4 % input(unit)
373+
call set3 % input(unit)
374+
if ( set3 /= set0 .or. set4 /= set1 .or. set5 /= set2 ) then
375+
error stop procedure // ' transfer to and from units using ' // &
376+
' stream output and input failed.'
377+
else
378+
write(*,*) 'Transfer to and from units using ' // &
379+
'stream output and input succeeded.'
380+
end if
381+
382+
close( unit )
383+
361384
open( newunit=unit, file='test.bin', status='replace', &
362385
form='unformatted', action='write' )
363386
call set12 % output(unit)
@@ -376,6 +399,27 @@ subroutine test_io()
376399
write(*,*) 'Transfer to and from units using ' // &
377400
'output and input succeeded for bits > 64.'
378401
end if
402+
close(unit)
403+
404+
open( newunit=unit, file='test.bin', status='replace', &
405+
form='unformatted', access='stream', action='write' )
406+
call set12 % output(unit)
407+
call set11 % output(unit)
408+
call set10 % output(unit)
409+
close( unit )
410+
open( newunit=unit, file='test.bin', status='old', &
411+
form='unformatted', access='stream', action='read' )
412+
call set15 % input(unit)
413+
call set14 % input(unit)
414+
call set13 % input(unit)
415+
if ( set13 /= set10 .or. set14 /= set11 .or. set15 /= set12 ) then
416+
error stop procedure // ' transfer to and from units using ' // &
417+
' stream output and input failed for bits . 64.'
418+
else
419+
write(*,*) 'Transfer to and from units using ' // &
420+
'stream output and input succeeded for bits > 64.'
421+
end if
422+
close(unit)
379423

380424
end subroutine test_io
381425

0 commit comments

Comments
 (0)