MOM_file_parser_tests.F90

1! This file is part of MOM6, the Modular Ocean Model version 6.
2! See the LICENSE file for licensing information.
3! SPDX-License-Identifier: Apache-2.0
4
6
7use posix, only : chmod
8
12use mom_file_parser, only : read_param
13use mom_file_parser, only : log_param
14use mom_file_parser, only : get_param
15use mom_file_parser, only : log_version
19
20use mom_time_manager, only : time_type
21use mom_time_manager, only : set_date
22use mom_time_manager, only : set_ticks_per_second
23use mom_time_manager, only : set_calendar_type
24use mom_time_manager, only : noleap, no_calendar
25
26use mom_error_handler, only : assert
28use mom_error_handler, only : fatal
29
30use mom_unit_testing, only : testsuite
31use mom_unit_testing, only : string
34
35implicit none ; private
36
37public :: run_file_parser_tests
38
39character(len=*), parameter :: param_filename = 'TEST_input'
40character(len=*), parameter :: missing_param_filename = 'MISSING_input'
41character(len=*), parameter :: netcdf_param_filename = 'TEST_input.nc'
42
43character(len=*), parameter :: sample_param_name = 'SAMPLE_PARAMETER'
44character(len=*), parameter :: missing_param_name = 'MISSING_PARAMETER'
45
46character(len=*), parameter :: module_name = "SAMPLE_module"
47character(len=*), parameter :: module_version = "SAMPLE_version"
48character(len=*), parameter :: module_desc = "Description here"
49
50character(len=9), parameter :: param_docfiles(4) = [ &
51 "all ", &
52 "debugging", &
53 "layout ", &
54 "short " &
55]
56
57contains
58
59subroutine test_open_param_file
60 type(param_file_type) :: param
61
62 call create_test_file(param_filename)
63
64 call open_param_file(param_filename, param)
65 call close_param_file(param)
66end subroutine test_open_param_file
67
68
69subroutine test_close_param_file_quiet
70 type(param_file_type) :: param
71
72 call create_test_file(param_filename)
73
74 call open_param_file(param_filename, param)
75 call close_param_file(param, quiet_close=.true.)
76end subroutine test_close_param_file_quiet
77
78
79subroutine test_open_param_file_component
80 type(param_file_type) :: param
81 integer :: i
82
83 call create_test_file(param_filename)
84
85 call open_param_file(param_filename, param, component="TEST")
86 call close_param_file(param, component="TEST")
87end subroutine test_open_param_file_component
88
89
90subroutine cleanup_open_param_file_component
91 integer :: i
92
93 call delete_test_file(param_filename)
94 do i = 1, 4
95 call delete_test_file("TEST_parameter_doc."//param_docfiles(i))
96 enddo
97end subroutine cleanup_open_param_file_component
98
99
100subroutine test_open_param_file_docdir
101 ! TODO: Make a new directory...?
102 type(param_file_type) :: param
103
104 call create_test_file(param_filename)
105
106 call open_param_file(param_filename, param, doc_file_dir='./')
107 call close_param_file(param)
108end subroutine test_open_param_file_docdir
109
110
111subroutine test_open_param_file_empty_filename
112 type(param_file_type) :: param
113
114 call open_param_file('', param)
115 ! FATAL; return to program
116end subroutine test_open_param_file_empty_filename
117
118
119subroutine test_open_param_file_long_name
120 !> Store filename in a variable longer than FILENAME_LENGTH
121 type(param_file_type) :: param
122 character(len=250) :: long_filename
123
124 long_filename = param_filename
125
126 call create_test_file(long_filename)
127
128 call open_param_file(long_filename, param)
129 call close_param_file(param)
130end subroutine test_open_param_file_long_name
131
132
133subroutine test_missing_param_file
134 type(param_file_type) :: param
135 logical :: file_exists
136
137 inquire(file=missing_param_filename, exist=file_exists)
138 if (file_exists) call mom_error(fatal, "Missing file already exists!")
139
140 call open_param_file(missing_param_filename, param)
141 ! FATAL; return to program
142end subroutine test_missing_param_file
143
144
145subroutine test_open_param_file_ioerr
146 type(param_file_type) :: param
147 ! NOTE: Induce an I/O error in open() by making the file unreadable
148
149 call create_test_file(param_filename, mode=int(o'000'))
150
151 call open_param_file(param_filename, param)
152 ! FATAL; return to program
153end subroutine test_open_param_file_ioerr
154
155
156subroutine cleanup_open_param_file_ioerr
157 integer :: rc
158
159 rc = chmod(param_filename, int(o'700'))
160 call cleanup_file_parser()
161end subroutine cleanup_open_param_file_ioerr
162
163
164subroutine test_open_param_file_netcdf
165 type(param_file_type) :: param
166
167 call create_test_file(netcdf_param_filename)
168
169 call open_param_file(netcdf_param_filename, param)
170 ! FATAL; return to program
171end subroutine test_open_param_file_netcdf
172
173
174subroutine cleanup_open_param_file_netcdf
175 integer :: param_unit
176 logical :: is_open
177
178 call delete_test_file(netcdf_param_filename)
179end subroutine cleanup_open_param_file_netcdf
180
181
182subroutine test_open_param_file_checkable
183 type(param_file_type) :: param
184
185 call create_test_file(param_filename)
186
187 call open_param_file(param_filename, param, checkable=.false.)
188 call close_param_file(param)
189end subroutine test_open_param_file_checkable
190
191
192subroutine test_reopen_param_file
193 type(param_file_type) :: param
194
195 call create_test_file(param_filename)
196
197 call open_param_file(param_filename, param)
198 call open_param_file(param_filename, param)
199 call close_param_file(param)
200end subroutine test_reopen_param_file
201
202
203subroutine test_open_param_file_no_doc
204 type(param_file_type) :: param
205 type(string) :: lines(1)
206
207 lines(1) = string('DOCUMENT_FILE = ""')
208 call create_test_file(param_filename, lines)
209
210 call open_param_file(param_filename, param)
211 call close_param_file(param)
212end subroutine test_open_param_file_no_doc
213
214
215subroutine test_read_param_int
216 type(param_file_type) :: param
217 integer :: sample
218 type(string) :: lines(1)
219 character(len=*), parameter :: sample_input = '123'
220 integer, parameter :: sample_result = 123
221
222 lines = string(sample_param_name // ' = ' // sample_input)
223 call create_test_file(param_filename, lines)
224
225 call open_param_file(param_filename, param)
226 call read_param(param, sample_param_name, sample)
227 call close_param_file(param)
228
229 call assert(sample == sample_result, 'Incorrect value')
230end subroutine test_read_param_int
231
232
233subroutine test_read_param_int_missing
234 type(param_file_type) :: param
235 integer :: sample
236
237 call create_test_file(param_filename)
238
239 call open_param_file(param_filename, param)
240 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
241 ! FATAL; return to program
242end subroutine test_read_param_int_missing
243
244
245subroutine test_read_param_int_undefined
246 type(param_file_type) :: param
247 integer :: sample
248 type(string) :: lines(1)
249
250 lines = string('#undef ' // sample_param_name)
251 call create_test_file(param_filename, lines)
252
253 call open_param_file(param_filename, param)
254 call read_param(param, sample_param_name, sample, fail_if_missing=.true.)
255 ! FATAL; return to program
256end subroutine test_read_param_int_undefined
257
258
259subroutine test_read_param_int_type_err
260 type(param_file_type) :: param
261 integer :: sample
262 type(string) :: lines(1)
263
264 lines = string(sample_param_name // ' = not_an_integer')
265 call create_test_file(param_filename, lines)
266
267 call open_param_file(param_filename, param)
268 call read_param(param, sample_param_name, sample)
269 ! FATAL; return to program
270end subroutine test_read_param_int_type_err
271
272
273subroutine test_read_param_int_array
274 type(param_file_type) :: param
275 integer :: sample(3)
276 type(string) :: lines(1)
277 character(len=*), parameter :: sample_input = '1, 2, 3'
278 integer, parameter :: sample_result(3) = [1, 2, 3]
279
280 lines = string(sample_param_name // ' = ' // sample_input)
281 call create_test_file(param_filename, lines)
282
283 call open_param_file(param_filename, param)
284 call read_param(param, sample_param_name, sample)
285 call close_param_file(param)
286
287 call assert(all(sample == sample_result), 'Incorrect value')
288end subroutine test_read_param_int_array
289
290
291subroutine test_read_param_int_array_missing
292 type(param_file_type) :: param
293 integer :: sample(3)
294
295 call create_test_file(param_filename)
296
297 call open_param_file(param_filename, param)
298 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
299 ! FATAL; return to program
300end subroutine test_read_param_int_array_missing
301
302
303subroutine test_read_param_int_array_undefined
304 type(param_file_type) :: param
305 integer :: sample(3)
306 type(string) :: lines(1)
307
308 lines = string('#undef ' // sample_param_name)
309 call create_test_file(param_filename, lines)
310
311 call open_param_file(param_filename, param)
312 call read_param(param, sample_param_name, sample, fail_if_missing=.true.)
313 ! FATAL; return to program
314end subroutine test_read_param_int_array_undefined
315
316
317subroutine test_read_param_int_array_type_err
318 type(param_file_type) :: param
319 integer :: sample(3)
320 type(string) :: lines(1)
321
322 lines = string(sample_param_name // ' = not_an_int_array')
323 call create_test_file(param_filename, lines)
324
325 call open_param_file(param_filename, param)
326 call read_param(param, sample_param_name, sample)
327 ! FATAL; return to program
328end subroutine test_read_param_int_array_type_err
329
330
331subroutine test_read_param_real
332 type(param_file_type) :: param
333 real :: sample
334 type(string) :: lines(1)
335 character(len=*), parameter :: sample_input = '3.14'
336 real, parameter :: sample_result = 3.14
337
338 lines = string(sample_param_name // ' = ' // sample_input)
339 call create_test_file(param_filename, lines)
340
341 call open_param_file(param_filename, param)
342 call read_param(param, sample_param_name, sample)
343 call close_param_file(param)
344
345 call assert(sample == sample_result, 'Incorrect value')
346end subroutine test_read_param_real
347
348
349subroutine test_read_param_real_missing
350 type(param_file_type) :: param
351 real :: sample
352
353 call create_test_file(param_filename)
354
355 call open_param_file(param_filename, param)
356 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
357 ! FATAL; return to program
358end subroutine test_read_param_real_missing
359
360
361subroutine test_read_param_real_undefined
362 type(param_file_type) :: param
363 real :: sample
364 type(string) :: lines(1)
365
366 lines = string('#undef ' // sample_param_name)
367 call create_test_file(param_filename, lines)
368
369 call open_param_file(param_filename, param)
370 call read_param(param, sample_param_name, sample, fail_if_missing=.true.)
371 ! FATAL; return to program
372end subroutine test_read_param_real_undefined
373
374
375subroutine test_read_param_real_type_err
376 type(param_file_type) :: param
377 real :: sample
378 type(string) :: lines(1)
379
380 lines = string(sample_param_name // ' = not_a_real')
381 call create_test_file(param_filename, lines)
382
383 call open_param_file(param_filename, param)
384 call read_param(param, sample_param_name, sample)
385 ! FATAL; return to program
386end subroutine test_read_param_real_type_err
387
388
389subroutine test_read_param_real_array
390 type(param_file_type) :: param
391 real :: sample(3)
392 type(string) :: lines(1)
393 character(len=*), parameter :: sample_input = '1., 2., 3.'
394 real, parameter :: sample_result(3) = [1., 2., 3.]
395
396 lines = string(sample_param_name // ' = ' // sample_input)
397 call create_test_file(param_filename, lines)
398
399 call open_param_file(param_filename, param)
400 call read_param(param, sample_param_name, sample)
401 call close_param_file(param)
402
403 call assert(all(sample == sample_result), 'Incorrect value')
404end subroutine test_read_param_real_array
405
406
407subroutine test_read_param_real_array_missing
408 type(param_file_type) :: param
409 real :: sample(3)
410
411 call create_test_file(param_filename)
412
413 call open_param_file(param_filename, param)
414 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
415 ! FATAL; return to program
416end subroutine test_read_param_real_array_missing
417
418
419subroutine test_read_param_real_array_undefined
420 type(param_file_type) :: param
421 real :: sample(3)
422 type(string) :: lines(1)
423
424 lines = string('#undef ' // sample_param_name)
425 call create_test_file(param_filename, lines)
426
427 call open_param_file(param_filename, param)
428 call read_param(param, sample_param_name, sample, fail_if_missing=.true.)
429 ! FATAL; return to program
430end subroutine test_read_param_real_array_undefined
431
432
433subroutine test_read_param_real_array_type_err
434 type(param_file_type) :: param
435 real :: sample(3)
436 type(string) :: lines(1)
437
438 lines = string(sample_param_name // ' = not_a_real_array')
439 call create_test_file(param_filename, lines)
440
441 call open_param_file(param_filename, param)
442 call read_param(param, sample_param_name, sample)
443 ! FATAL; return to program
444end subroutine test_read_param_real_array_type_err
445
446
447subroutine test_read_param_logical
448 type(param_file_type) :: param
449 logical :: sample
450 type(string) :: lines(1)
451 character(len=*), parameter :: sample_input = 'True'
452 logical, parameter :: sample_result = .true.
453
454 lines = string(sample_param_name // ' = ' // sample_input)
455
456 !lines = string(sample_param_name // ' = True')
457 call create_test_file(param_filename, lines)
458
459 call open_param_file(param_filename, param)
460 call read_param(param, sample_param_name, sample)
461 call close_param_file(param)
462
463 call assert(sample .eqv. sample_result, 'Incorrect value')
464end subroutine test_read_param_logical
465
466
467subroutine test_read_param_logical_missing
468 type(param_file_type) :: param
469 logical :: sample
470
471 call create_test_file(param_filename)
472
473 call open_param_file(param_filename, param)
474 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
475 ! FATAL; return to program
476end subroutine test_read_param_logical_missing
477
478
479subroutine test_read_param_char_no_delim
480 type(param_file_type) :: param
481 character(len=8) :: sample
482 type(string) :: lines(1)
483 character(len=*), parameter :: sample_input = "abcdefgh"
484 character(len=*), parameter :: sample_result = "abcdefgh"
485
486 lines = string(sample_param_name // ' = ' // sample_input)
487 call create_test_file(param_filename, lines)
488
489 call open_param_file(param_filename, param)
490 call read_param(param, sample_param_name, sample)
491 call close_param_file(param)
492
493 call assert(sample == sample_result, 'Incorrect value')
494end subroutine test_read_param_char_no_delim
495
496
497subroutine test_read_param_char_quote_delim
498 type(param_file_type) :: param
499 character(len=8) :: sample
500 type(string) :: lines(1)
501 character(len=*), parameter :: sample_input = '"abcdefgh"'
502 character(len=*), parameter :: sample_result = "abcdefgh"
503
504 lines = string(sample_param_name // ' = ' // sample_input)
505 call create_test_file(param_filename, lines)
506
507 call open_param_file(param_filename, param)
508 call read_param(param, sample_param_name, sample)
509 call close_param_file(param)
510
511 call assert(sample == sample_result, 'Incorrect value')
512end subroutine test_read_param_char_quote_delim
513
514
515subroutine test_read_param_char_apostrophe_delim
516 type(param_file_type) :: param
517 character(len=8) :: sample
518 type(string) :: lines(1)
519 character(len=*), parameter :: sample_input = "'abcdefgh'"
520 character(len=*), parameter :: sample_result = "abcdefgh"
521
522 lines = string(sample_param_name // " = " // sample_input)
523 call create_test_file(param_filename, lines)
524
525 call open_param_file(param_filename, param)
526 call read_param(param, sample_param_name, sample)
527 call close_param_file(param)
528
529 call assert(sample == sample_result, 'Incorrect value')
530end subroutine test_read_param_char_apostrophe_delim
531
532
533subroutine test_read_param_char_missing
534 type(param_file_type) :: param
535 character(len=8) :: sample
536
537 call create_test_file(param_filename)
538
539 call open_param_file(param_filename, param)
540 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
541 ! FATAL; return to program
542end subroutine test_read_param_char_missing
543
544
545subroutine test_read_param_char_array
546 type(param_file_type) :: param
547 character(len=3) :: sample(3)
548 type(string) :: lines(1)
549 character(len=*), parameter :: sample_input = '"abc", "def", "ghi"'
550 character(len=*), parameter :: sample_result(3) = ["abc", "def", "ghi"]
551
552 lines = string(sample_param_name // ' = ' // sample_input)
553 call create_test_file(param_filename, lines)
554
555 call open_param_file(param_filename, param)
556 call read_param(param, sample_param_name, sample)
557 call close_param_file(param)
558
559 call assert(all(sample == sample_result), 'Incorrect value')
560end subroutine test_read_param_char_array
561
562
563subroutine test_read_param_char_array_missing
564 type(param_file_type) :: param
565 character(len=8) :: sample(3)
566
567 call create_test_file(param_filename)
568
569 call open_param_file(param_filename, param)
570 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
571 ! FATAL; return to program
572end subroutine test_read_param_char_array_missing
573
574
575subroutine test_read_param_time_date
576 type(param_file_type) :: param
577 type(time_type) :: sample
578 type(string) :: lines(1)
579
580 lines = string(sample_param_name // ' = 1980-01-01 00:00:00')
581 call create_test_file(param_filename, lines)
582
583 call set_calendar_type(noleap)
584 call open_param_file(param_filename, param)
585 call read_param(param, sample_param_name, sample)
586 call close_param_file(param)
587end subroutine test_read_param_time_date
588
589
590subroutine test_read_param_time_date_bad_format
591 type(param_file_type) :: param
592 type(time_type) :: sample
593 type(string) :: lines(1)
594
595 lines = string(sample_param_name // ' = 1980--01--01 00::00::00')
596 call create_test_file(param_filename, lines)
597
598 call set_calendar_type(noleap)
599 call open_param_file(param_filename, param)
600 call read_param(param, sample_param_name, sample)
601 ! FATAL; return to program
602end subroutine test_read_param_time_date_bad_format
603
604
605subroutine test_read_param_time_tuple
606 type(param_file_type) :: param
607 type(time_type) :: sample
608 type(string) :: lines(1)
609
610 lines = string(sample_param_name // ' = 1980,1,1,0,0,0')
611 call create_test_file(param_filename, lines)
612
613 call set_calendar_type(noleap)
614 call open_param_file(param_filename, param)
615 call read_param(param, sample_param_name, sample)
616 call close_param_file(param)
617end subroutine test_read_param_time_tuple
618
619
620subroutine test_read_param_time_bad_tuple
621 type(param_file_type) :: param
622 type(time_type) :: sample
623 type(string) :: lines(1)
624
625 lines = string(sample_param_name // ' = 1980, 1')
626 call create_test_file(param_filename, lines)
627
628 call set_calendar_type(noleap)
629 call open_param_file(param_filename, param)
630 call read_param(param, sample_param_name, sample)
631 ! FATAL; return to program
632end subroutine test_read_param_time_bad_tuple
633
634
635subroutine test_read_param_time_bad_tuple_values
636 type(param_file_type) :: param
637 type(time_type) :: sample
638 type(string) :: lines(1)
639
640 lines = string(sample_param_name // ' = 0, 0, 0, 0, 0, 0')
641 call create_test_file(param_filename, lines)
642
643 call set_calendar_type(noleap)
644 call open_param_file(param_filename, param)
645 call read_param(param, sample_param_name, sample)
646 ! FATAL; return to program
647end subroutine test_read_param_time_bad_tuple_values
648
649
650subroutine test_read_param_time_unit
651 type(param_file_type) :: param
652 type(time_type) :: sample
653 type(string) :: lines(1)
654
655 lines = string(sample_param_name // ' = 0.5')
656 call create_test_file(param_filename, lines)
657
658 call set_calendar_type(noleap)
659 call open_param_file(param_filename, param)
660 call read_param(param, sample_param_name, sample, timeunit=86400.)
661 call close_param_file(param)
662end subroutine test_read_param_time_unit
663
664
665subroutine test_read_param_time_missing
666 type(param_file_type) :: param
667 type(time_type) :: sample
668
669 call create_test_file(param_filename)
670
671 call open_param_file(param_filename, param)
672 call read_param(param, missing_param_name, sample, fail_if_missing=.true.)
673 ! FATAL; return to program
674end subroutine test_read_param_time_missing
675
676
677subroutine test_read_param_time_undefined
678 type(param_file_type) :: param
679 type(time_type) :: sample
680 type(string) :: lines(1)
681
682 lines = string('#undef ' // sample_param_name)
683 call create_test_file(param_filename, lines)
684
685 call open_param_file(param_filename, param)
686 call read_param(param, sample_param_name, sample, fail_if_missing=.true.)
687 ! FATAL; return to program
688end subroutine test_read_param_time_undefined
689
690
691subroutine test_read_param_time_type_err
692 type(param_file_type) :: param
693 type(time_type) :: sample
694 type(string) :: lines(1)
695
696 lines = string(sample_param_name // ' = 1., 2., 3., 4., 5., 6.')
697 call create_test_file(param_filename, lines)
698
699 call open_param_file(param_filename, param)
700 call read_param(param, sample_param_name, sample)
701 ! FATAL; return to program
702end subroutine test_read_param_time_type_err
703
704! Generic parameter tests
705
706subroutine test_read_param_unused_fatal
707 type(param_file_type) :: param
708 type(string) :: lines(2)
709
710 lines = [ &
711 string('FATAL_UNUSED_PARAMS = True'), &
712 string(sample_param_name // ' = 1') &
713 ]
714 call create_test_file(param_filename, lines)
715
716 call open_param_file(param_filename, param)
717 call close_param_file(param)
718 ! FATAL; return to program
719end subroutine test_read_param_unused_fatal
720
721
722subroutine test_read_param_replace_tabs
723 type(param_file_type) :: param
724 integer :: sample
725 type(string) :: lines(1)
726 character(len=*), parameter :: sample_input = "1"
727 integer, parameter :: sample_result = 1
728 character, parameter :: tab = achar(9)
729
730 lines = string(sample_param_name // tab // '=' // tab // sample_input)
731 call create_test_file(param_filename, lines)
732
733 call open_param_file(param_filename, param)
734 call read_param(param, sample_param_name, sample)
735 call close_param_file(param)
736
737 call assert(sample == sample_result, 'Incorrect value')
738end subroutine test_read_param_replace_tabs
739
740
741subroutine test_read_param_pad_equals
742 type(param_file_type) :: param
743 integer :: sample
744 type(string) :: lines(1)
745 character(len=*), parameter :: sample_input = "1"
746 integer, parameter :: sample_result = 1
747
748 lines = string(sample_param_name // '=' // sample_input)
749 call create_test_file(param_filename, lines)
750
751 call open_param_file(param_filename, param)
752 call read_param(param, sample_param_name, sample)
753 call close_param_file(param)
754
755 call assert(sample == sample_result, 'Incorrect value')
756end subroutine test_read_param_pad_equals
757
758
759subroutine test_read_param_multiline_param
760 type(param_file_type) :: param
761 integer :: sample
762 type(string) :: lines(2)
763 integer, parameter :: sample_result = 1
764 character, parameter :: backslash = achar(92)
765
766 lines = [ &
767 string(sample_param_name // ' = ' // backslash), &
768 string(' 1') &
769 ]
770 call create_test_file(param_filename, lines)
771
772 call open_param_file(param_filename, param)
773 call read_param(param, sample_param_name, sample)
774 call close_param_file(param)
775
776 call assert(sample == sample_result, 'Incorrect result')
777end subroutine test_read_param_multiline_param
778
779
780subroutine test_read_param_multiline_param_unclosed
781 type(param_file_type) :: param
782 integer :: sample
783 type(string) :: lines(1)
784 character, parameter :: backslash = achar(92)
785
786 lines = string(sample_param_name // ' = ' // backslash)
787 call create_test_file(param_filename, lines)
788
789 call open_param_file(param_filename, param)
790 ! FATAL; return to program
791end subroutine test_read_param_multiline_param_unclosed
792
793
794subroutine test_read_param_multiline_comment
795 type(param_file_type) :: param
796 integer :: sample
797
798 type(string) :: lines(6)
799
800 lines = [ &
801 string('/* First C comment line'), &
802 string(' Second C comment line */'), &
803 string('// First C++ comment line'), &
804 string('// Second C++ comment line'), &
805 string('! First Fortran comment line'), &
806 string('! Second Fortran comment line') &
807 ]
808 call create_test_file(param_filename, lines)
809
810 call open_param_file(param_filename, param)
811 call close_param_file(param)
812end subroutine test_read_param_multiline_comment
813
814
815subroutine test_read_param_multiline_comment_unclosed
816 type(param_file_type) :: param
817 integer :: sample
818 type(string) :: lines(1)
819
820 lines = string('/* Unclosed C comment')
821 call create_test_file(param_filename, lines)
822
823 call open_param_file(param_filename, param)
824 ! FATAL; return to program
825end subroutine test_read_param_multiline_comment_unclosed
826
827
828subroutine test_read_param_misplaced_quote
829 type(param_file_type) :: param
830 character(len=20) :: sample
831 type(string) :: lines(1)
832
833 lines = string(sample_param_name // ' = "abc')
834 call create_test_file(param_filename, lines)
835
836 call open_param_file(param_filename, param)
837 ! FATAL; return to program
838end subroutine test_read_param_misplaced_quote
839
840
841subroutine test_read_param_define
842 type(param_file_type) :: param
843 integer :: sample
844 type(string) :: lines(1)
845 integer, parameter :: sample_result = 2
846
847 lines = string('#define ' // sample_param_name // ' 2')
848 call create_test_file(param_filename, lines)
849
850 call open_param_file(param_filename, param)
851 call read_param(param, sample_param_name, sample)
852 call close_param_file(param)
853
854 call assert(sample == sample_result, 'Incorrect value')
855end subroutine test_read_param_define
856
857
858subroutine test_read_param_define_as_flag
859 type(param_file_type) :: param
860 integer :: sample
861 type(string) :: lines(1)
862
863 lines = string('#define ' // sample_param_name)
864 call create_test_file(param_filename, lines)
865
866 call open_param_file(param_filename, param)
867 call read_param(param, sample_param_name, sample)
868 call close_param_file(param)
869end subroutine test_read_param_define_as_flag
870
871
872subroutine test_read_param_override
873 type(param_file_type) :: param
874 integer :: sample
875 type(string) :: lines(2)
876 integer, parameter :: sample_result = 2
877
878 lines = [ &
879 string(sample_param_name // ' = 1'), &
880 string('#override ' // sample_param_name // ' = 2') &
881 ]
882 call create_test_file(param_filename, lines)
883
884 call open_param_file(param_filename, param)
885 call read_param(param, sample_param_name, sample)
886 call close_param_file(param)
887
888 call assert(sample == sample_result, 'Incorrect value')
889end subroutine test_read_param_override
890
891
892subroutine test_read_param_override_misplaced
893 type(param_file_type) :: param
894 integer :: sample
895 type(string) :: lines(1)
896
897 lines(1) = string('#define #override ' // sample_param_name // ' = 1')
898 call create_test_file(param_filename, lines)
899
900 call open_param_file(param_filename, param)
901 ! FATAL; return to program
902end subroutine test_read_param_override_misplaced
903
904
905subroutine test_read_param_override_twice
906 type(param_file_type) :: param
907 integer :: sample
908 type(string) :: lines(3)
909
910 lines = [ &
911 string(sample_param_name // ' = 1'), &
912 string('#override ' // sample_param_name // ' = 2'), &
913 string('#override ' // sample_param_name // ' = 3') &
914 ]
915 call create_test_file(param_filename, lines)
916
917 call open_param_file(param_filename, param)
918 call read_param(param, sample_param_name, sample)
919 ! FATAL; return to program
920end subroutine test_read_param_override_twice
921
922
923subroutine test_read_param_override_repeat
924 type(param_file_type) :: param
925 integer :: sample
926 type(string) :: lines(3)
927
928 lines = [ &
929 string(sample_param_name // ' = 1'), &
930 string('#override ' // sample_param_name // ' = 2'), &
931 string('#override ' // sample_param_name // ' = 2') &
932 ]
933 call create_test_file(param_filename, lines)
934
935 call open_param_file(param_filename, param)
936 call read_param(param, sample_param_name, sample)
937 ! FATAL; return to program
938end subroutine test_read_param_override_repeat
939
940
941subroutine test_read_param_override_warn_chain
942 type(param_file_type) :: param
943 integer :: sample
944 character(len=*), parameter :: other_param_name = 'OTHER_PARAMETER'
945 type(string) :: lines(4)
946
947 lines = [ &
948 string(other_param_name // ' = 1'), &
949 string(sample_param_name // ' = 2'), &
950 string('#override ' // other_param_name // ' = 3'), &
951 string('#override ' // sample_param_name // ' = 4') &
952 ]
953 call create_test_file(param_filename, lines)
954
955 call open_param_file(param_filename, param)
956 ! First invoke the "other" override, adding it to the chain
957 call read_param(param, other_param_name, sample)
958 ! Now invoke the "sample" override, with "other" in the chain
959 call read_param(param, sample_param_name, sample)
960 ! Finally, re-invoke the "other" override, having already been issued.
961 call read_param(param, other_param_name, sample)
962 call close_param_file(param)
963end subroutine test_read_param_override_warn_chain
964
965
966subroutine test_read_param_assign_after_override
967 type(param_file_type) :: param
968 integer :: sample
969 type(string) :: lines(2)
970
971 lines = [ &
972 string('#override ' // sample_param_name // ' = 2'), &
973 string(sample_param_name // ' = 3') &
974 ]
975 call create_test_file(param_filename, lines)
976
977 call open_param_file(param_filename, param)
978 call read_param(param, sample_param_name, sample)
979 call close_param_file(param)
980end subroutine test_read_param_assign_after_override
981
982
983subroutine test_read_param_override_no_def
984 type(param_file_type) :: param
985 integer :: sample
986 type(string) :: lines(1)
987
988 lines(1) = string('#override ' // sample_param_name)
989 call create_test_file(param_filename, lines)
990
991 call open_param_file(param_filename, param)
992 call read_param(param, sample_param_name, sample)
993 ! FATAL; return to program
994end subroutine test_read_param_override_no_def
995
996
997subroutine test_read_param_assign_twice
998 type(param_file_type) :: param
999 integer :: sample
1000 type(string) :: lines(2)
1001
1002 lines = [ &
1003 string(sample_param_name // ' = 1'), &
1004 string(sample_param_name // ' = 2') &
1005 ]
1006 call create_test_file(param_filename, lines)
1007
1008 call open_param_file(param_filename, param)
1009 call read_param(param, sample_param_name, sample)
1010 ! FATAL; return to program
1011end subroutine test_read_param_assign_twice
1012
1013
1014subroutine test_read_param_assign_repeat
1015 type(param_file_type) :: param
1016 integer :: sample
1017 type(string) :: lines(2)
1018
1019 lines = [ &
1020 string(sample_param_name // ' = 1'), &
1021 string(sample_param_name // ' = 1') &
1022 ]
1023 call create_test_file(param_filename, lines)
1024
1025 call open_param_file(param_filename, param)
1026 call read_param(param, sample_param_name, sample)
1027 call close_param_file(param)
1028end subroutine test_read_param_assign_repeat
1029
1030
1031subroutine test_read_param_null_stmt
1032 type(param_file_type) :: param
1033 integer :: sample
1034 type(string) :: lines(1)
1035
1036 lines(1) = string(sample_param_name)
1037 call create_test_file(param_filename, lines)
1038
1039 call open_param_file(param_filename, param)
1040 call read_param(param, sample_param_name, sample)
1041 ! FATAL; return to program
1042end subroutine test_read_param_null_stmt
1043
1044
1045subroutine test_read_param_assign_in_define
1046 type(param_file_type) :: param
1047 integer :: sample
1048 type(string) :: lines(1)
1049
1050 lines = string('#define ' // sample_param_name // ' = 1')
1051 call create_test_file(param_filename, lines)
1052
1053 call open_param_file(param_filename, param)
1054 call read_param(param, sample_param_name, sample)
1055 ! FATAL; return to program
1056end subroutine test_read_param_assign_in_define
1057
1058!-- Blocks
1059
1060subroutine test_read_param_block
1061 type(param_file_type) :: param
1062 integer :: sample
1063 type(string) :: lines(3)
1064 integer, parameter :: sample_result = 123
1065
1066 lines = [ &
1067 string('ABC%'), &
1068 string('ABC%' // sample_param_name // ' = 123'), &
1069 string('%ABC') &
1070 ]
1071 call create_test_file(param_filename, lines)
1072
1073 call open_param_file(param_filename, param)
1074 call openparameterblock(param, 'ABC')
1075 call read_param(param, sample_param_name, sample)
1076 call closeparameterblock(param)
1077 call clearparameterblock(param)
1078 call close_param_file(param)
1079
1080 call assert(sample == sample_result, 'Incorrect value')
1081end subroutine test_read_param_block
1082
1083
1084! TODO: This test fails due to an implementation issue.
1085subroutine test_read_param_block_stack
1086 type(param_file_type) :: param
1087 integer :: sample
1088 type(string) :: lines(5)
1089
1090 lines = [ &
1091 string('ABC%'), &
1092 string('DEF%'), &
1093 string(sample_param_name // ' = 123'), &
1094 string('DEF%'), &
1095 string('%ABC') &
1096 ]
1097 call create_test_file(param_filename, lines)
1098
1099 call open_param_file(param_filename, param)
1100 call openparameterblock(param, 'ABC')
1101 call openparameterblock(param, 'DEF')
1102 call read_param(param, sample_param_name, sample)
1103 call closeparameterblock(param)
1104 call clearparameterblock(param)
1105 call close_param_file(param)
1106end subroutine test_read_param_block_stack
1107
1108
1109! NOTE: This is a simpler version of the block_stack test which works
1110subroutine test_read_param_block_inline_stack
1111 type(param_file_type) :: param
1112 integer :: sample
1113 type(string) :: lines(3)
1114
1115 lines = [ &
1116 string('ABC%'), &
1117 string('DEF%' // sample_param_name // ' = 123'), &
1118 string('%ABC') &
1119 ]
1120 call create_test_file(param_filename, lines)
1121
1122 call open_param_file(param_filename, param)
1123 call openparameterblock(param, 'ABC')
1124 call openparameterblock(param, 'DEF')
1125 call read_param(param, sample_param_name, sample)
1126 call closeparameterblock(param)
1127 call clearparameterblock(param)
1128 call close_param_file(param)
1129end subroutine test_read_param_block_inline_stack
1130
1131
1132subroutine test_read_param_block_empty_pop
1133 type(param_file_type) :: param
1134
1135 call create_test_file(param_filename)
1136
1137 call open_param_file(param_filename, param)
1138 call openparameterblock(param, '%')
1139 call openparameterblock(param, 'ABC')
1140 call closeparameterblock(param)
1141 call closeparameterblock(param)
1142 ! FATAL; return to program
1143end subroutine test_read_param_block_empty_pop
1144
1145
1146subroutine test_read_param_block_close_unnamed
1147 type(param_file_type) :: param
1148 type(string) :: lines(2)
1149
1150 lines = [ &
1151 string('ABC%'), &
1152 string('%ABC') &
1153 ]
1154 call create_test_file(param_filename, lines)
1155
1156 call open_param_file(param_filename, param)
1157 call openparameterblock(param, 'ABC')
1158 call closeparameterblock(param)
1159 call closeparameterblock(param)
1160 ! FATAL; return to program
1161end subroutine test_read_param_block_close_unnamed
1162
1163
1164subroutine test_read_param_block_close_unopened
1165 type(param_file_type) :: param
1166 type(string) :: lines(1)
1167
1168 lines = string('%CBA')
1169 call create_test_file(param_filename, lines)
1170
1171 call open_param_file(param_filename, param)
1172 ! FATAL; return to program
1173end subroutine test_read_param_block_close_unopened
1174
1175
1176subroutine test_read_param_block_unmatched
1177 type(param_file_type) :: param
1178 type(string) :: lines(2)
1179
1180 lines = [ &
1181 string('ABC%'), &
1182 string('%CBA') &
1183 ]
1184 call create_test_file(param_filename, lines)
1185
1186 call open_param_file(param_filename, param)
1187 ! FATAL; return to program
1188end subroutine test_read_param_block_unmatched
1189
1190
1191subroutine test_open_unallocated_block
1192 type(param_file_type) :: param
1193 character(len=*), parameter :: block_name = "ABC"
1194
1195 call openparameterblock(param, block_name)
1196 ! FATAL; return to program
1197end subroutine test_open_unallocated_block
1198
1199
1200subroutine test_close_unallocated_block
1201 type(param_file_type) :: param
1202
1203 call closeparameterblock(param)
1204 ! FATAL; return to program
1205end subroutine test_close_unallocated_block
1206
1207
1208subroutine test_clear_unallocated_block
1209 type(param_file_type) :: param
1210
1211 call clearparameterblock(param)
1212 ! FATAL; return to program
1213end subroutine test_clear_unallocated_block
1214
1215
1216subroutine test_read_param_block_outside_block
1217 type(param_file_type) :: param
1218 integer :: sample
1219 type(string) :: lines(3)
1220
1221 lines = [ &
1222 string('ABC%'), &
1223 string(sample_param_name // ' = 1'), &
1224 string('%ABC') &
1225 ]
1226 call create_test_file(param_filename, lines)
1227
1228 call open_param_file(param_filename, param)
1229 call read_param(param, sample_param_name, sample)
1230end subroutine test_read_param_block_outside_block
1231
1232!---
1233
1234subroutine test_log_version_cs
1235 type(param_file_type) :: param
1236
1237 call create_test_file(param_filename)
1238
1239 call open_param_file(param_filename, param)
1240 call log_version(param, module_name, module_version, desc=module_desc)
1241 call close_param_file(param)
1242end subroutine test_log_version_cs
1243
1244
1245subroutine test_log_version_plain
1246 call log_version(module_name, module_version)
1247end subroutine test_log_version_plain
1248
1249
1250subroutine test_log_param_int
1251 type(param_file_type) :: param
1252 integer, parameter :: sample = 1
1253 character(len=*), parameter :: desc = "Parameter description"
1254
1255 call create_test_file(param_filename)
1256
1257 call open_param_file(param_filename, param)
1258 call log_param(param, module_name, sample_param_name, sample, desc=desc)
1259 call close_param_file(param)
1260end subroutine test_log_param_int
1261
1262
1263subroutine test_log_param_int_array
1264 type(param_file_type) :: param
1265 integer, parameter :: sample(3) = [1, 2, 3]
1266 character(len=*), parameter :: desc = "Parameter description"
1267
1268 call create_test_file(param_filename)
1269
1270 call open_param_file(param_filename, param)
1271 call log_param(param, module_name, sample_param_name, sample, desc=desc)
1272 call close_param_file(param)
1273end subroutine test_log_param_int_array
1274
1275
1276subroutine test_log_param_real
1277 type(param_file_type) :: param
1278 real, parameter :: sample = 1.
1279 character(len=*), parameter :: desc = "Parameter description"
1280
1281 call create_test_file(param_filename)
1282
1283 call open_param_file(param_filename, param)
1284 call log_param(param, module_name, sample_param_name, sample, desc=desc, units="")
1285 call close_param_file(param)
1286end subroutine test_log_param_real
1287
1288
1289subroutine test_log_param_real_array
1290 type(param_file_type) :: param
1291 real, parameter :: sample(3) = [1., 2., 3.]
1292 character(len=*), parameter :: desc = "Parameter description"
1293
1294 call create_test_file(param_filename)
1295
1296 call open_param_file(param_filename, param)
1297 call log_param(param, module_name, sample_param_name, sample, desc=desc, units="")
1298 call close_param_file(param)
1299end subroutine test_log_param_real_array
1300
1301
1302subroutine test_log_param_time
1303 type(param_file_type) :: param
1304 type(time_type) :: sample
1305 character(len=*), parameter :: desc = "Parameter description"
1306 type(string) :: lines(1)
1307
1308 lines = string(sample_param_name // ' = 1980,1,1,0,0,0')
1309
1310 call set_calendar_type(noleap)
1311 call create_test_file(param_filename)
1312
1313 call open_param_file(param_filename, param)
1314 call read_param(param, sample_param_name, sample)
1315 call log_param(param, module_name, sample_param_name, sample, desc=desc)
1316 call close_param_file(param)
1317end subroutine test_log_param_time
1318
1319
1320subroutine test_log_param_time_as_date
1321 type(param_file_type) :: param
1322 type(time_type) :: sample
1323 character(len=*), parameter :: desc = "Parameter description"
1324
1325 call set_calendar_type(noleap)
1326 call create_test_file(param_filename)
1327
1328 call open_param_file(param_filename, param)
1329 sample = set_date(1980, 1, 1, 0, 0, 0)
1330 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1331 log_date=.true.)
1332 call close_param_file(param)
1333end subroutine test_log_param_time_as_date
1334
1335
1336subroutine test_log_param_time_as_date_default
1337 type(param_file_type) :: param
1338 type(time_type) :: sample
1339 type(time_type) :: default_date
1340 character(len=*), parameter :: desc = "Parameter description"
1341
1342 call set_calendar_type(noleap)
1343 call create_test_file(param_filename)
1344
1345 call open_param_file(param_filename, param)
1346
1347 call set_ticks_per_second(60)
1348 default_date = set_date(1980, 1, 1, 0, 0, 0, 30)
1349 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1350 log_date=.true., default=default_date)
1351
1352 call set_ticks_per_second(300)
1353 default_date = set_date(1980, 1, 1, 0, 0, 0, 150)
1354 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1355 log_date=.true., default=default_date)
1356
1357 call close_param_file(param)
1358end subroutine test_log_param_time_as_date_default
1359
1360
1361subroutine test_log_param_time_as_date_tick
1362 type(param_file_type) :: param
1363 type(time_type) :: sample
1364 character(len=*), parameter :: desc = "Parameter description"
1365
1366 call set_calendar_type(noleap)
1367 call create_test_file(param_filename)
1368
1369 call open_param_file(param_filename, param)
1370 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1371 log_date=.true.)
1372 call close_param_file(param)
1373end subroutine test_log_param_time_as_date_tick
1374
1375
1376subroutine test_log_param_time_with_unit
1377 type(param_file_type) :: param
1378 type(time_type) :: sample
1379 type(time_type) :: default_date
1380 character(len=*), parameter :: desc = "Parameter description"
1381 character(len=*), parameter :: sample_units = "days since whatever"
1382
1383 call set_calendar_type(noleap)
1384 call create_test_file(param_filename)
1385
1386 call set_ticks_per_second(60)
1387 sample = set_date(1980, 1, 1, 0, 0, 0, 30)
1388
1389 default_date = set_date(1980, 1, 1, 0, 0, 0, 30)
1390
1391 call open_param_file(param_filename, param)
1392 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1393 units=sample_units, timeunit=86400., default=default_date)
1394 call close_param_file(param)
1395end subroutine test_log_param_time_with_unit
1396
1397
1398subroutine test_log_param_time_with_timeunit
1399 type(param_file_type) :: param
1400 type(time_type) :: sample
1401 integer :: i
1402 character(len=*), parameter :: desc = "Parameter description"
1403 real, parameter :: timeunits(5) = [1., 3600., 86400., 3.1e7, 1e8]
1404
1405 call set_calendar_type(noleap)
1406 call create_test_file(param_filename)
1407
1408 call open_param_file(param_filename, param)
1409 do i = 1,5
1410 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1411 timeunit=timeunits(i))
1412 enddo
1413 call close_param_file(param)
1414end subroutine test_log_param_time_with_timeunit
1415
1416!----
1417
1418subroutine test_get_param_int
1419 type(param_file_type) :: param
1420 integer :: sample
1421
1422 call create_test_file(param_filename)
1423
1424 call open_param_file(param_filename, param)
1425 call get_param(param, module_name, sample_param_name, sample)
1426 call close_param_file(param)
1427end subroutine test_get_param_int
1428
1429
1430subroutine test_get_param_int_no_read_no_log
1431 type(param_file_type) :: param
1432 integer :: sample
1433
1434 call create_test_file(param_filename)
1435
1436 call open_param_file(param_filename, param)
1437 call get_param(param, module_name, sample_param_name, sample, &
1438 do_not_read=.true., do_not_log=.true.)
1439 call close_param_file(param)
1440end subroutine test_get_param_int_no_read_no_log
1441
1442
1443subroutine test_get_param_int_array
1444 type(param_file_type) :: param
1445 integer :: sample(3)
1446
1447 call create_test_file(param_filename)
1448
1449 call open_param_file(param_filename, param)
1450 call get_param(param, module_name, sample_param_name, sample)
1451 call close_param_file(param)
1452end subroutine test_get_param_int_array
1453
1454
1455subroutine test_get_param_int_array_no_read_no_log
1456 type(param_file_type) :: param
1457 integer :: sample(3)
1458
1459 call create_test_file(param_filename)
1460
1461 call open_param_file(param_filename, param)
1462 call get_param(param, module_name, sample_param_name, sample, &
1463 do_not_read=.true., do_not_log=.true.)
1464 call close_param_file(param)
1465end subroutine test_get_param_int_array_no_read_no_log
1466
1467
1468subroutine test_get_param_real
1469 type(param_file_type) :: param
1470 real :: sample
1471
1472 call create_test_file(param_filename)
1473
1474 call open_param_file(param_filename, param)
1475 call get_param(param, module_name, sample_param_name, sample, units="")
1476 call close_param_file(param)
1477end subroutine test_get_param_real
1478
1479
1480subroutine test_get_param_real_no_read_no_log
1481 type(param_file_type) :: param
1482 real :: sample
1483
1484 call create_test_file(param_filename)
1485
1486 call open_param_file(param_filename, param)
1487 call get_param(param, module_name, sample_param_name, sample, units="", &
1488 do_not_read=.true., do_not_log=.true.)
1489 call close_param_file(param)
1490end subroutine test_get_param_real_no_read_no_log
1491
1492
1493subroutine test_get_param_real_array
1494 type(param_file_type) :: param
1495 real :: sample(3)
1496
1497 call create_test_file(param_filename)
1498
1499 call open_param_file(param_filename, param)
1500 call get_param(param, module_name, sample_param_name, sample, units="")
1501 call close_param_file(param)
1502end subroutine test_get_param_real_array
1503
1504
1505subroutine test_get_param_real_array_no_read_no_log
1506 type(param_file_type) :: param
1507 real :: sample(3)
1508
1509 call create_test_file(param_filename)
1510
1511 call open_param_file(param_filename, param)
1512 call get_param(param, module_name, sample_param_name, sample, units="", &
1513 do_not_read=.true., do_not_log=.true.)
1514 call close_param_file(param)
1515end subroutine test_get_param_real_array_no_read_no_log
1516
1517
1518subroutine test_get_param_char
1519 type(param_file_type) :: param
1520 character(len=8) :: sample
1521
1522 call create_test_file(param_filename)
1523
1524 call open_param_file(param_filename, param)
1525 call get_param(param, module_name, sample_param_name, sample)
1526 call close_param_file(param)
1527end subroutine test_get_param_char
1528
1529
1530subroutine test_get_param_char_no_read_no_log
1531 type(param_file_type) :: param
1532 character(len=8) :: sample
1533
1534 call create_test_file(param_filename)
1535
1536 call open_param_file(param_filename, param)
1537 call get_param(param, module_name, sample_param_name, sample, &
1538 do_not_read=.true., do_not_log=.true.)
1539 call close_param_file(param)
1540end subroutine test_get_param_char_no_read_no_log
1541
1542
1543subroutine test_get_param_char_array
1544 type(param_file_type) :: param
1545 character(len=8) :: sample(3)
1546
1547 call create_test_file(param_filename)
1548
1549 call open_param_file(param_filename, param)
1550 call get_param(param, module_name, sample_param_name, sample)
1551 call close_param_file(param)
1552end subroutine test_get_param_char_array
1553
1554
1555subroutine test_get_param_logical
1556 type(param_file_type) :: param
1557 logical :: sample
1558
1559 call create_test_file(param_filename)
1560
1561 call open_param_file(param_filename, param)
1562 call get_param(param, module_name, sample_param_name, sample)
1563 call close_param_file(param)
1564end subroutine test_get_param_logical
1565
1566
1567subroutine test_get_param_logical_no_read_no_log
1568 type(param_file_type) :: param
1569 logical :: sample
1570
1571 call create_test_file(param_filename)
1572
1573 call open_param_file(param_filename, param)
1574 call get_param(param, module_name, sample_param_name, sample, &
1575 do_not_read=.true., do_not_log=.true.)
1576 call close_param_file(param)
1577end subroutine test_get_param_logical_no_read_no_log
1578
1579
1580subroutine test_get_param_logical_default
1581 type(param_file_type) :: param
1582 logical :: sample
1583 logical, parameter :: default_value = .false.
1584
1585 call create_test_file(param_filename)
1586
1587 call open_param_file(param_filename, param)
1588 call get_param(param, module_name, sample_param_name, sample, &
1589 default=default_value)
1590 call close_param_file(param)
1591end subroutine test_get_param_logical_default
1592
1593
1594subroutine test_get_param_time
1595 type(param_file_type) :: param
1596 type(time_type) :: sample
1597
1598 call create_test_file(param_filename)
1599
1600 call open_param_file(param_filename, param)
1601 call get_param(param, module_name, sample_param_name, sample)
1602 call close_param_file(param)
1603end subroutine test_get_param_time
1604
1605
1606subroutine test_get_param_time_no_read_no_log
1607 type(param_file_type) :: param
1608 type(time_type) :: sample
1609
1610 call create_test_file(param_filename)
1611
1612 call open_param_file(param_filename, param)
1613 call get_param(param, module_name, sample_param_name, sample, &
1614 do_not_read=.true., do_not_log=.true.)
1615 call close_param_file(param)
1616end subroutine test_get_param_time_no_read_no_log
1617
1618
1619! Utility functions
1620! TODO: Move to a generic testing module
1621
1622subroutine cleanup_file_parser
1623 integer :: i
1624
1625 call delete_test_file(param_filename)
1626 do i = 1, 4
1627 call delete_test_file("MOM_parameter_doc."//param_docfiles(i))
1628 enddo
1629
1630 call set_calendar_type(no_calendar)
1631end subroutine cleanup_file_parser
1632
1633
1634subroutine run_file_parser_tests
1635 ! testing...
1636 type(testsuite) :: suite
1637
1638 ! Delete any pre-existing test parameter files
1639 call cleanup_file_parser
1640
1641 ! Build the test suite
1642 suite = testsuite()
1643 suite%cleanup => cleanup_file_parser
1644
1645 call suite%add(test_open_param_file, "test_open_param_file")
1646
1647 call suite%add(test_close_param_file_quiet, "test_close_param_file_quiet")
1648
1649 call suite%add(test_open_param_file_component, "test_open_param_file_component", &
1650 cleanup=cleanup_open_param_file_component)
1651
1652 call suite%add(test_open_param_file_docdir, "test_open_param_file_docdir")
1653
1654 call suite%add(test_open_param_file_empty_filename, &
1655 "test_open_param_file_empty_filename", fatal=.true.)
1656
1657 call suite%add(test_open_param_file_long_name, &
1658 "test_open_param_file_longname")
1659
1660 call suite%add(test_missing_param_file, "test_missing_param_file", &
1661 fatal=.true.)
1662
1663 call suite%add(test_open_param_file_ioerr, "test_open_param_file_ioerr", &
1664 fatal=.true., cleanup=cleanup_open_param_file_ioerr)
1665
1666 call suite%add(test_open_param_file_checkable, &
1667 "test_open_param_file_checkable")
1668
1669 call suite%add(test_reopen_param_file, "test_reopen_param_file")
1670
1671 call suite%add(test_open_param_file_netcdf, "test_open_param_file_netcdf", &
1672 fatal=.true., cleanup=cleanup_open_param_file_netcdf)
1673
1674 call suite%add(test_open_param_file_no_doc, "test_open_param_file_no_doc")
1675
1676 call suite%add(test_read_param_int, "test_read_param_int")
1677
1678 call suite%add(test_read_param_int_missing, "test_read_param_int_missing", &
1679 fatal=.true.)
1680
1681 call suite%add(test_read_param_int_undefined, &
1682 "test_read_param_int_undefined", fatal=.true.)
1683
1684 call suite%add(test_read_param_int_type_err, &
1685 "test_read_param_int_type_err", fatal=.true.)
1686
1687 call suite%add(test_read_param_int_array, "test_read_param_int_array")
1688
1689 call suite%add(test_read_param_int_array_missing, &
1690 "test_read_param_int_array_missing", fatal=.true.)
1691
1692 call suite%add(test_read_param_int_array_undefined, &
1693 "test_read_param_int_array_undefined", fatal=.true.)
1694
1695 call suite%add(test_read_param_int_array_type_err, &
1696 "test_read_param_int_array_type_err", fatal=.true.)
1697
1698 call suite%add(test_read_param_real, "test_read_param_real")
1699
1700 call suite%add(test_read_param_real_missing, &
1701 "test_read_param_real_missing", fatal=.true.)
1702
1703 call suite%add(test_read_param_real_undefined, &
1704 "test_read_param_real_undefined", fatal=.true.)
1705
1706 call suite%add(test_read_param_real_type_err, &
1707 "test_read_param_real_type_err", fatal=.true.)
1708
1709 call suite%add(test_read_param_real_array, "test_read_param_real_array")
1710
1711 call suite%add(test_read_param_real_array_missing, &
1712 "test_read_param_real_array_missing", fatal=.true.)
1713
1714 call suite%add(test_read_param_real_array_undefined, &
1715 "test_read_param_real_array_undefined", fatal=.true.)
1716
1717 call suite%add(test_read_param_real_array_type_err, &
1718 "test_read_param_real_array_type_err", fatal=.true.)
1719
1720 call suite%add(test_read_param_logical, "test_read_param_logical")
1721
1722 call suite%add(test_read_param_logical_missing, &
1723 "test_read_param_logical_missing", fatal=.true.)
1724
1725 call suite%add(test_read_param_char_no_delim, &
1726 "test_read_param_char_no_delim")
1727
1728 call suite%add(test_read_param_char_quote_delim, &
1729 "test_read_param_char_quote_delim")
1730
1731 call suite%add(test_read_param_char_apostrophe_delim, &
1732 "test_read_param_char_apostrophe_delim")
1733
1734 call suite%add(test_read_param_char_missing, &
1735 "test_read_param_char_missing", fatal=.true.)
1736
1737 call suite%add(test_read_param_char_array, "test_read_param_char_array")
1738
1739 call suite%add(test_read_param_char_array_missing, &
1740 "test_read_param_char_array_missing", fatal=.true.)
1741
1742 call suite%add(test_read_param_time_date, "test_read_param_time_date")
1743
1744 call suite%add(test_read_param_time_date_bad_format, &
1745 "test_read_param_time_date_bad_format", fatal=.true.)
1746
1747 call suite%add(test_read_param_time_tuple, "test_read_param_time_tuple")
1748
1749 call suite%add(test_read_param_time_bad_tuple, &
1750 "test_read_param_time_bad_tuple", fatal=.true.)
1751
1752 call suite%add(test_read_param_time_bad_tuple_values, &
1753 "test_read_param_time_bad_tuple_values", fatal=.true.)
1754
1755 call suite%add(test_read_param_time_missing, &
1756 "test_read_param_time_missing", fatal=.true.)
1757
1758 call suite%add(test_read_param_time_undefined, &
1759 "test_read_param_time_undefined", fatal=.true.)
1760
1761 call suite%add(test_read_param_time_type_err, &
1762 "test_read_param_time_type_err", fatal=.true.)
1763
1764 call suite%add(test_read_param_time_unit, "test_read_param_time_unit")
1765
1766 call suite%add(test_read_param_unused_fatal, &
1767 "test_read_param_unused_fatal", fatal=.true.)
1768
1769 call suite%add(test_read_param_multiline_comment, &
1770 "test_read_param_multiline_comment")
1771
1772 call suite%add(test_read_param_multiline_comment_unclosed, &
1773 "test_read_param_multiline_comment_unclosed", fatal=.true.)
1774
1775 call suite%add(test_read_param_multiline_param, &
1776 "test_read_param_multiline_param")
1777
1778 call suite%add(test_read_param_multiline_param_unclosed, &
1779 "test_read_param_multiline_param_unclosed", fatal=.true.)
1780
1781 call suite%add(test_read_param_replace_tabs, "test_read_param_replace_tabs")
1782
1783 call suite%add(test_read_param_pad_equals, "test_read_param_pad_equals")
1784
1785 call suite%add(test_read_param_misplaced_quote, &
1786 "test_read_param_misplaced_quote", fatal=.true.)
1787
1788 call suite%add(test_read_param_define, "test_read_param_define")
1789
1790 call suite%add(test_read_param_define_as_flag, &
1791 "test_read_param_define_as_flag")
1792
1793 call suite%add(test_read_param_override, "test_read_param_override")
1794
1795 call suite%add(test_read_param_override_misplaced, &
1796 "test_read_param_override_misplaced", fatal=.true.)
1797
1798 call suite%add(test_read_param_override_twice, &
1799 "test_read_param_override_twice", fatal=.true.)
1800
1801 call suite%add(test_read_param_override_repeat, &
1802 "test_read_param_override_repeat", fatal=.true.)
1803
1804 call suite%add(test_read_param_override_warn_chain, &
1805 "test_read_param_override_warn_chain")
1806
1807 call suite%add(test_read_param_override_no_def, &
1808 "test_read_param_override_no_def", fatal=.true.)
1809
1810 call suite%add(test_read_param_assign_after_override, &
1811 "test_read_param_assign_after_override")
1812
1813 call suite%add(test_read_param_assign_twice, &
1814 "test_read_param_assign_twice", fatal=.true.)
1815
1816 call suite%add(test_read_param_assign_repeat, &
1817 "test_read_param_assign_repeat")
1818
1819 call suite%add(test_read_param_null_stmt, "test_read_param_null_stmt", &
1820 fatal=.true.)
1821
1822 call suite%add(test_read_param_assign_in_define, &
1823 "test_read_param_assign_in_define", fatal=.true.)
1824
1825 call suite%add(test_read_param_block, "test_read_param_block")
1826
1827 ! FIXME: Test does not pass
1828 !call suite%add(test_read_param_block_stack, "test_read_param_block_stack")
1829
1830 call suite%add(test_read_param_block_inline_stack, &
1831 "test_read_param_block_inline_stack")
1832
1833 call suite%add(test_read_param_block_empty_pop, &
1834 "test_read_param_block_empty_pop", fatal=.true.)
1835
1836 call suite%add(test_read_param_block_close_unopened, &
1837 "test_read_param_block_close_unopened", fatal=.true.)
1838
1839 call suite%add(test_read_param_block_close_unnamed, &
1840 "test_read_param_block_close_unnamed", fatal=.true.)
1841
1842 call suite%add(test_read_param_block_unmatched, &
1843 "test_read_param_block_unmatched", fatal=.true.)
1844
1845 call suite%add(test_read_param_block_outside_block, &
1846 "test_read_param_block_outside_block")
1847
1848 call suite%add(test_open_unallocated_block, "test_open_unallocated_block", &
1849 fatal=.true.)
1850
1851 call suite%add(test_close_unallocated_block, &
1852 "test_close_unallocated_block", fatal=.true.)
1853
1854 call suite%add(test_clear_unallocated_block, &
1855 "test_clear_unallocated_block", fatal=.true.)
1856
1857 call suite%add(test_log_version_cs, "test_log_version_cs")
1858
1859 call suite%add(test_log_version_plain, "test_log_version_plain")
1860
1861 call suite%add(test_log_param_int, "test_log_param_int")
1862
1863 call suite%add(test_log_param_int_array, "test_log_param_int_array")
1864
1865 call suite%add(test_log_param_real, "test_log_param_real")
1866
1867 call suite%add(test_log_param_real_array, "test_log_param_real_array")
1868
1869 call suite%add(test_log_param_time, "test_log_param_time")
1870
1871 call suite%add(test_log_param_time_as_date, "test_log_param_time_as_date")
1872
1873 call suite%add(test_log_param_time_as_date_default, &
1874 "test_log_param_time_as_date_default")
1875
1876 call suite%add(test_log_param_time_as_date_tick, &
1877 "test_log_param_time_as_date_tick")
1878
1879 call suite%add(test_log_param_time_with_unit, &
1880 "test_log_param_time_with_unit")
1881
1882 call suite%add(test_log_param_time_with_timeunit, &
1883 "test_log_param_time_with_timeunit")
1884
1885 call suite%add(test_get_param_int, "test_get_param_int")
1886
1887 call suite%add(test_get_param_int_no_read_no_log, &
1888 "test_get_param_int_no_read_no_log")
1889
1890 call suite%add(test_get_param_int_array, "test_get_param_int_array")
1891
1892 call suite%add(test_get_param_int_array_no_read_no_log, &
1893 "test_get_param_int_array_no_read_no_log")
1894
1895 call suite%add(test_get_param_real, "test_get_param_real")
1896
1897 call suite%add(test_get_param_real_no_read_no_log, &
1898 "test_get_param_real_n_read_no_log")
1899
1900 call suite%add(test_get_param_real_array, "test_get_param_real_array")
1901
1902 call suite%add(test_get_param_real_array_no_read_no_log, &
1903 "test_get_param_real_array_no_read_no_log")
1904
1905 call suite%add(test_get_param_char, "test_get_param_char")
1906
1907 call suite%add(test_get_param_char_no_read_no_log, &
1908 "test_get_param_char_no_read_no_log")
1909
1910 call suite%add(test_get_param_char_array, "test_get_param_char_array")
1911
1912 call suite%add(test_get_param_logical, "test_get_param_logical")
1913
1914 call suite%add(test_get_param_logical_default, &
1915 "test_get_param_logical_default")
1916
1917 call suite%add(test_get_param_logical_no_read_no_log, &
1918 "test_get_param_logical_no_read_no_log")
1919
1920 call suite%add(test_get_param_time, "test_get_param_time")
1921
1922 call suite%add(test_get_param_time_no_read_no_log, &
1923 "test_get_param_time_np_read_no_log")
1924
1925 call suite%run()
1926end subroutine run_file_parser_tests
1927
1928end module mom_file_parser_tests