Skip to content

Commit 56603f0

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #492 from jacobwilliams/develop
Develop
2 parents 26d2283 + 938227c commit 56603f0

File tree

11 files changed

+179
-42
lines changed

11 files changed

+179
-42
lines changed

‎CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ cmake_minimum_required ( VERSION 2.8.8 FATAL_ERROR )
1414
# Use MSVS folders to organize projects on windows
1515
set_property(GLOBAL PROPERTY USE_FOLDERS ON)
1616

17-
set(PROJECT_DESCRIPTION "A Fortran 2008 JSON API")
17+
set(PROJECT_DESCRIPTION "A Modern Fortran JSON API")
1818
set(PROJECT_URL "https://github.com/jacobwilliams/json-fortran")
1919

2020
# Set the type/configuration of build to perform

‎LICENSE

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
JSON-Fortran: A Fortran 2008 JSON API
1+
JSON-Fortran: A Modern Fortran JSON API
22
<https://github.com/jacobwilliams/json-fortran>
33

44
Copyright (c) 2014-2021, Jacob Williams

‎README.md

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
1-
JSON-Fortran
1+
![JSON-Fortran](/media/json-fortran-logo-2.png)
22
============
33

44
[![GitHub release](https://img.shields.io/github/release/jacobwilliams/json-fortran.svg?style=plastic)](https://github.com/jacobwilliams/json-fortran/releases/latest)
5-
A Fortran 2008 JSON API
5+
A Modern Fortran JSON API
66

77
<!-- markdown-toc start - Don't edit this section. Run M-x markdown-toc/generate-toc again -->
88
**Table of Contents**
@@ -34,7 +34,7 @@ for a list of changes since the latest release.
3434
Brief description
3535
---------------
3636

37-
A user-friendly, thread-safe, and object-oriented API for reading and writing [JSON](http://json.org) files, written in modern Fortran.
37+
JSON-Fortran is a user-friendly, thread-safe, and object-oriented API for reading and writing [JSON](http://json.org) files, written in modern Fortran.
3838

3939
[top](#json-fortran)
4040

‎fpm.toml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@ name = "json-fortran"
22
author = "Jacob Williams"
33
copyright = "Copyright (c) 2014-2021, Jacob Williams"
44
license = "BSD"
5-
description = "A Fortran 2008 JSON API"
5+
description = "A Modern Fortran JSON API"
66
homepage = "https://github.com/jacobwilliams/json-fortran"
77
categories = ["io"]
88
keywords = ["JSON"]

‎json-fortran.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
---
22
project: JSON-Fortran
33
summary: ![JSON-Fortran](|media|/json-fortran-logo-2.png)<br>
4-
JSON-Fortran -- A Fortran 2008 JSON API
4+
JSON-Fortran -- A Modern Fortran JSON API
55
author: Jacob Williams
66
src_dir: ./src
77
output_dir: ./doc

‎src/json_module.F90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
!> author: Jacob Williams
33
! license: BSD
44
!
5-
! A Fortran 2008 JSON (JavaScript Object Notation) API.
5+
! A Modern Fortran JSON (JavaScript Object Notation) API.
66
!
77
! This module provides access to [[json_value_module]] and
88
! [[json_file_module]]. For normal JSON-Fortran use, using this module

‎src/json_value_module.F90

Lines changed: 84 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -8141,8 +8141,13 @@ subroutine json_get_integer(json, me, value)
81418141
value = me%int_value
81428142
else
81438143
if (json%strict_type_checking) then
8144-
call json%throw_exception('Error in json_get_integer:'//&
8145-
' Unable to resolve value to integer: '//me%name)
8144+
if (allocated(me%name)) then
8145+
call json%throw_exception('Error in json_get_integer:'//&
8146+
' Unable to resolve value to integer: '//me%name)
8147+
else
8148+
call json%throw_exception('Error in json_get_integer:'//&
8149+
' Unable to resolve value to integer')
8150+
end if
81468151
else
81478152
!type conversions
81488153
select case(me%var_type)
@@ -8158,13 +8163,24 @@ subroutine json_get_integer(json, me, value)
81588163
call string_to_integer(me%str_value,value,status_ok)
81598164
if (.not. status_ok) then
81608165
value = 0_IK
8161-
call json%throw_exception('Error in json_get_integer:'//&
8162-
' Unable to convert string value to integer: me.'//&
8163-
me%name//' = '//trim(me%str_value))
8166+
if (allocated(me%name)) then
8167+
call json%throw_exception('Error in json_get_integer:'//&
8168+
' Unable to convert string value to integer: '//&
8169+
me%name//' = '//trim(me%str_value))
8170+
else
8171+
call json%throw_exception('Error in json_get_integer:'//&
8172+
' Unable to convert string value to integer: '//&
8173+
trim(me%str_value))
8174+
end if
81648175
end if
81658176
case default
8166-
call json%throw_exception('Error in json_get_integer:'//&
8167-
' Unable to resolve value to integer: '//me%name)
8177+
if (allocated(me%name)) then
8178+
call json%throw_exception('Error in json_get_integer:'//&
8179+
' Unable to resolve value to integer: '//me%name)
8180+
else
8181+
call json%throw_exception('Error in json_get_integer:'//&
8182+
' Unable to resolve value to integer')
8183+
end if
81688184
end select
81698185
end if
81708186
end if
@@ -8354,8 +8370,13 @@ subroutine json_get_real(json, me, value)
83548370
value = me%dbl_value
83558371
else
83568372
if (json%strict_type_checking) then
8357-
call json%throw_exception('Error in json_get_real:'//&
8358-
' Unable to resolve value to real: '//me%name)
8373+
if (allocated(me%name)) then
8374+
call json%throw_exception('Error in json_get_real:'//&
8375+
' Unable to resolve value to real: '//me%name)
8376+
else
8377+
call json%throw_exception('Error in json_get_real:'//&
8378+
' Unable to resolve value to real')
8379+
end if
83598380
else
83608381
!type conversions
83618382
select case (me%var_type)
@@ -8371,9 +8392,15 @@ subroutine json_get_real(json, me, value)
83718392
call string_to_real(me%str_value,json%use_quiet_nan,value,status_ok)
83728393
if (.not. status_ok) then
83738394
value = 0.0_RK
8374-
call json%throw_exception('Error in json_get_real:'//&
8375-
' Unable to convert string value to real: me.'//&
8376-
me%name//' = '//trim(me%str_value))
8395+
if (allocated(me%name)) then
8396+
call json%throw_exception('Error in json_get_real:'//&
8397+
' Unable to convert string value to real: '//&
8398+
me%name//' = '//trim(me%str_value))
8399+
else
8400+
call json%throw_exception('Error in json_get_real:'//&
8401+
' Unable to convert string value to real: '//&
8402+
trim(me%str_value))
8403+
end if
83778404
end if
83788405
case (json_null)
83798406
if (ieee_support_nan(value) .and. json%null_to_real_mode/=1_IK) then
@@ -8388,13 +8415,22 @@ subroutine json_get_real(json, me, value)
83888415
value = 0.0_RK
83898416
end select
83908417
else
8391-
call json%throw_exception('Error in json_get_real:'//&
8392-
' Cannot convert null to NaN: '//me%name)
8418+
if (allocated(me%name)) then
8419+
call json%throw_exception('Error in json_get_real:'//&
8420+
' Cannot convert null to NaN: '//me%name)
8421+
else
8422+
call json%throw_exception('Error in json_get_real:'//&
8423+
' Cannot convert null to NaN')
8424+
end if
83938425
end if
83948426
case default
8395-
8396-
call json%throw_exception('Error in json_get_real:'//&
8397-
' Unable to resolve value to real: '//me%name)
8427+
if (allocated(me%name)) then
8428+
call json%throw_exception('Error in json_get_real:'//&
8429+
' Unable to resolve value to real: '//me%name)
8430+
else
8431+
call json%throw_exception('Error in json_get_real:'//&
8432+
' Unable to resolve value to real')
8433+
end if
83988434
end select
83998435
end if
84008436
end if
@@ -8844,9 +8880,14 @@ subroutine json_get_logical(json, me, value)
88448880
value = me%log_value
88458881
else
88468882
if (json%strict_type_checking) then
8847-
call json%throw_exception('Error in json_get_logical: '//&
8848-
'Unable to resolve value to logical: '//&
8849-
me%name)
8883+
if (allocated(me%name)) then
8884+
call json%throw_exception('Error in json_get_logical: '//&
8885+
'Unable to resolve value to logical: '//&
8886+
me%name)
8887+
else
8888+
call json%throw_exception('Error in json_get_logical: '//&
8889+
'Unable to resolve value to logical')
8890+
end if
88508891
else
88518892
!type conversions
88528893
select case (me%var_type)
@@ -8857,9 +8898,14 @@ subroutine json_get_logical(json, me, value)
88578898
case (json_string)
88588899
value = (me%str_value == true_str)
88598900
case default
8860-
call json%throw_exception('Error in json_get_logical: '//&
8861-
'Unable to resolve value to logical: '//&
8862-
me%name)
8901+
if (allocated(me%name)) then
8902+
call json%throw_exception('Error in json_get_logical: '//&
8903+
'Unable to resolve value to logical: '//&
8904+
me%name)
8905+
else
8906+
call json%throw_exception('Error in json_get_logical: '//&
8907+
'Unable to resolve value to logical')
8908+
end if
88638909
end select
88648910
end if
88658911
end if
@@ -9046,8 +9092,13 @@ subroutine json_get_string(json, me, value)
90469092
else
90479093

90489094
if (json%strict_type_checking) then
9049-
call json%throw_exception('Error in json_get_string:'//&
9050-
' Unable to resolve value to string: '//me%name)
9095+
if (allocated(me%name)) then
9096+
call json%throw_exception('Error in json_get_string:'//&
9097+
' Unable to resolve value to string: '//me%name)
9098+
else
9099+
call json%throw_exception('Error in json_get_string:'//&
9100+
' Unable to resolve value to string')
9101+
end if
90519102
else
90529103

90539104
select case (me%var_type)
@@ -9094,11 +9145,14 @@ subroutine json_get_string(json, me, value)
90949145
value = null_str
90959146

90969147
case default
9097-
9098-
call json%throw_exception('Error in json_get_string: '//&
9099-
'Unable to resolve value to characters: '//&
9100-
me%name)
9101-
9148+
if (allocated(me%name)) then
9149+
call json%throw_exception('Error in json_get_string: '//&
9150+
'Unable to resolve value to characters: '//&
9151+
me%name)
9152+
else
9153+
call json%throw_exception('Error in json_get_string: '//&
9154+
'Unable to resolve value to characters')
9155+
end if
91029156
end select
91039157

91049158
end if

‎src/tests/jf_test_48.F90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ subroutine test_48(error_cnt)
3737
call json%initialize()
3838
if (json%failed()) then
3939
call json%print_error_message(error_unit)
40-
error_cnt = error_cnt + 1
40+
error_cnt = error_cnt + 1
4141
end if
4242

4343
write(error_unit,'(A)') 'open file'
@@ -71,7 +71,7 @@ subroutine test_48(error_cnt)
7171
write(error_unit,'(A)') 'Success'
7272
else
7373
write(error_unit,'(A)') 'Failed'
74-
end if
74+
end if
7575

7676
write(error_unit,'(A)') ''
7777

‎src/tests/jf_test_49.F90

Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
!*****************************************************************************************
2+
!>
3+
! Module for the 49th unit test.
4+
5+
module jf_test_49_mod
6+
7+
use json_module, wp => json_RK, IK => json_IK, LK => json_LK, CK => json_CK
8+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
9+
10+
implicit none
11+
12+
private
13+
public :: test_49
14+
15+
contains
16+
17+
subroutine test_49(error_cnt)
18+
19+
!! 49th unit test. see Issue #488
20+
21+
implicit none
22+
23+
integer,intent(out) :: error_cnt
24+
25+
type(json_file) :: json
26+
integer :: i !! counter
27+
28+
integer,parameter :: n_repeat = 1000 !! number of time to repeat the test
29+
character(kind=CK,len=*),parameter :: json_string = CK_'{"Substance":[]}' !! string to deserialize
30+
31+
write(error_unit,'(A)') ''
32+
write(error_unit,'(A)') '================================='
33+
write(error_unit,'(A)') ' EXAMPLE 49'
34+
write(error_unit,'(A)') '================================='
35+
write(error_unit,'(A)') ''
36+
37+
error_cnt = 0
38+
39+
do i = 1, n_repeat
40+
call json%deserialize(json_string)
41+
if (json%failed()) then
42+
call json%print_error_message(error_unit)
43+
error_cnt = error_cnt + 1
44+
call json%destroy()
45+
exit
46+
end if
47+
call json%destroy()
48+
end do
49+
50+
if (error_cnt==0) then
51+
write(error_unit,'(A)') 'Success'
52+
else
53+
write(error_unit,'(A)') 'Failed'
54+
end if
55+
56+
write(error_unit,'(A)') ''
57+
58+
end subroutine test_49
59+
60+
end module jf_test_49_mod
61+
!*****************************************************************************************
62+
63+
!*****************************************************************************************
64+
#ifndef INTEGRATED_TESTS
65+
program jf_test_49
66+
67+
use jf_test_49_mod , only: test_49
68+
69+
implicit none
70+
integer :: n_errors
71+
72+
call test_49(n_errors)
73+
if (n_errors /= 0) stop 1
74+
75+
end program jf_test_49
76+
#endif
77+
!*****************************************************************************************

‎visual_studio/jsonfortrantest/jsonfortrantest.f90

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,8 @@ program jsonfortrantest
5454
use jf_test_45_mod , only: test_45
5555
use jf_test_46_mod , only: test_46
5656
use jf_test_47_mod , only: test_47
57+
use jf_test_48_mod , only: test_48
58+
use jf_test_49_mod , only: test_49
5759

5860
implicit none
5961

@@ -108,6 +110,8 @@ program jsonfortrantest
108110
call test_45(n_errors); if (n_errors /= 0) stop 1
109111
call test_46(n_errors); if (n_errors /= 0) stop 1
110112
call test_47(n_errors); if (n_errors /= 0) stop 1
113+
call test_48(n_errors); if (n_errors /= 0) stop 1
114+
call test_49(n_errors); if (n_errors /= 0) stop 1
111115

112116
end program jsonfortrantest
113117
!*****************************************************************************************

0 commit comments

Comments
 (0)