Skip to content

Commit c012823

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #382 from jacobwilliams/381-new-constructors
New json_file constructors
2 parents 0e956b2 + 4a656f9 commit c012823

File tree

4 files changed

+309
-7
lines changed

4 files changed

+309
-7
lines changed

‎src/json_file_module.F90

Lines changed: 164 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -267,15 +267,16 @@ module json_file_module
267267
!> author: Izaak Beekman
268268
! date: 07/23/2015
269269
!
270-
! Structure constructor to initialize a [[json_file(type)]] object
271-
! with an existing [[json_value]] object, and either the [[json_core(type)]]
272-
! settings or a [[json_core(type)]] instance.
270+
! Structure constructor to initialize a [[json_file(type)]]
271+
! object with an existing [[json_value]] object or a JSON
272+
! string, and either the [[json_core(type)]] settings or a
273+
! [[json_core(type)]] instance.
273274
!
274275
!### Example
275276
!
276277
!```fortran
277278
! ...
278-
! type(json_file) :: my_file
279+
! type(json_file) :: my_file
279280
! type(json_value),pointer :: json_object
280281
! type(json_core) :: json_core_object
281282
! ...
@@ -285,10 +286,17 @@ module json_file_module
285286
! !or:
286287
! my_file = json_file(json_object,verbose=.true.)
287288
! !or:
289+
! my_file = json_file('{"x": [1]}',verbose=.true.)
290+
! !or:
288291
! my_file = json_file(json_object,json_core_object)
292+
! !or:
293+
! my_file = json_file('{"x": [1]}',json_core_object)
289294
!```
290295
interface json_file
291-
module procedure initialize_json_file, initialize_json_file_v2
296+
module procedure initialize_json_file, &
297+
initialize_json_file_v2, &
298+
MAYBEWRAP(initialize_json_file_from_string), &
299+
MAYBEWRAP(initialize_json_file_from_string_v2)
292300
end interface
293301
!*************************************************************************************
294302

@@ -374,7 +382,9 @@ end subroutine json_file_print_error_message
374382
!@note This does not destroy the data in the file.
375383
!
376384
!@note [[initialize_json_core]], [[json_initialize]],
377-
! [[initialize_json_core_in_file]], and [[initialize_json_file]]
385+
! [[initialize_json_core_in_file]], [[initialize_json_file]],
386+
! [[initialize_json_file_v2]], [[initialize_json_file_from_string]],
387+
! and [[initialize_json_file_from_string_v2]]
378388
! all have a similar interface.
379389

380390
subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
@@ -461,7 +471,9 @@ end subroutine get_json_core_in_file
461471
! It also calls the `initialize()` method.
462472
!
463473
!@note [[initialize_json_core]], [[json_initialize]],
464-
! [[initialize_json_core_in_file]], and [[initialize_json_file]]
474+
! [[initialize_json_core_in_file]], [[initialize_json_file]],
475+
! [[initialize_json_file_v2]], [[initialize_json_file_from_string]],
476+
! and [[initialize_json_file_from_string_v2]]
465477
! all have a similar interface.
466478

