Line data Source code
1 1 : program test_utils
2 :
3 1 : use utils_def
4 : use utils_lib
5 : use const_def, only: dp
6 :
7 : implicit none
8 :
9 1 : call test_dict
10 :
11 1 : call test_idict
12 :
13 1 : call test_token_read
14 :
15 : contains
16 :
17 6 : subroutine test_dict
18 : type(integer_dict), pointer :: dict
19 :
20 : integer :: value, ierr
21 : logical :: duplicate
22 :
23 1 : write (*, '(A)')
24 1 : write (*, *) 'test_dict'
25 :
26 1 : nullify (dict)
27 :
28 1 : call integer_dict_define_and_report_duplicates(dict, 'c', 3, duplicate, ierr)
29 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
30 1 : call integer_dict_define_and_report_duplicates(dict, 'a', 1, duplicate, ierr)
31 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
32 1 : call integer_dict_define_and_report_duplicates(dict, 'd', 4, duplicate, ierr)
33 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
34 1 : call integer_dict_define_and_report_duplicates(dict, 'b', 0, duplicate, ierr)
35 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
36 : ! redefine some
37 1 : call integer_dict_define_and_report_duplicates(dict, 'b', 2, duplicate, ierr)
38 1 : if (ierr /= 0 .or. .not. duplicate) call mesa_error(__FILE__, __LINE__)
39 1 : call integer_dict_define_and_report_duplicates(dict, 'd', 4, duplicate, ierr)
40 1 : if (ierr /= 0 .or. .not. duplicate) call mesa_error(__FILE__, __LINE__)
41 1 : call integer_dict_define_and_report_duplicates(dict, 'c', 3, duplicate, ierr)
42 1 : if (ierr /= 0 .or. .not. duplicate) call mesa_error(__FILE__, __LINE__)
43 :
44 1 : call integer_dict_create_hash(dict, ierr)
45 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
46 :
47 1 : call integer_dict_lookup(dict, 'b', value, ierr)
48 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
49 1 : if (value /= 2) call mesa_error(__FILE__, __LINE__)
50 :
51 1 : call integer_dict_lookup(dict, 'a', value, ierr)
52 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
53 1 : if (value /= 1) call mesa_error(__FILE__, __LINE__)
54 :
55 1 : call integer_dict_lookup(dict, 'd', value, ierr)
56 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
57 1 : if (value /= 4) call mesa_error(__FILE__, __LINE__)
58 :
59 1 : call integer_dict_lookup(dict, 'bogus', value, ierr)
60 1 : if (ierr == 0) call mesa_error(__FILE__, __LINE__)
61 1 : ierr = 0
62 :
63 1 : call integer_dict_free(dict)
64 :
65 1 : write (*, *) 'okay'
66 1 : write (*, '(A)')
67 :
68 1 : end subroutine test_dict
69 :
70 2 : subroutine test_idict
71 : type(integer_idict), pointer :: idict
72 :
73 : integer :: value, ierr
74 : logical :: duplicate
75 :
76 1 : write (*, '(A)')
77 1 : write (*, *) 'test_idict'
78 :
79 1 : nullify (idict)
80 :
81 1 : call integer_idict_define_and_report_duplicates(idict, 196, 48, 3, duplicate, ierr)
82 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
83 1 : call integer_idict_define_and_report_duplicates(idict, 1547, 974, 1, duplicate, ierr)
84 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
85 1 : call integer_idict_define_and_report_duplicates(idict, 592, 8, 4, duplicate, ierr)
86 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
87 1 : call integer_idict_define_and_report_duplicates(idict, -51, 885, 0, duplicate, ierr)
88 1 : if (ierr /= 0 .or. duplicate) call mesa_error(__FILE__, __LINE__)
89 : ! redefine some
90 1 : call integer_idict_define_and_report_duplicates(idict, -51, 885, 2, duplicate, ierr)
91 1 : if (ierr /= 0 .or. .not. duplicate) call mesa_error(__FILE__, __LINE__)
92 1 : call integer_idict_define_and_report_duplicates(idict, 592, 8, 4, duplicate, ierr)
93 1 : if (ierr /= 0 .or. .not. duplicate) call mesa_error(__FILE__, __LINE__)
94 1 : call integer_idict_define_and_report_duplicates(idict, 196, 48, 3, duplicate, ierr)
95 1 : if (ierr /= 0 .or. .not. duplicate) call mesa_error(__FILE__, __LINE__)
96 :
97 1 : call integer_idict_create_hash(idict, ierr)
98 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
99 :
100 1 : call integer_idict_lookup(idict, -51, 885, value, ierr)
101 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
102 1 : if (value /= 2) call mesa_error(__FILE__, __LINE__)
103 :
104 1 : call integer_idict_lookup(idict, 1547, 974, value, ierr)
105 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
106 1 : if (value /= 1) call mesa_error(__FILE__, __LINE__)
107 :
108 1 : call integer_idict_lookup(idict, 592, 8, value, ierr)
109 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
110 1 : if (value /= 4) call mesa_error(__FILE__, __LINE__)
111 :
112 1 : call integer_idict_lookup(idict, 0, 18888888, value, ierr)
113 1 : if (ierr == 0) call mesa_error(__FILE__, __LINE__)
114 1 : ierr = 0
115 :
116 1 : call integer_idict_free(idict)
117 :
118 1 : write (*, *) 'okay'
119 1 : write (*, '(A)')
120 :
121 1 : end subroutine test_idict
122 :
123 1 : subroutine test_token_read
124 : integer :: iounit, n, i, t, ierr
125 : character(len=256) :: buffer, string, filename
126 :
127 1 : write (*, '(A)')
128 1 : write (*, *) 'test_token_read'
129 1 : write (*, '(A)')
130 :
131 1 : filename = 'token.txt'
132 1 : ierr = 0
133 1 : iounit = alloc_iounit(ierr)
134 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
135 1 : open (unit=iounit, file=trim(filename), action='read', status='old', iostat=ierr)
136 1 : if (ierr /= 0) call mesa_error(__FILE__, __LINE__)
137 1 : n = 0
138 1 : i = 0
139 :
140 20 : do
141 21 : t = token(iounit, n, i, buffer, string)
142 2 : select case (t)
143 : case (string_token)
144 2 : write (*, *) 'string_token', len_trim(string), trim(string)
145 : case (name_token)
146 11 : write (*, *) 'name_token', len_trim(string), trim(string)
147 : case (left_paren_token)
148 2 : write (*, *) 'left_paren_token'
149 : case (right_paren_token)
150 2 : write (*, *) 'right_paren_token'
151 : case (comma_token)
152 3 : write (*, *) 'comma_token'
153 : case (eof_token)
154 1 : write (*, *) 'eof_token'
155 22 : exit
156 : case default
157 : end select
158 :
159 : end do
160 :
161 1 : close (iounit)
162 1 : call free_iounit(iounit)
163 :
164 1 : write (*, '(A)')
165 1 : write (*, *) 'done test_token_read'
166 1 : write (*, '(A)')
167 :
168 1 : end subroutine test_token_read
169 :
170 : end program test_utils
|
