-
Notifications
You must be signed in to change notification settings - Fork 37
Expand file tree
/
Copy pathtest_pathlib.f90
More file actions
95 lines (69 loc) · 2.53 KB
/
Copy pathtest_pathlib.f90
File metadata and controls
95 lines (69 loc) · 2.53 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
program pathlib_test
use, intrinsic :: iso_fortran_env, only : stderr=>error_unit
use pathlib, only : get_filename, mkdir
implicit none (type, external)
character(:), allocatable :: fn
integer :: i
logical :: e
!> test get_filename
if(get_filename('') /= '') error stop 'empty 1'
if(get_filename('','') /= '') error stop 'empty 2'
call unlink('test-pathlib.h5')
if(len(get_filename('test-pathlib.h5')) > 0) error stop 'not exist full 1'
fn = get_filename('test-pathlib')
if(len(fn) > 0) then
write(stderr,*) 'ERROR: ',fn, len(fn)
error stop 'not exist stem 1'
endif
!> touch empty file
open(newunit=i, file='test-pathlib.h5', status='replace')
close(i)
inquire(file='test-pathlib.h5', exist=e)
if(.not.e) error stop 'could not create test-pathlib.h5'
if(get_filename('test-pathlib.h5') /= 'test-pathlib.h5') error stop 'exist full 1'
if(get_filename('test-pathlib') /= 'test-pathlib.h5') error stop 'exist stem 1'
fn = get_filename('.', 'test-pathlib')
if(fn /= './test-pathlib.h5') then
write(stderr,*) fn
error stop 'exist stem 2'
endif
fn = get_filename('./test-pathlib', 'test-pathlib')
if(fn /= './test-pathlib.h5') then
write(stderr,*) fn
error stop 'exist parts 2'
endif
fn = get_filename('./test-pathlib.h5', 'test-pathlib')
if(fn /= './test-pathlib.h5') then
write(stderr,*) fn
error stop 'exist full 2'
endif
call unlink('test-pathlib.h5')
open(newunit=i, file='test-pathlib.nc', status='replace')
close(i)
if(get_filename('test-pathlib.nc') /= 'test-pathlib.nc') error stop 'exist full 1a'
if(get_filename('test-pathlib') /= 'test-pathlib.nc') error stop 'exist stem 1a'
if(get_filename('.', 'test-pathlib') /= './test-pathlib.nc') error stop 'exist stem 2a'
if(get_filename('./test-pathlib', 'test-pathlib') /= './test-pathlib.nc') error stop 'exist parts 2a'
call unlink('test-pathlib.nc')
i = mkdir('temp1/temp2')
call unlink('temp1/temp2/test-pathlib.h5')
fn = get_filename('temp1/temp2', 'test-pathlib')
if (fn /= '') error stop 'non-exist dir'
open(newunit=i, file='temp1/temp2/test-pathlib.h5', status='replace')
close(i)
fn = get_filename('temp1/temp2', 'test-pathlib')
if (fn /= 'temp1/temp2/test-pathlib.h5') error stop 'exist dir full 2'
fn = get_filename('./temp1/temp2', 'test-pathlib')
if (fn /= './temp1/temp2/test-pathlib.h5') error stop 'exist dir full 2a'
print *, 'OK: pathlib'
contains
subroutine unlink(path)
character(*), intent(in) :: path
integer :: i
logical :: e
inquire(file=path, exist=e)
if (.not.e) return
open(newunit=i, file=path, status='old')
close(i, status='delete')
end subroutine unlink
end program