JSON/jf_test_3 [ Unittest ]

[ Top ] [ Unittest ]

NAME

    jf_test_3

DESCRIPTION

    Third unit test

USES

    json_module
    iso_fortran_env (intrinsic)

HISTORY

    Izaak Beekman : 2/18/2015 : Created (refactoried original json_example.f90 file)

LICENSE

    JSON-FORTRAN: A Fortran 2008 JSON API
    https://github.com/jacobwilliams/json-fortran

    Copyright (c) 2014, Jacob Williams
    All rights reserved.

    Redistribution and use in source and binary forms, with or without modification,
    are permitted provided that the following conditions are met:

    * Redistributions of source code must retain the above copyright notice, this
      list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above copyright notice, this
      list of conditions and the following disclaimer in the documentation and/or
      other materials provided with the distribution.

    * The names of its contributors may not be used to endorse or promote products
      derived from this software without specific prior written permission.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
    ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
    DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
    ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
    (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
    ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
    SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

SOURCE

 51 module jf_test_3_mod
 52 
 53     use json_module
 54     use, intrinsic :: iso_fortran_env , only: error_unit, output_unit, wp => real64
 55 
 56     implicit none
 57 
 58     character(len=*),parameter :: dir = '../files/'               !working directory
 59     character(len=*),parameter :: filename2 = 'test2.json'
 60 
 61 contains
 62 
 63     subroutine test_3(error_cnt)
 64 
 65 !   Read the file generated in jf_test_2, and extract some data from it.
 66 
 67     implicit none
 68 
 69     integer,intent(out) :: error_cnt
 70     integer :: ival
 71     character(len=:),allocatable :: cval
 72     real(wp) :: rval
 73     type(json_file) :: json    !the JSON structure read from the file:
 74     integer :: i
 75     character(len=10) :: str
 76     real(wp),dimension(:),allocatable :: rvec
 77 
 78     error_cnt = 0
 79     call json_initialize()
 80     if (json_failed()) then
 81         call json_print_error_message(error_unit)
 82         error_cnt = error_cnt + 1
 83     end if
 84 
 85     write(error_unit,'(A)') ''
 86     write(error_unit,'(A)') '================================='
 87     write(error_unit,'(A)') '   EXAMPLE 3'
 88     write(error_unit,'(A)') '================================='
 89     write(error_unit,'(A)') ''
 90 
 91     ! parse the json file:
 92     write(error_unit,'(A)') ''
 93     write(error_unit,'(A)') 'parsing file: '//dir//filename2
 94 
 95     call json%load_file(filename = dir//filename2)
 96 
 97     if (json_failed()) then    !if there was an error reading the file
 98 
 99         call json_print_error_message(error_unit)
100         error_cnt = error_cnt + 1
101 
102     else
103 
104         write(error_unit,'(A)') ''
105         write(error_unit,'(A)') 'reading data from file...'
106         !get scalars:
107         write(error_unit,'(A)') ''
108         call json%get('inputs.integer_scalar', ival)
109         if (json_failed()) then
110             call json_print_error_message(error_unit)
111             error_cnt = error_cnt + 1
112         else
113             write(error_unit,'(A,1X,I5)') 'inputs.integer_scalar = ',ival
114         end if
115         !get one element from a vector:
116         write(error_unit,'(A)') ''
117         call json%get('trajectory(1).DATA(2)', rval)
118         if (json_failed()) then
119             call json_print_error_message(error_unit)
120             error_cnt = error_cnt + 1
121         else
122             write(error_unit,'(A,1X,F30.16)') 'trajectory(1).DATA(2) = ',rval
123         end if
124         !get vectors:
125         do i=1,4
126 
127             write(str,fmt='(I10)') i
128             str = adjustl(str)
129 
130             write(error_unit,'(A)') ''
131             call json%get('trajectory('//trim(str)//').VARIABLE', cval)
132             if (json_failed()) then
133 
134                 call json_print_error_message(error_unit)
135                 error_cnt = error_cnt + 1
136 
137             else
138 
139                 write(error_unit,'(A)') 'trajectory('//trim(str)//').VARIABLE = '//trim(cval)
140 
141                 !...get the vector using the callback method:
142                 call json%get('trajectory('//trim(str)//').DATA', rvec)
143                 if (json_failed()) then
144                     call json_print_error_message(error_unit)
145                     error_cnt = error_cnt + 1
146                 else
147                     write(error_unit,'(A,1X,*(F30.16,1X))') 'trajectory('//trim(str)//').DATA = ',rvec
148                 end if
149 
150             end if
151 
152         end do
153 
154     end if
155 
156     ! clean up
157     write(error_unit,'(A)') ''
158     write(error_unit,'(A)') 'destroy...'
159     call json%destroy()
160     if (json_failed()) then
161         call json_print_error_message(error_unit)
162         error_cnt = error_cnt + 1
163     end if
164 
165     end subroutine test_3
166 
167 end module jf_test_3_mod
168 
169 program jf_test_3
170     use jf_test_3_mod , only: test_3
171     implicit none
172     integer :: n_errors
173     n_errors = 0
174     call test_3(n_errors)
175     if (n_errors /= 0) stop 1
176 end program jf_test_3