1
1
module test_os
2
2
use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test
3
- use stdlib_system, only: get_runtime_os, OS_WINDOWS, OS_UNKNOWN, OS_TYPE, is_windows
3
+ use stdlib_system, only: get_runtime_os, OS_WINDOWS, OS_UNKNOWN, OS_TYPE, is_windows, null_device
4
4
5
5
implicit none
6
6
@@ -13,7 +13,8 @@ subroutine collect_suite(testsuite)
13
13
14
14
testsuite = [ &
15
15
new_unittest(' test_get_runtime_os' , test_get_runtime_os), &
16
- new_unittest(' test_is_windows' , test_is_windows) &
16
+ new_unittest(' test_is_windows' , test_is_windows), &
17
+ new_unittest(' test_null_device' , test_null_device) &
17
18
]
18
19
end subroutine collect_suite
19
20
@@ -38,6 +39,26 @@ subroutine test_is_windows(error)
38
39
39
40
end subroutine test_is_windows
40
41
42
+ ! > Test that the null_device is valid by writing something to it
43
+ subroutine test_null_device (error )
44
+ type (error_type), allocatable , intent (out ) :: error
45
+ integer :: unit, ios
46
+ character (len= 512 ) :: iomsg
47
+
48
+ ! Try opening the null device for writing
49
+ open (newunit= unit, file= null_device(), status= ' old' , action= ' write' , iostat= ios, iomsg= iomsg)
50
+ call check(error, ios== 0 , ' Cannot open null_device unit: ' // trim (iomsg))
51
+ if (allocated (error)) return
52
+
53
+ write (unit, * , iostat= ios, iomsg= iomsg) ' Hello, World!'
54
+ call check(error, ios== 0 , ' Cannot write to null_device unit: ' // trim (iomsg))
55
+ if (allocated (error)) return
56
+
57
+ close (unit, iostat= ios, iomsg= iomsg)
58
+ call check(error, ios== 0 , ' Cannot close null_device unit: ' // trim (iomsg))
59
+ if (allocated (error)) return
60
+
61
+ end subroutine test_null_device
41
62
42
63
end module test_os
43
64
0 commit comments