467479
function initialize_json_file(p,verbose,compact_reals,&
@@ -528,6 +540,151 @@ function initialize_json_file_v2(json_value_object, json_core_object) &
528540
end function initialize_json_file_v2
529541
!*****************************************************************************************
530542

543+
!*****************************************************************************************
544+
!> author: Jacob Williams
545+
! date: 01/19/2019
546+
!
547+
! Cast a JSON string as a [[json_file(type)]] object.
548+
! It also calls the `initialize()` method.
549+
!
550+
!### Example
551+
!
552+
!```fortran
553+
! type(json_file) :: f
554+
! f = json_file('{"key ": 1}', trailing_spaces_significant=.true.)
555+
!```
556+
!
557+
!@note [[initialize_json_core]], [[json_initialize]],
558+
! [[initialize_json_core_in_file]], [[initialize_json_file]],
559+
! [[initialize_json_file_v2]], [[initialize_json_file_from_string]],
560+
! and [[initialize_json_file_from_string_v2]]
561+
! all have a similar interface.
562+
563+
function initialize_json_file_from_string(str,verbose,compact_reals,&
564+
print_signs,real_format,spaces_per_tab,&
565+
strict_type_checking,&
566+
trailing_spaces_significant,&
567+
case_sensitive_keys,&
568+
no_whitespace,&
569+
unescape_strings,&
570+
comment_char,&
571+
path_mode,&
572+
path_separator,&
573+
compress_vectors,&
574+
allow_duplicate_keys,&
575+
escape_solidus,&
576+
stop_on_error) result(file_object)
577+
578+
implicit none
579+
580+
type(json_file) :: file_object
581+
character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from
582+
#include "json_initialize_arguments.inc"
583+
584+
call file_object%initialize(verbose,compact_reals,&
585+
print_signs,real_format,spaces_per_tab,&
586+
strict_type_checking,&
587+
trailing_spaces_significant,&
588+
case_sensitive_keys,&
589+
no_whitespace,&
590+
unescape_strings,&
591+
comment_char,&
592+
path_mode,&
593+
path_separator,&
594+
compress_vectors,&
595+
allow_duplicate_keys,&
596+
escape_solidus,&
597+
stop_on_error)
598+
599+
call file_object%load_from_string(str)
600+
601+
end function initialize_json_file_from_string
602+
!*****************************************************************************************
603+
604+
!*****************************************************************************************
605+
!>
606+
! Alternate version of [[initialize_json_file_from_string]], where "str" is kind=CDK.
607+
608+
function wrap_initialize_json_file_from_string(str,verbose,compact_reals,&
609+
print_signs,real_format,spaces_per_tab,&
610+
strict_type_checking,&
611+
trailing_spaces_significant,&
612+
case_sensitive_keys,&
613+
no_whitespace,&
614+
unescape_strings,&
615+
comment_char,&
616+
path_mode,&
617+
path_separator,&
618+
compress_vectors,&
619+
allow_duplicate_keys,&
620+
escape_solidus,&
621+
stop_on_error) result(file_object)
622+
623+
implicit none
624+
625+
type(json_file) :: file_object
626+
character(kind=CDK,len=*),intent(in) :: str !! string to load JSON data from
627+
#include "json_initialize_arguments.inc"
628+
629+
file_object = initialize_json_file_from_string(&
630+
to_unicode(str),verbose,compact_reals,&
631+
print_signs,real_format,spaces_per_tab,&
632+
strict_type_checking,&
633+
trailing_spaces_significant,&
634+
case_sensitive_keys,&
635+
no_whitespace,&
636+
unescape_strings,&
637+
comment_char,&
638+
path_mode,&
639+
path_separator,&
640+
compress_vectors,&
641+
allow_duplicate_keys,&
642+
escape_solidus,&
643+
stop_on_error)
644+
645+
end function wrap_initialize_json_file_from_string
646+
!*****************************************************************************************
647+
648+
!*****************************************************************************************
649+
!> author: Jacob Williams
650+
! date: 1/19/2019
651+
!
652+
! Cast a JSON string and a [[json_core(type)]] object
653+
! as a [[json_file(type)]] object.
654+
655+
function initialize_json_file_from_string_v2(str, json_core_object) &
656+
result(file_object)
657+
658+
implicit none
659+
660+
type(json_file) :: file_object
661+
character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from
662+
type(json_core),intent(in) :: json_core_object
663+
664+
file_object%core = json_core_object
665+
call file_object%load_from_string(str)
666+
667+
end function initialize_json_file_from_string_v2
668+
!*****************************************************************************************
669+
670+
!*****************************************************************************************
671+
!>
672+
! Alternate version of [[initialize_json_file_from_string_v2]], where "str" is kind=CDK.
673+
674+
function wrap_initialize_json_file_from_string_v2(str,json_core_object) &
675+
result(file_object)
676+
677+
implicit none
678+
679+
type(json_file) :: file_object
680+
character(kind=CDK,len=*),intent(in) :: str !! string to load JSON data from
681+
type(json_core),intent(in) :: json_core_object
682+
683+
file_object = initialize_json_file_from_string_v2(to_unicode(str),json_core_object)
684+
685+
end function wrap_initialize_json_file_from_string_v2
686+
!*****************************************************************************************
687+
531688
!*****************************************************************************************
532689
!> author: Jacob Williams
533690
!

‎src/tests/jf_test_37.F90

Lines changed: 142 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,142 @@
1+
!*****************************************************************************************
2+
!> author: Jacob Williams
3+
! date: 1/20/2019
4+
!
5+
! Module for the 37th unit test.
6+
7+
module jf_test_37_mod
8+
9+
use json_module, CK => json_CK, CDK => json_CDK
10+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
11+
12+
implicit none
13+
14+
private
15+
public :: test_37
16+
17+
contains
18+
19+
subroutine test_37(error_cnt)
20+
21+
!! Test of `json_file` constructor functions.
22+
23+
implicit none
24+
25+
integer,intent(out) :: error_cnt !! report number of errors to caller
26+
27+
type(json_file) :: f
28+
type(json_value),pointer :: p
29+
type(json_core) :: json
30+
31+
write(error_unit,'(A)') ''
32+
write(error_unit,'(A)') '================================='
33+
write(error_unit,'(A)') ' TEST 37'
34+
write(error_unit,'(A)') '================================='
35+
write(error_unit,'(A)') ''
36+
37+
error_cnt = 0
38+
39+
call json%initialize(no_whitespace=.true.)
40+
41+
call json%parse(p, CK_'{"a": ["1", "2", "3"]}')
42+
f = json_file(p,no_whitespace=.true.)
43+
call f%print_file(error_unit)
44+
write(error_unit,'(A)') ''
45+
call check_for_error()
46+
call f%destroy()
47+
48+
call json%parse(p, CK_'{"b": ["4", "5", "6"]}')
49+
f = json_file(p,json)
50+
call f%print_file(error_unit)
51+
write(error_unit,'(A)') ''
52+
call check_for_error()
53+
call f%destroy()
54+
55+
f = json_file(CK_'{"x": [1,2,3]}',no_whitespace=.true.)
56+
call f%print_file(error_unit)
57+
write(error_unit,'(A)') ''
58+
call check_for_error()
59+
call f%destroy()
60+
61+
f = json_file(CK_'{"y": [4,5,6]}',json)
62+
call f%print_file(error_unit)
63+
write(error_unit,'(A)') ''
64+
call check_for_error()
65+
call f%destroy()
66+
67+
# ifdef USE_UCS4
68+
69+
! also test default character kind when unicode is enabled:
70+
71+
call json%parse(p, CDK_'{"a": ["1", "2", "3"]}')
72+
f = json_file(p,no_whitespace=.true.)
73+
call f%print_file(error_unit)
74+
write(error_unit,'(A)') ''
75+
call check_for_error()
76+
call f%destroy()
77+
78+
call json%parse(p, CDK_'{"b": ["4", "5", "6"]}')
79+
f = json_file(p,json)
80+
call f%print_file(error_unit)
81+
write(error_unit,'(A)') ''
82+
call check_for_error()
83+
call f%destroy()
84+
85+
f = json_file(CDK_'{"x": [1,2,3]}',no_whitespace=.true.)
86+
call f%print_file(error_unit)
87+
write(error_unit,'(A)') ''
88+
call check_for_error()
89+
call f%destroy()
90+
91+
f = json_file(CDK_'{"y": [4,5,6]}',json)
92+
call f%print_file(error_unit)
93+
write(error_unit,'(A)') ''
94+
call check_for_error()
95+
call f%destroy()
96+
97+
# endif
98+
99+
if (error_cnt==0) then
100+
write(error_unit,'(A)') ''
101+
write(error_unit,'(A)') ' Success!'
102+
end if
103+
write(error_unit,'(A)') ''
104+
105+
contains
106+
107+
subroutine check_for_error()
108+
109+
implicit none
110+
111+
if (f%failed()) then
112+
call f%print_error_message(error_unit)
113+
error_cnt = error_cnt + 1
114+
end if
115+
116+
if (json%failed()) then
117+
call json%print_error_message(error_unit)
118+
error_cnt = error_cnt + 1
119+
end if
120+
121+
end subroutine check_for_error
122+
123+
end subroutine test_37
124+
125+
end module jf_test_37_mod
126+
!*****************************************************************************************
127+
128+
#ifndef INTERGATED_TESTS
129+
!*****************************************************************************************
130+
program jf_test_37
131+
132+
!! 37th unit test.
133+
134+
use jf_test_37_mod, only: test_37
135+
implicit none
136+
integer :: n_errors
137+
call test_37(n_errors)
138+
if ( n_errors /= 0) stop 1
139+
140+
end program jf_test_37
141+
!*****************************************************************************************
142+
#endif

‎visual_studio/jsonfortrantest/jsonfortrantest.f90

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@ program jsonfortrantest
4343
use jf_test_34_mod , only: test_34
4444
use jf_test_35_mod , only: test_35
4545
use jf_test_36_mod , only: test_36
46+
use jf_test_37_mod , only: test_37
4647

4748
implicit none
4849

@@ -86,6 +87,7 @@ program jsonfortrantest
8687
call test_34(n_errors); if (n_errors /= 0) stop 1
8788
call test_35(n_errors); if (n_errors /= 0) stop 1
8889
call test_36(n_errors); if (n_errors /= 0) stop 1
90+
call test_37(n_errors); if (n_errors /= 0) stop 1
8991

9092
end program jsonfortrantest
9193
!*****************************************************************************************

‎visual_studio/jsonfortrantest/jsonfortrantest.vfproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -82,5 +82,6 @@
8282
<File RelativePath="..\..\src\tests\jf_test_34.F90"/>
8383
<File RelativePath="..\..\src\tests\jf_test_35.F90"/>
8484
<File RelativePath="..\..\src\tests\jf_test_36.F90"/>
85+
<File RelativePath="..\..\src\tests\jf_test_37.F90"/>
8586
<File RelativePath=".\jsonfortrantest.f90"/></Filter></Files>
8687
<Globals/></VisualStudioProject>

0 commit comments

Comments
 (0)