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_unused_fatal_absent
723 type(param_file_type) :: param
724 type(string) :: lines(3)
725
726 lines = [ &
727 string('FATAL_UNUSED_PARAMS = True'), &
728 string(sample_param_name // ' = 1'), &
729 string('#override absent '//sample_param_name) &
730 ]
731 call create_test_file(param_filename, lines)
732
733 call open_param_file(param_filename, param)
734 call close_param_file(param)
735end subroutine test_read_param_unused_fatal_absent
736
737
738subroutine test_read_param_replace_tabs
739 type(param_file_type) :: param
740 integer :: sample
741 type(string) :: lines(1)
742 character(len=*), parameter :: sample_input = "1"
743 integer, parameter :: sample_result = 1
744 character, parameter :: tab = achar(9)
745
746 lines = string(sample_param_name // tab // '=' // tab // sample_input)
747 call create_test_file(param_filename, lines)
748
749 call open_param_file(param_filename, param)
750 call read_param(param, sample_param_name, sample)
751 call close_param_file(param)
752
753 call assert(sample == sample_result, 'Incorrect value')
754end subroutine test_read_param_replace_tabs
755
756
757subroutine test_read_param_pad_equals
758 type(param_file_type) :: param
759 integer :: sample
760 type(string) :: lines(1)
761 character(len=*), parameter :: sample_input = "1"
762 integer, parameter :: sample_result = 1
763
764 lines = string(sample_param_name // '=' // sample_input)
765 call create_test_file(param_filename, lines)
766
767 call open_param_file(param_filename, param)
768 call read_param(param, sample_param_name, sample)
769 call close_param_file(param)
770
771 call assert(sample == sample_result, 'Incorrect value')
772end subroutine test_read_param_pad_equals
773
774
775subroutine test_read_param_multiline_param
776 type(param_file_type) :: param
777 integer :: sample
778 type(string) :: lines(2)
779 integer, parameter :: sample_result = 1
780 character, parameter :: backslash = achar(92)
781
782 lines = [ &
783 string(sample_param_name // ' = ' // backslash), &
784 string(' 1') &
785 ]
786 call create_test_file(param_filename, lines)
787
788 call open_param_file(param_filename, param)
789 call read_param(param, sample_param_name, sample)
790 call close_param_file(param)
791
792 call assert(sample == sample_result, 'Incorrect result')
793end subroutine test_read_param_multiline_param
794
795
796subroutine test_read_param_multiline_param_fatal_unused
797 type(param_file_type) :: param
798 integer :: sample
799 type(string) :: lines(3)
800 integer, parameter :: sample_result = 1
801
802 lines = [ &
803 string('FATAL_UNUSED_PARAMS = True'), &
804 string(sample_param_name // ' = &'), &
805 string(' 1') &
806 ]
807 call create_test_file(param_filename, lines)
808
809 call open_param_file(param_filename, param)
810 call read_param(param, sample_param_name, sample)
811 call close_param_file(param)
812
813 call assert(sample == sample_result, 'Incorrect result')
814end subroutine test_read_param_multiline_param_fatal_unused
815
816
817subroutine test_read_param_multiline_param_unclosed
818 type(param_file_type) :: param
819 integer :: sample
820 type(string) :: lines(1)
821 character, parameter :: backslash = achar(92)
822
823 lines = string(sample_param_name // ' = ' // backslash)
824 call create_test_file(param_filename, lines)
825
826 call open_param_file(param_filename, param)
827 ! FATAL; return to program
828end subroutine test_read_param_multiline_param_unclosed
829
830
831subroutine test_read_param_multiline_comment
832 type(param_file_type) :: param
833 integer :: sample
834
835 type(string) :: lines(6)
836
837 lines = [ &
838 string('/* First C comment line'), &
839 string(' Second C comment line */'), &
840 string('// First C++ comment line'), &
841 string('// Second C++ comment line'), &
842 string('! First Fortran comment line'), &
843 string('! Second Fortran comment line') &
844 ]
845 call create_test_file(param_filename, lines)
846
847 call open_param_file(param_filename, param)
848 call close_param_file(param)
849end subroutine test_read_param_multiline_comment
850
851
852subroutine test_read_param_multiline_comment_unclosed
853 type(param_file_type) :: param
854 integer :: sample
855 type(string) :: lines(1)
856
857 lines = string('/* Unclosed C comment')
858 call create_test_file(param_filename, lines)
859
860 call open_param_file(param_filename, param)
861 ! FATAL; return to program
862end subroutine test_read_param_multiline_comment_unclosed
863
864
865subroutine test_read_param_misplaced_quote
866 type(param_file_type) :: param
867 character(len=20) :: sample
868 type(string) :: lines(1)
869
870 lines = string(sample_param_name // ' = "abc')
871 call create_test_file(param_filename, lines)
872
873 call open_param_file(param_filename, param)
874 ! FATAL; return to program
875end subroutine test_read_param_misplaced_quote
876
877
878subroutine test_read_param_define
879 type(param_file_type) :: param
880 integer :: sample
881 type(string) :: lines(1)
882 integer, parameter :: sample_result = 2
883
884 lines = string('#define ' // sample_param_name // ' 2')
885 call create_test_file(param_filename, lines)
886
887 call open_param_file(param_filename, param)
888 call read_param(param, sample_param_name, sample)
889 call close_param_file(param)
890
891 call assert(sample == sample_result, 'Incorrect value')
892end subroutine test_read_param_define
893
894
895subroutine test_read_param_define_as_flag
896 type(param_file_type) :: param
897 integer :: sample
898 type(string) :: lines(1)
899
900 lines = string('#define ' // sample_param_name)
901 call create_test_file(param_filename, lines)
902
903 call open_param_file(param_filename, param)
904 call read_param(param, sample_param_name, sample)
905 call close_param_file(param)
906end subroutine test_read_param_define_as_flag
907
908
909subroutine test_read_param_override
910 type(param_file_type) :: param
911 integer :: sample
912 type(string) :: lines(2)
913 integer, parameter :: sample_result = 2
914
915 lines = [ &
916 string(sample_param_name // ' = 1'), &
917 string('#override ' // sample_param_name // ' = 2') &
918 ]
919 call create_test_file(param_filename, lines)
920
921 call open_param_file(param_filename, param)
922 call read_param(param, sample_param_name, sample)
923 call close_param_file(param)
924
925 call assert(sample == sample_result, 'Incorrect value')
926end subroutine test_read_param_override
927
928
929subroutine test_read_param_override_misplaced
930 type(param_file_type) :: param
931 integer :: sample
932 type(string) :: lines(1)
933
934 lines(1) = string('#define #override ' // sample_param_name // ' = 1')
935 call create_test_file(param_filename, lines)
936
937 call open_param_file(param_filename, param)
938 ! FATAL; return to program
939end subroutine test_read_param_override_misplaced
940
941
942subroutine test_read_param_override_twice
943 type(param_file_type) :: param
944 integer :: sample
945 type(string) :: lines(3)
946
947 lines = [ &
948 string(sample_param_name // ' = 1'), &
949 string('#override ' // sample_param_name // ' = 2'), &
950 string('#override ' // sample_param_name // ' = 3') &
951 ]
952 call create_test_file(param_filename, lines)
953
954 call open_param_file(param_filename, param)
955 call read_param(param, sample_param_name, sample)
956 ! FATAL; return to program
957end subroutine test_read_param_override_twice
958
959
960subroutine test_read_param_override_twice_absent
961 type(param_file_type) :: param
962 integer :: sample
963 type(string) :: lines(3)
964 integer, parameter :: sample_result = 4
965
966 lines = [ &
967 string(sample_param_name // ' = 1'), &
968 string('#override ' // sample_param_name // ' = 2'), &
969 string('#override absent '//sample_param_name) &
970 ]
971 call create_test_file(param_filename, lines)
972
973 call open_param_file(param_filename, param)
974 call read_param(param, sample_param_name, sample)
975 ! FATAL; return to program
976end subroutine test_read_param_override_twice_absent
977
978
979subroutine test_read_param_override_repeat
980 type(param_file_type) :: param
981 integer :: sample
982 type(string) :: lines(3)
983
984 lines = [ &
985 string(sample_param_name // ' = 1'), &
986 string('#override ' // sample_param_name // ' = 2'), &
987 string('#override ' // sample_param_name // ' = 2') &
988 ]
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_repeat
995
996
997subroutine test_read_param_override_warn_chain
998 type(param_file_type) :: param
999 integer :: sample
1000 character(len=*), parameter :: other_param_name = 'OTHER_PARAMETER'
1001 type(string) :: lines(4)
1002
1003 lines = [ &
1004 string(other_param_name // ' = 1'), &
1005 string(sample_param_name // ' = 2'), &
1006 string('#override ' // other_param_name // ' = 3'), &
1007 string('#override ' // sample_param_name // ' = 4') &
1008 ]
1009 call create_test_file(param_filename, lines)
1010
1011 call open_param_file(param_filename, param)
1012 ! First invoke the "other" override, adding it to the chain
1013 call read_param(param, other_param_name, sample)
1014 ! Now invoke the "sample" override, with "other" in the chain
1015 call read_param(param, sample_param_name, sample)
1016 ! Finally, re-invoke the "other" override, having already been issued.
1017 call read_param(param, other_param_name, sample)
1018 call close_param_file(param)
1019end subroutine test_read_param_override_warn_chain
1020
1021
1022subroutine test_read_param_assign_after_override
1023 type(param_file_type) :: param
1024 integer :: sample
1025 type(string) :: lines(2)
1026
1027 lines = [ &
1028 string('#override ' // sample_param_name // ' = 2'), &
1029 string(sample_param_name // ' = 3') &
1030 ]
1031 call create_test_file(param_filename, lines)
1032
1033 call open_param_file(param_filename, param)
1034 call read_param(param, sample_param_name, sample)
1035 call close_param_file(param)
1036end subroutine test_read_param_assign_after_override
1037
1038
1039subroutine test_read_param_override_no_def
1040 type(param_file_type) :: param
1041 integer :: sample
1042 type(string) :: lines(1)
1043
1044 lines(1) = string('#override ' // sample_param_name)
1045 call create_test_file(param_filename, lines)
1046
1047 call open_param_file(param_filename, param)
1048 call read_param(param, sample_param_name, sample)
1049 ! FATAL; return to program
1050end subroutine test_read_param_override_no_def
1051
1052
1053subroutine test_read_param_assign_twice
1054 type(param_file_type) :: param
1055 integer :: sample
1056 type(string) :: lines(2)
1057
1058 lines = [ &
1059 string(sample_param_name // ' = 1'), &
1060 string(sample_param_name // ' = 2') &
1061 ]
1062 call create_test_file(param_filename, lines)
1063
1064 call open_param_file(param_filename, param)
1065 call read_param(param, sample_param_name, sample)
1066 ! FATAL; return to program
1067end subroutine test_read_param_assign_twice
1068
1069
1070subroutine test_read_param_assign_repeat
1071 type(param_file_type) :: param
1072 integer :: sample
1073 type(string) :: lines(2)
1074
1075 lines = [ &
1076 string(sample_param_name // ' = 1'), &
1077 string(sample_param_name // ' = 1') &
1078 ]
1079 call create_test_file(param_filename, lines)
1080
1081 call open_param_file(param_filename, param)
1082 call read_param(param, sample_param_name, sample)
1083 call close_param_file(param)
1084end subroutine test_read_param_assign_repeat
1085
1086
1087subroutine test_read_param_null_stmt
1088 type(param_file_type) :: param
1089 integer :: sample
1090 type(string) :: lines(1)
1091
1092 lines(1) = string(sample_param_name)
1093 call create_test_file(param_filename, lines)
1094
1095 call open_param_file(param_filename, param)
1096 call read_param(param, sample_param_name, sample)
1097 ! FATAL; return to program
1098end subroutine test_read_param_null_stmt
1099
1100
1101subroutine test_read_param_assign_in_define
1102 type(param_file_type) :: param
1103 integer :: sample
1104 type(string) :: lines(1)
1105
1106 lines = string('#define ' // sample_param_name // ' = 1')
1107 call create_test_file(param_filename, lines)
1108
1109 call open_param_file(param_filename, param)
1110 call read_param(param, sample_param_name, sample)
1111 ! FATAL; return to program
1112end subroutine test_read_param_assign_in_define
1113
1114!-- Blocks
1115
1116subroutine test_read_param_block
1117 type(param_file_type) :: param
1118 integer :: sample
1119 type(string) :: lines(3)
1120 integer, parameter :: sample_result = 123
1121
1122 lines = [ &
1123 string('ABC%'), &
1124 string('ABC%' // sample_param_name // ' = 123'), &
1125 string('%ABC') &
1126 ]
1127 call create_test_file(param_filename, lines)
1128
1129 call open_param_file(param_filename, param)
1130 call openparameterblock(param, 'ABC')
1131 call read_param(param, sample_param_name, sample)
1132 call closeparameterblock(param)
1133 call clearparameterblock(param)
1134 call close_param_file(param)
1135
1136 call assert(sample == sample_result, 'Incorrect value')
1137end subroutine test_read_param_block
1138
1139
1140subroutine test_read_param_block_absent
1141 type(param_file_type) :: param
1142 integer :: sample
1143 logical :: param_was_set
1144 type(string) :: lines(10)
1145 integer, parameter :: sample_result = 123
1146
1147 ! Test that all 4 combinations of block formats for
1148 ! setting parameters and absenting them work.
1149 lines = [ &
1150 string('ABC%SAMPLE_PARAMETER_1 = 1'), &
1151 string('ABC%'), &
1152 string('ABC%SAMPLE_PARAMETER_2 = 2'), &
1153 string('SAMPLE_PARAMETER_3 = 3'), &
1154 string('SAMPLE_PARAMETER_4 = 4'), &
1155 string('#override absent ABC%SAMPLE_PARAMETER_1'), &
1156 string('#override absent SAMPLE_PARAMETER_2'), &
1157 string('#override absent SAMPLE_PARAMETER_3'), &
1158 string('%ABC'), &
1159 string('#override absent ABC%SAMPLE_PARAMETER_4') &
1160 ]
1161 call create_test_file(param_filename, lines)
1162
1163 sample = sample_result
1164 call open_param_file(param_filename, param)
1165 call openparameterblock(param, 'ABC')
1166 call read_param(param, 'SAMPLE_PARAMETER_2', sample, set=param_was_set)
1167 call closeparameterblock(param)
1168 call clearparameterblock(param)
1169 call close_param_file(param)
1170
1171 call assert(.not.param_was_set, 'Parameter should be absent')
1172 call assert(sample == sample_result, 'Absent parameter changed value')
1173end subroutine test_read_param_block_absent
1174
1175
1176! TODO: This test fails due to an implementation issue.
1177subroutine test_read_param_block_stack
1178 type(param_file_type) :: param
1179 integer :: sample
1180 type(string) :: lines(5)
1181
1182 lines = [ &
1183 string('ABC%'), &
1184 string('DEF%'), &
1185 string(sample_param_name // ' = 123'), &
1186 string('DEF%'), &
1187 string('%ABC') &
1188 ]
1189 call create_test_file(param_filename, lines)
1190
1191 call open_param_file(param_filename, param)
1192 call openparameterblock(param, 'ABC')
1193 call openparameterblock(param, 'DEF')
1194 call read_param(param, sample_param_name, sample)
1195 call closeparameterblock(param)
1196 call clearparameterblock(param)
1197 call close_param_file(param)
1198end subroutine test_read_param_block_stack
1199
1200
1201! NOTE: This is a simpler version of the block_stack test which works
1202subroutine test_read_param_block_inline_stack
1203 type(param_file_type) :: param
1204 integer :: sample
1205 type(string) :: lines(3)
1206
1207 lines = [ &
1208 string('ABC%'), &
1209 string('DEF%' // sample_param_name // ' = 123'), &
1210 string('%ABC') &
1211 ]
1212 call create_test_file(param_filename, lines)
1213
1214 call open_param_file(param_filename, param)
1215 call openparameterblock(param, 'ABC')
1216 call openparameterblock(param, 'DEF')
1217 call read_param(param, sample_param_name, sample)
1218 call closeparameterblock(param)
1219 call clearparameterblock(param)
1220 call close_param_file(param)
1221end subroutine test_read_param_block_inline_stack
1222
1223
1224subroutine test_read_param_block_empty_pop
1225 type(param_file_type) :: param
1226
1227 call create_test_file(param_filename)
1228
1229 call open_param_file(param_filename, param)
1230 call openparameterblock(param, '%')
1231 call openparameterblock(param, 'ABC')
1232 call closeparameterblock(param)
1233 call closeparameterblock(param)
1234 ! FATAL; return to program
1235end subroutine test_read_param_block_empty_pop
1236
1237
1238subroutine test_read_param_block_close_unnamed
1239 type(param_file_type) :: param
1240 type(string) :: lines(2)
1241
1242 lines = [ &
1243 string('ABC%'), &
1244 string('%ABC') &
1245 ]
1246 call create_test_file(param_filename, lines)
1247
1248 call open_param_file(param_filename, param)
1249 call openparameterblock(param, 'ABC')
1250 call closeparameterblock(param)
1251 call closeparameterblock(param)
1252 ! FATAL; return to program
1253end subroutine test_read_param_block_close_unnamed
1254
1255
1256subroutine test_read_param_block_close_unopened
1257 type(param_file_type) :: param
1258 type(string) :: lines(1)
1259
1260 lines = string('%CBA')
1261 call create_test_file(param_filename, lines)
1262
1263 call open_param_file(param_filename, param)
1264 ! FATAL; return to program
1265end subroutine test_read_param_block_close_unopened
1266
1267
1268subroutine test_read_param_block_unmatched
1269 type(param_file_type) :: param
1270 type(string) :: lines(2)
1271
1272 lines = [ &
1273 string('ABC%'), &
1274 string('%CBA') &
1275 ]
1276 call create_test_file(param_filename, lines)
1277
1278 call open_param_file(param_filename, param)
1279 ! FATAL; return to program
1280end subroutine test_read_param_block_unmatched
1281
1282
1283subroutine test_open_unallocated_block
1284 type(param_file_type) :: param
1285 character(len=*), parameter :: block_name = "ABC"
1286
1287 call openparameterblock(param, block_name)
1288 ! FATAL; return to program
1289end subroutine test_open_unallocated_block
1290
1291
1292subroutine test_close_unallocated_block
1293 type(param_file_type) :: param
1294
1295 call closeparameterblock(param)
1296 ! FATAL; return to program
1297end subroutine test_close_unallocated_block
1298
1299
1300subroutine test_clear_unallocated_block
1301 type(param_file_type) :: param
1302
1303 call clearparameterblock(param)
1304 ! FATAL; return to program
1305end subroutine test_clear_unallocated_block
1306
1307
1308subroutine test_read_param_block_outside_block
1309 type(param_file_type) :: param
1310 integer :: sample
1311 type(string) :: lines(3)
1312
1313 lines = [ &
1314 string('ABC%'), &
1315 string(sample_param_name // ' = 1'), &
1316 string('%ABC') &
1317 ]
1318 call create_test_file(param_filename, lines)
1319
1320 call open_param_file(param_filename, param)
1321 call read_param(param, sample_param_name, sample)
1322end subroutine test_read_param_block_outside_block
1323
1324!---
1325
1326subroutine test_log_version_cs
1327 type(param_file_type) :: param
1328
1329 call create_test_file(param_filename)
1330
1331 call open_param_file(param_filename, param)
1332 call log_version(param, module_name, module_version, desc=module_desc)
1333 call close_param_file(param)
1334end subroutine test_log_version_cs
1335
1336
1337subroutine test_log_version_plain
1338 call log_version(module_name, module_version)
1339end subroutine test_log_version_plain
1340
1341
1342subroutine test_log_param_int
1343 type(param_file_type) :: param
1344 integer, parameter :: sample = 1
1345 character(len=*), parameter :: desc = "Parameter description"
1346
1347 call create_test_file(param_filename)
1348
1349 call open_param_file(param_filename, param)
1350 call log_param(param, module_name, sample_param_name, sample, desc=desc)
1351 call close_param_file(param)
1352end subroutine test_log_param_int
1353
1354
1355subroutine test_log_param_int_array
1356 type(param_file_type) :: param
1357 integer, parameter :: sample(3) = [1, 2, 3]
1358 character(len=*), parameter :: desc = "Parameter description"
1359
1360 call create_test_file(param_filename)
1361
1362 call open_param_file(param_filename, param)
1363 call log_param(param, module_name, sample_param_name, sample, desc=desc)
1364 call close_param_file(param)
1365end subroutine test_log_param_int_array
1366
1367
1368subroutine test_log_param_real
1369 type(param_file_type) :: param
1370 real, parameter :: sample = 1.
1371 character(len=*), parameter :: desc = "Parameter description"
1372
1373 call create_test_file(param_filename)
1374
1375 call open_param_file(param_filename, param)
1376 call log_param(param, module_name, sample_param_name, sample, desc=desc, units="")
1377 call close_param_file(param)
1378end subroutine test_log_param_real
1379
1380
1381subroutine test_log_param_real_array
1382 type(param_file_type) :: param
1383 real, parameter :: sample(3) = [1., 2., 3.]
1384 character(len=*), parameter :: desc = "Parameter description"
1385
1386 call create_test_file(param_filename)
1387
1388 call open_param_file(param_filename, param)
1389 call log_param(param, module_name, sample_param_name, sample, desc=desc, units="")
1390 call close_param_file(param)
1391end subroutine test_log_param_real_array
1392
1393
1394subroutine test_log_param_time
1395 type(param_file_type) :: param
1396 type(time_type) :: sample
1397 character(len=*), parameter :: desc = "Parameter description"
1398 type(string) :: lines(1)
1399
1400 lines = string(sample_param_name // ' = 1980,1,1,0,0,0')
1401
1402 call set_calendar_type(noleap)
1403 call create_test_file(param_filename)
1404
1405 call open_param_file(param_filename, param)
1406 call read_param(param, sample_param_name, sample)
1407 call log_param(param, module_name, sample_param_name, sample, desc=desc)
1408 call close_param_file(param)
1409end subroutine test_log_param_time
1410
1411
1412subroutine test_log_param_time_as_date
1413 type(param_file_type) :: param
1414 type(time_type) :: sample
1415 character(len=*), parameter :: desc = "Parameter description"
1416
1417 call set_calendar_type(noleap)
1418 call create_test_file(param_filename)
1419
1420 call open_param_file(param_filename, param)
1421 sample = set_date(1980, 1, 1, 0, 0, 0)
1422 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1423 log_date=.true.)
1424 call close_param_file(param)
1425end subroutine test_log_param_time_as_date
1426
1427
1428subroutine test_log_param_time_as_date_default
1429 type(param_file_type) :: param
1430 type(time_type) :: sample
1431 type(time_type) :: default_date
1432 character(len=*), parameter :: desc = "Parameter description"
1433
1434 call set_calendar_type(noleap)
1435 call create_test_file(param_filename)
1436
1437 call open_param_file(param_filename, param)
1438
1439 call set_ticks_per_second(60)
1440 default_date = set_date(1980, 1, 1, 0, 0, 0, 30)
1441 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1442 log_date=.true., default=default_date)
1443
1444 call set_ticks_per_second(300)
1445 default_date = set_date(1980, 1, 1, 0, 0, 0, 150)
1446 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1447 log_date=.true., default=default_date)
1448
1449 call close_param_file(param)
1450end subroutine test_log_param_time_as_date_default
1451
1452
1453subroutine test_log_param_time_as_date_tick
1454 type(param_file_type) :: param
1455 type(time_type) :: sample
1456 character(len=*), parameter :: desc = "Parameter description"
1457
1458 call set_calendar_type(noleap)
1459 call create_test_file(param_filename)
1460
1461 call open_param_file(param_filename, param)
1462 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1463 log_date=.true.)
1464 call close_param_file(param)
1465end subroutine test_log_param_time_as_date_tick
1466
1467
1468subroutine test_log_param_time_with_unit
1469 type(param_file_type) :: param
1470 type(time_type) :: sample
1471 type(time_type) :: default_date
1472 character(len=*), parameter :: desc = "Parameter description"
1473 character(len=*), parameter :: sample_units = "days since whatever"
1474
1475 call set_calendar_type(noleap)
1476 call create_test_file(param_filename)
1477
1478 call set_ticks_per_second(60)
1479 sample = set_date(1980, 1, 1, 0, 0, 0, 30)
1480
1481 default_date = set_date(1980, 1, 1, 0, 0, 0, 30)
1482
1483 call open_param_file(param_filename, param)
1484 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1485 units=sample_units, timeunit=86400., default=default_date)
1486 call close_param_file(param)
1487end subroutine test_log_param_time_with_unit
1488
1489
1490subroutine test_log_param_time_with_timeunit
1491 type(param_file_type) :: param
1492 type(time_type) :: sample
1493 integer :: i
1494 character(len=*), parameter :: desc = "Parameter description"
1495 real, parameter :: timeunits(5) = [1., 3600., 86400., 3.1e7, 1e8]
1496
1497 call set_calendar_type(noleap)
1498 call create_test_file(param_filename)
1499
1500 call open_param_file(param_filename, param)
1501 do i = 1,5
1502 call log_param(param, module_name, sample_param_name, sample, desc=desc, &
1503 timeunit=timeunits(i))
1504 enddo
1505 call close_param_file(param)
1506end subroutine test_log_param_time_with_timeunit
1507
1508!----
1509
1510subroutine test_get_param_int
1511 type(param_file_type) :: param
1512 integer :: sample
1513
1514 call create_test_file(param_filename)
1515
1516 call open_param_file(param_filename, param)
1517 call get_param(param, module_name, sample_param_name, sample)
1518 call close_param_file(param)
1519end subroutine test_get_param_int
1520
1521
1522subroutine test_get_param_int_no_read_no_log
1523 type(param_file_type) :: param
1524 integer :: sample
1525
1526 call create_test_file(param_filename)
1527
1528 call open_param_file(param_filename, param)
1529 call get_param(param, module_name, sample_param_name, sample, &
1530 do_not_read=.true., do_not_log=.true.)
1531 call close_param_file(param)
1532end subroutine test_get_param_int_no_read_no_log
1533
1534
1535subroutine test_get_param_int_array
1536 type(param_file_type) :: param
1537 integer :: sample(3)
1538
1539 call create_test_file(param_filename)
1540
1541 call open_param_file(param_filename, param)
1542 call get_param(param, module_name, sample_param_name, sample)
1543 call close_param_file(param)
1544end subroutine test_get_param_int_array
1545
1546
1547subroutine test_get_param_int_array_no_read_no_log
1548 type(param_file_type) :: param
1549 integer :: sample(3)
1550
1551 call create_test_file(param_filename)
1552
1553 call open_param_file(param_filename, param)
1554 call get_param(param, module_name, sample_param_name, sample, &
1555 do_not_read=.true., do_not_log=.true.)
1556 call close_param_file(param)
1557end subroutine test_get_param_int_array_no_read_no_log
1558
1559
1560subroutine test_get_param_real
1561 type(param_file_type) :: param
1562 real :: sample
1563
1564 call create_test_file(param_filename)
1565
1566 call open_param_file(param_filename, param)
1567 call get_param(param, module_name, sample_param_name, sample, units="")
1568 call close_param_file(param)
1569end subroutine test_get_param_real
1570
1571
1572subroutine test_get_param_real_no_read_no_log
1573 type(param_file_type) :: param
1574 real :: sample
1575
1576 call create_test_file(param_filename)
1577
1578 call open_param_file(param_filename, param)
1579 call get_param(param, module_name, sample_param_name, sample, units="", &
1580 do_not_read=.true., do_not_log=.true.)
1581 call close_param_file(param)
1582end subroutine test_get_param_real_no_read_no_log
1583
1584
1585subroutine test_get_param_real_array
1586 type(param_file_type) :: param
1587 real :: sample(3)
1588
1589 call create_test_file(param_filename)
1590
1591 call open_param_file(param_filename, param)
1592 call get_param(param, module_name, sample_param_name, sample, units="")
1593 call close_param_file(param)
1594end subroutine test_get_param_real_array
1595
1596
1597subroutine test_get_param_real_array_no_read_no_log
1598 type(param_file_type) :: param
1599 real :: sample(3)
1600
1601 call create_test_file(param_filename)
1602
1603 call open_param_file(param_filename, param)
1604 call get_param(param, module_name, sample_param_name, sample, units="", &
1605 do_not_read=.true., do_not_log=.true.)
1606 call close_param_file(param)
1607end subroutine test_get_param_real_array_no_read_no_log
1608
1609
1610subroutine test_get_param_char
1611 type(param_file_type) :: param
1612 character(len=8) :: sample
1613
1614 call create_test_file(param_filename)
1615
1616 call open_param_file(param_filename, param)
1617 call get_param(param, module_name, sample_param_name, sample)
1618 call close_param_file(param)
1619end subroutine test_get_param_char
1620
1621
1622subroutine test_get_param_char_no_read_no_log
1623 type(param_file_type) :: param
1624 character(len=8) :: sample
1625
1626 call create_test_file(param_filename)
1627
1628 call open_param_file(param_filename, param)
1629 call get_param(param, module_name, sample_param_name, sample, &
1630 do_not_read=.true., do_not_log=.true.)
1631 call close_param_file(param)
1632end subroutine test_get_param_char_no_read_no_log
1633
1634
1635subroutine test_get_param_char_array
1636 type(param_file_type) :: param
1637 character(len=8) :: sample(3)
1638
1639 call create_test_file(param_filename)
1640
1641 call open_param_file(param_filename, param)
1642 call get_param(param, module_name, sample_param_name, sample)
1643 call close_param_file(param)
1644end subroutine test_get_param_char_array
1645
1646
1647subroutine test_get_param_logical
1648 type(param_file_type) :: param
1649 logical :: sample
1650
1651 call create_test_file(param_filename)
1652
1653 call open_param_file(param_filename, param)
1654 call get_param(param, module_name, sample_param_name, sample)
1655 call close_param_file(param)
1656end subroutine test_get_param_logical
1657
1658
1659subroutine test_get_param_logical_no_read_no_log
1660 type(param_file_type) :: param
1661 logical :: sample
1662
1663 call create_test_file(param_filename)
1664
1665 call open_param_file(param_filename, param)
1666 call get_param(param, module_name, sample_param_name, sample, &
1667 do_not_read=.true., do_not_log=.true.)
1668 call close_param_file(param)
1669end subroutine test_get_param_logical_no_read_no_log
1670
1671
1672subroutine test_get_param_logical_default
1673 type(param_file_type) :: param
1674 logical :: sample
1675 logical, parameter :: default_value = .false.
1676
1677 call create_test_file(param_filename)
1678
1679 call open_param_file(param_filename, param)
1680 call get_param(param, module_name, sample_param_name, sample, &
1681 default=default_value)
1682 call close_param_file(param)
1683end subroutine test_get_param_logical_default
1684
1685
1686subroutine test_get_param_time
1687 type(param_file_type) :: param
1688 type(time_type) :: sample
1689
1690 call create_test_file(param_filename)
1691
1692 call open_param_file(param_filename, param)
1693 call get_param(param, module_name, sample_param_name, sample)
1694 call close_param_file(param)
1695end subroutine test_get_param_time
1696
1697
1698subroutine test_get_param_time_no_read_no_log
1699 type(param_file_type) :: param
1700 type(time_type) :: sample
1701
1702 call create_test_file(param_filename)
1703
1704 call open_param_file(param_filename, param)
1705 call get_param(param, module_name, sample_param_name, sample, &
1706 do_not_read=.true., do_not_log=.true.)
1707 call close_param_file(param)
1708end subroutine test_get_param_time_no_read_no_log
1709
1710
1711! Utility functions
1712! TODO: Move to a generic testing module
1713
1714subroutine cleanup_file_parser
1715 integer :: i
1716
1717 call delete_test_file(param_filename)
1718 do i = 1, 4
1719 call delete_test_file("MOM_parameter_doc."//param_docfiles(i))
1720 enddo
1721
1722 call set_calendar_type(no_calendar)
1723end subroutine cleanup_file_parser
1724
1725
1726subroutine run_file_parser_tests
1727 ! testing...
1728 type(testsuite) :: suite
1729
1730 ! Delete any pre-existing test parameter files
1731 call cleanup_file_parser
1732
1733 ! Build the test suite
1734 suite = testsuite()
1735 suite%cleanup => cleanup_file_parser
1736
1737 call suite%add(test_open_param_file, "test_open_param_file")
1738
1739 call suite%add(test_close_param_file_quiet, "test_close_param_file_quiet")
1740
1741 call suite%add(test_open_param_file_component, "test_open_param_file_component", &
1742 cleanup=cleanup_open_param_file_component)
1743
1744 call suite%add(test_open_param_file_docdir, "test_open_param_file_docdir")
1745
1746 call suite%add(test_open_param_file_empty_filename, &
1747 "test_open_param_file_empty_filename", fatal=.true.)
1748
1749 call suite%add(test_open_param_file_long_name, &
1750 "test_open_param_file_longname")
1751
1752 call suite%add(test_missing_param_file, "test_missing_param_file", &
1753 fatal=.true.)
1754
1755 call suite%add(test_open_param_file_ioerr, "test_open_param_file_ioerr", &
1756 fatal=.true., cleanup=cleanup_open_param_file_ioerr)
1757
1758 call suite%add(test_open_param_file_checkable, &
1759 "test_open_param_file_checkable")
1760
1761 call suite%add(test_reopen_param_file, "test_reopen_param_file")
1762
1763 call suite%add(test_open_param_file_netcdf, "test_open_param_file_netcdf", &
1764 fatal=.true., cleanup=cleanup_open_param_file_netcdf)
1765
1766 call suite%add(test_open_param_file_no_doc, "test_open_param_file_no_doc")
1767
1768 call suite%add(test_read_param_int, "test_read_param_int")
1769
1770 call suite%add(test_read_param_int_missing, "test_read_param_int_missing", &
1771 fatal=.true.)
1772
1773 call suite%add(test_read_param_int_undefined, &
1774 "test_read_param_int_undefined", fatal=.true.)
1775
1776 call suite%add(test_read_param_int_type_err, &
1777 "test_read_param_int_type_err", fatal=.true.)
1778
1779 call suite%add(test_read_param_int_array, "test_read_param_int_array")
1780
1781 call suite%add(test_read_param_int_array_missing, &
1782 "test_read_param_int_array_missing", fatal=.true.)
1783
1784 call suite%add(test_read_param_int_array_undefined, &
1785 "test_read_param_int_array_undefined", fatal=.true.)
1786
1787 call suite%add(test_read_param_int_array_type_err, &
1788 "test_read_param_int_array_type_err", fatal=.true.)
1789
1790 call suite%add(test_read_param_real, "test_read_param_real")
1791
1792 call suite%add(test_read_param_real_missing, &
1793 "test_read_param_real_missing", fatal=.true.)
1794
1795 call suite%add(test_read_param_real_undefined, &
1796 "test_read_param_real_undefined", fatal=.true.)
1797
1798 call suite%add(test_read_param_real_type_err, &
1799 "test_read_param_real_type_err", fatal=.true.)
1800
1801 call suite%add(test_read_param_real_array, "test_read_param_real_array")
1802
1803 call suite%add(test_read_param_real_array_missing, &
1804 "test_read_param_real_array_missing", fatal=.true.)
1805
1806 call suite%add(test_read_param_real_array_undefined, &
1807 "test_read_param_real_array_undefined", fatal=.true.)
1808
1809 call suite%add(test_read_param_real_array_type_err, &
1810 "test_read_param_real_array_type_err", fatal=.true.)
1811
1812 call suite%add(test_read_param_logical, "test_read_param_logical")
1813
1814 call suite%add(test_read_param_logical_missing, &
1815 "test_read_param_logical_missing", fatal=.true.)
1816
1817 call suite%add(test_read_param_char_no_delim, &
1818 "test_read_param_char_no_delim")
1819
1820 call suite%add(test_read_param_char_quote_delim, &
1821 "test_read_param_char_quote_delim")
1822
1823 call suite%add(test_read_param_char_apostrophe_delim, &
1824 "test_read_param_char_apostrophe_delim")
1825
1826 call suite%add(test_read_param_char_missing, &
1827 "test_read_param_char_missing", fatal=.true.)
1828
1829 call suite%add(test_read_param_char_array, "test_read_param_char_array")
1830
1831 call suite%add(test_read_param_char_array_missing, &
1832 "test_read_param_char_array_missing", fatal=.true.)
1833
1834 call suite%add(test_read_param_time_date, "test_read_param_time_date")
1835
1836 call suite%add(test_read_param_time_date_bad_format, &
1837 "test_read_param_time_date_bad_format", fatal=.true.)
1838
1839 call suite%add(test_read_param_time_tuple, "test_read_param_time_tuple")
1840
1841 call suite%add(test_read_param_time_bad_tuple, &
1842 "test_read_param_time_bad_tuple", fatal=.true.)
1843
1844 call suite%add(test_read_param_time_bad_tuple_values, &
1845 "test_read_param_time_bad_tuple_values", fatal=.true.)
1846
1847 call suite%add(test_read_param_time_missing, &
1848 "test_read_param_time_missing", fatal=.true.)
1849
1850 call suite%add(test_read_param_time_undefined, &
1851 "test_read_param_time_undefined", fatal=.true.)
1852
1853 call suite%add(test_read_param_time_type_err, &
1854 "test_read_param_time_type_err", fatal=.true.)
1855
1856 call suite%add(test_read_param_time_unit, "test_read_param_time_unit")
1857
1858 call suite%add(test_read_param_unused_fatal, &
1859 "test_read_param_unused_fatal", fatal=.true.)
1860
1861 call suite%add(test_read_param_unused_fatal_absent, &
1862 "test_read_param_unused_fatal_absent")
1863
1864 call suite%add(test_read_param_multiline_comment, &
1865 "test_read_param_multiline_comment")
1866
1867 call suite%add(test_read_param_multiline_comment_unclosed, &
1868 "test_read_param_multiline_comment_unclosed", fatal=.true.)
1869
1870 call suite%add(test_read_param_multiline_param, &
1871 "test_read_param_multiline_param")
1872
1873 call suite%add(test_read_param_multiline_param_fatal_unused, &
1874 "test_read_param_multiline_param_fatal_unused")
1875
1876 call suite%add(test_read_param_multiline_param_unclosed, &
1877 "test_read_param_multiline_param_unclosed", fatal=.true.)
1878
1879 call suite%add(test_read_param_replace_tabs, "test_read_param_replace_tabs")
1880
1881 call suite%add(test_read_param_pad_equals, "test_read_param_pad_equals")
1882
1883 call suite%add(test_read_param_misplaced_quote, &
1884 "test_read_param_misplaced_quote", fatal=.true.)
1885
1886 call suite%add(test_read_param_define, "test_read_param_define")
1887
1888 call suite%add(test_read_param_define_as_flag, &
1889 "test_read_param_define_as_flag")
1890
1891 call suite%add(test_read_param_override, "test_read_param_override")
1892
1893 call suite%add(test_read_param_override_misplaced, &
1894 "test_read_param_override_misplaced", fatal=.true.)
1895
1896 call suite%add(test_read_param_override_twice, &
1897 "test_read_param_override_twice", fatal=.true.)
1898
1899 call suite%add(test_read_param_override_twice_absent, &
1900 "test_read_param_override_twice_absent", fatal=.true.)
1901
1902 call suite%add(test_read_param_override_repeat, &
1903 "test_read_param_override_repeat", fatal=.true.)
1904
1905 call suite%add(test_read_param_override_warn_chain, &
1906 "test_read_param_override_warn_chain")
1907
1908 call suite%add(test_read_param_override_no_def, &
1909 "test_read_param_override_no_def", fatal=.true.)
1910
1911 call suite%add(test_read_param_assign_after_override, &
1912 "test_read_param_assign_after_override")
1913
1914 call suite%add(test_read_param_assign_twice, &
1915 "test_read_param_assign_twice", fatal=.true.)
1916
1917 call suite%add(test_read_param_assign_repeat, &
1918 "test_read_param_assign_repeat")
1919
1920 call suite%add(test_read_param_null_stmt, "test_read_param_null_stmt", &
1921 fatal=.true.)
1922
1923 call suite%add(test_read_param_assign_in_define, &
1924 "test_read_param_assign_in_define", fatal=.true.)
1925
1926 call suite%add(test_read_param_block, "test_read_param_block")
1927
1928 call suite%add(test_read_param_block_absent, "test_read_param_block_absent")
1929
1930 ! FIXME: Test does not pass
1931 !call suite%add(test_read_param_block_stack, "test_read_param_block_stack")
1932
1933 call suite%add(test_read_param_block_inline_stack, &
1934 "test_read_param_block_inline_stack")
1935
1936 call suite%add(test_read_param_block_empty_pop, &
1937 "test_read_param_block_empty_pop", fatal=.true.)
1938
1939 call suite%add(test_read_param_block_close_unopened, &
1940 "test_read_param_block_close_unopened", fatal=.true.)
1941
1942 call suite%add(test_read_param_block_close_unnamed, &
1943 "test_read_param_block_close_unnamed", fatal=.true.)
1944
1945 call suite%add(test_read_param_block_unmatched, &
1946 "test_read_param_block_unmatched", fatal=.true.)
1947
1948 call suite%add(test_read_param_block_outside_block, &
1949 "test_read_param_block_outside_block")
1950
1951 call suite%add(test_open_unallocated_block, "test_open_unallocated_block", &
1952 fatal=.true.)
1953
1954 call suite%add(test_close_unallocated_block, &
1955 "test_close_unallocated_block", fatal=.true.)
1956
1957 call suite%add(test_clear_unallocated_block, &
1958 "test_clear_unallocated_block", fatal=.true.)
1959
1960 call suite%add(test_log_version_cs, "test_log_version_cs")
1961
1962 call suite%add(test_log_version_plain, "test_log_version_plain")
1963
1964 call suite%add(test_log_param_int, "test_log_param_int")
1965
1966 call suite%add(test_log_param_int_array, "test_log_param_int_array")
1967
1968 call suite%add(test_log_param_real, "test_log_param_real")
1969
1970 call suite%add(test_log_param_real_array, "test_log_param_real_array")
1971
1972 call suite%add(test_log_param_time, "test_log_param_time")
1973
1974 call suite%add(test_log_param_time_as_date, "test_log_param_time_as_date")
1975
1976 call suite%add(test_log_param_time_as_date_default, &
1977 "test_log_param_time_as_date_default")
1978
1979 call suite%add(test_log_param_time_as_date_tick, &
1980 "test_log_param_time_as_date_tick")
1981
1982 call suite%add(test_log_param_time_with_unit, &
1983 "test_log_param_time_with_unit")
1984
1985 call suite%add(test_log_param_time_with_timeunit, &
1986 "test_log_param_time_with_timeunit")
1987
1988 call suite%add(test_get_param_int, "test_get_param_int")
1989
1990 call suite%add(test_get_param_int_no_read_no_log, &
1991 "test_get_param_int_no_read_no_log")
1992
1993 call suite%add(test_get_param_int_array, "test_get_param_int_array")
1994
1995 call suite%add(test_get_param_int_array_no_read_no_log, &
1996 "test_get_param_int_array_no_read_no_log")
1997
1998 call suite%add(test_get_param_real, "test_get_param_real")
1999
2000 call suite%add(test_get_param_real_no_read_no_log, &
2001 "test_get_param_real_n_read_no_log")
2002
2003 call suite%add(test_get_param_real_array, "test_get_param_real_array")
2004
2005 call suite%add(test_get_param_real_array_no_read_no_log, &
2006 "test_get_param_real_array_no_read_no_log")
2007
2008 call suite%add(test_get_param_char, "test_get_param_char")
2009
2010 call suite%add(test_get_param_char_no_read_no_log, &
2011 "test_get_param_char_no_read_no_log")
2012
2013 call suite%add(test_get_param_char_array, "test_get_param_char_array")
2014
2015 call suite%add(test_get_param_logical, "test_get_param_logical")
2016
2017 call suite%add(test_get_param_logical_default, &
2018 "test_get_param_logical_default")
2019
2020 call suite%add(test_get_param_logical_no_read_no_log, &
2021 "test_get_param_logical_no_read_no_log")
2022
2023 call suite%add(test_get_param_time, "test_get_param_time")
2024
2025 call suite%add(test_get_param_time_no_read_no_log, &
2026 "test_get_param_time_np_read_no_log")
2027
2028 call suite%run()
2029end subroutine run_file_parser_tests
2030
2031end module mom_file_parser_tests