Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
west-public
West
Commits
cb1b73ef
Commit
cb1b73ef
authored
Jun 06, 2018
by
Marco Govoni
Browse files
Upgraded Json to 6.3.0
parent
bc9c3563
Changes
7
Expand all
Hide whitespace changes
Inline
Side-by-side
Libraries/Json/README
0 → 100644
View file @
cb1b73ef
==========================================
Based on the library: json-fortran v 6.3.0
==========================================
JSON-Fortran: A Fortran 2008 JSON API
<https://github.com/jacobwilliams/json-fortran>
Copyright (c) 2014-2018, 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.
> -----------------------------------------------------------------------------------------
>
> Original FSON License:
>
> Copyright (c) 2012 Joseph A. Levin
>
> Permission is hereby granted, free of charge, to any person obtaining a copy of this
> software and associated documentation files (the "Software"), to deal in the Software
> without restriction, including without limitation the rights to use, copy, modify, merge,
> publish, distribute, sublicense, and/or sell copies of the Software, and to permit
> persons to whom the Software is furnished to do so, subject to the following conditions:
>
> The above copyright notice and this permission notice shall be included in all copies or
> substantial portions of the Software.
>
> THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
> INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
> PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
> LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT
> OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
> DEALINGS IN THE SOFTWARE.
>
> -----------------------------------------------------------------------------------------
Libraries/Json/json_file_module.f90
View file @
cb1b73ef
...
...
@@ -338,7 +338,9 @@
comment_char
,&
path_mode
,&
path_separator
,&
compress_vectors
)
compress_vectors
,&
allow_duplicate_keys
,&
escape_solidus
)
implicit
none
...
...
@@ -355,7 +357,9 @@
comment_char
,&
path_mode
,&
path_separator
,&
compress_vectors
)
compress_vectors
,&
allow_duplicate_keys
,&
escape_solidus
)
end
subroutine
initialize_json_core_in_file
!*****************************************************************************************
...
...
@@ -419,7 +423,9 @@
comment_char
,&
path_mode
,&
path_separator
,&
compress_vectors
)
result
(
file_object
)
compress_vectors
,&
allow_duplicate_keys
,&
escape_solidus
)
result
(
file_object
)
implicit
none
...
...
@@ -438,7 +444,9 @@
comment_char
,&
path_mode
,&
path_separator
,&
compress_vectors
)
compress_vectors
,&
allow_duplicate_keys
,&
escape_solidus
)
if
(
present
(
p
))
file_object
%
p
=>
p
...
...
@@ -1190,7 +1198,7 @@
! date: 12/17/2016
!
! Get an (allocatable length) string vector from a JSON file.
! This is just a wrapper for [[json_get_alloc_string_vec_
with
_path]].
! This is just a wrapper for [[json_get_alloc_string_vec_
by
_path]].
subroutine
json_file_get_alloc_string_vec
(
me
,
path
,
vec
,
ilen
,
found
)
...
...
@@ -1212,7 +1220,7 @@
!*****************************************************************************************
!>
! Alternate version of [[json_file_get_alloc_string_vec]], where "path" is kind=CDK.
! This is just a wrapper for [[wrap_json_get_alloc_string_vec_
with
_path]].
! This is just a wrapper for [[wrap_json_get_alloc_string_vec_
by
_path]].
subroutine
wrap_json_file_get_alloc_string_vec
(
me
,
path
,
vec
,
ilen
,
found
)
...
...
Libraries/Json/json_initialize_arguments.inc
View file @
cb1b73ef
...
...
@@ -59,3 +59,18 @@ logical(LK),intent(in),optional :: compress_vectors
!!
[
Note
:
`no_whitespace`
will
!!
override
this
option
if
necessary
]
.
!!
(
Default
is
False
)
.
logical
(
LK
),
intent
(
in
),
optional
::
allow_duplicate_keys
!!
*
If
True
[
default
]
then
no
special
checks
!!
are
done
to
check
for
duplicate
keys
.
!!
*
If
False
,
then
after
parsing
,
if
any
duplicate
!!
keys
are
found
,
an
error
is
thrown
.
A
call
to
!!
[[
json_value_validate
]]
will
also
check
for
!!
duplicates
.
logical
(
LK
),
intent
(
in
),
optional
::
escape_solidus
!!
*
If
True
then
the
solidus
"`/`"
is
always
escaped
!!
"`\/`"
when
serializing
JSON
!!
*
If
False
[
default
],
then
it
is
not
escaped
.
!!
Note
that
this
option
does
not
affect
parsing
!!
(
both
escaped
and
unescaped
are
still
valid
in
!!
all
cases
)
.
Libraries/Json/json_kinds.f90
View file @
cb1b73ef
...
...
@@ -75,8 +75,8 @@
#elif REAL128
integer
,
parameter
,
public
::
RK
=
real128
!! Default real kind [16 bytes]
#else
!
integer,parameter,public :: RK = real64 !! Default real kind if not specified [8 bytes]
integer
,
parameter
,
public
::
RK
=
selected_real_kind
(
14
,
200
)
!
integer,parameter,public :: RK = real64 !! Default real kind if not specified [8 bytes]
integer
,
parameter
,
public
::
RK
=
selected_real_kind
(
14
,
200
)
#endif
#ifdef INT8
...
...
Libraries/Json/json_parameters.f90
View file @
cb1b73ef
...
...
@@ -52,6 +52,7 @@
character
(
kind
=
CK
,
len
=*
),
parameter
::
dot
=
CK_'.'
!! for [[json_get_by_path]]
character
(
kind
=
CK
,
len
=*
),
parameter
::
tilde
=
CK_'~'
!! RFC 6901 escape character
character
(
kind
=
CK
,
len
=*
),
parameter
::
percent
=
CK_'%'
!! Fortran path separator
character
(
kind
=
CK
,
len
=*
),
parameter
::
single_quote
=
CK_"'"
!! for JSONPath bracket-notation
character
(
kind
=
CK
,
len
=*
),
parameter
::
bspace
=
achar
(
8
,
kind
=
CK
)
character
(
kind
=
CK
,
len
=*
),
parameter
::
horizontal_tab
=
achar
(
9
,
kind
=
CK
)
character
(
kind
=
CK
,
len
=*
),
parameter
::
newline
=
achar
(
10
,
kind
=
CK
)
...
...
Libraries/Json/json_string_utilities.f90
View file @
cb1b73ef
...
...
@@ -126,8 +126,7 @@
! Compute how many digits we need to read
ndigits
=
2
*
len_trim
(
str
)
ndigits_digits
=
floor
(
log10
(
real
(
ndigits
)))
+1
!allocate(character(kind=CDK,len=ndigits_digits) :: digits) ! DOES NOT COMPILE ON BGQ
allocate
(
character
(
len
=
ndigits_digits
)
::
digits
)
allocate
(
character
(
kind
=
CDK
,
len
=
ndigits_digits
)
::
digits
)
write
(
digits
,
'(I0)'
)
ndigits
!gfortran will have a runtime error with * edit descriptor here
! gfortran bug: '*' edit descriptor for ISO_10646 strings does bad stuff.
read
(
str
,
'(I'
//
trim
(
digits
)//
')'
,
iostat
=
ierr
)
ival
!string to integer
...
...
@@ -294,12 +293,14 @@
!
! Add the escape characters to a string for adding to JSON.
subroutine
escape_string
(
str_in
,
str_out
)
subroutine
escape_string
(
str_in
,
str_out
,
escape_solidus
)
implicit
none
character
(
kind
=
CK
,
len
=*
),
intent
(
in
)
::
str_in
character
(
kind
=
CK
,
len
=
:),
allocatable
,
intent
(
out
)
::
str_out
logical
(
LK
),
intent
(
in
)
::
escape_solidus
!! if the solidus (forward slash)
!! is also to be escaped
integer
(
IK
)
::
i
!! counter
integer
(
IK
)
::
ipos
!! accumulated string size
...
...
@@ -309,20 +310,29 @@
#if defined __GFORTRAN__
character
(
kind
=
CK
,
len
=
:),
allocatable
::
tmp
!! workaround for bug in gfortran 6.1
#endif
logical
::
to_be_escaped
!! if there are characters to be escaped
character
(
kind
=
CK
,
len
=*
),
parameter
::
specials
=
quotation_mark
//&
character
(
kind
=
CK
,
len
=*
),
parameter
::
specials
_no_slash
=
quotation_mark
//&
backslash
//&
slash
//&
bspace
//&
formfeed
//&
newline
//&
carriage_return
//&
horizontal_tab
character
(
kind
=
CK
,
len
=*
),
parameter
::
specials
=
specials_no_slash
//
slash
!Do a quick scan for the special characters,
! if any are present, then process the string,
! otherwise, return the string as is.
if
(
scan
(
str_in
,
specials
)
>
0
)
then
if
(
escape_solidus
)
then
to_be_escaped
=
scan
(
str_in
,
specials
)
>
0
else
to_be_escaped
=
scan
(
str_in
,
specials_no_slash
)
>
0
end
if
if
(
to_be_escaped
)
then
str_out
=
repeat
(
space
,
chunk_size
)
ipos
=
1
...
...
@@ -336,9 +346,33 @@
if
(
ipos
+3
>
len
(
str_out
))
str_out
=
str_out
//
repeat
(
space
,
chunk_size
)
select
case
(
c
)
case
(
quotation_mark
,
backslash
,
slash
)
case
(
backslash
)
!test for unicode sequence: '\uXXXX'
![don't add an extra '\' for those]
if
(
i
+5
<=
len
(
str_in
))
then
if
(
str_in
(
i
+1
:
i
+1
)
==
CK_'u'
.and.
&
valid_json_hex
(
str_in
(
i
+2
:
i
+5
)))
then
str_out
(
ipos
:
ipos
)
=
c
ipos
=
ipos
+
1
cycle
end
if
end
if
str_out
(
ipos
:
ipos
+1
)
=
backslash
//
c
ipos
=
ipos
+
2
case
(
quotation_mark
)
str_out
(
ipos
:
ipos
+1
)
=
backslash
//
c
ipos
=
ipos
+
2
case
(
slash
)
if
(
escape_solidus
)
then
str_out
(
ipos
:
ipos
+1
)
=
backslash
//
c
ipos
=
ipos
+
2
else
str_out
(
ipos
:
ipos
)
=
c
ipos
=
ipos
+
1
end
if
case
(
bspace
)
str_out
(
ipos
:
ipos
+1
)
=
'\b'
ipos
=
ipos
+
2
...
...
@@ -388,18 +422,17 @@
!>
! Remove the escape characters from a JSON string and return it.
!
! The escaped characters are denoted by the '\' character:
!````
! '\"' quotation mark
! '\\' reverse solidus
! '\/' solidus
! '\b' backspace
! '\f' formfeed
! '\n' newline (LF)
! '\r' carriage return (CR)
! '\t' horizontal tab
! '\uXXXX' 4 hexadecimal digits
!````
! The escaped characters are denoted by the `\` character:
!
! * `\"` - quotation mark
! * `\\` - reverse solidus
! * `\/` - solidus
! * `\b` - backspace
! * `\f` - formfeed
! * `\n` - newline (LF)
! * `\r` - carriage return (CR)
! * `\t` - horizontal tab
! * `\uXXXX` - 4 hexadecimal digits
subroutine
unescape_string
(
str_in
,
str_out
,
error_message
)
...
...
@@ -714,62 +747,34 @@
end
function
default_neq_ucs4
!*****************************************************************************************
!*****************************************************************************************
!> author: Jacob Williams
!
! Return the lowercase version of the `CK` character.
pure
elemental
function
lowercase_character
(
c
)
result
(
c_lower
)
implicit
none
character
(
kind
=
CK
,
len
=
1
),
intent
(
in
)
::
c
character
(
kind
=
CK
,
len
=
1
)
::
c_lower
integer
::
i
!! index in uppercase array
i
=
index
(
upper
,
c
)
c_lower
=
merge
(
lower
(
i
:
i
),
c
,
i
>
0
)
end
function
lowercase_character
!*****************************************************************************************
!*****************************************************************************************
!> author: Jacob Williams
!
! Returns lowercase version of the `CK` string.
! !pure elemental function lowercase_string(str) result(s_lower) DOES NOT COMPILE ON BGQ
pure
function
lowercase_string
(
str
)
result
(
s_lower
)
pure
elemental
function
lowercase_string
(
str
)
result
(
s_lower
)
implicit
none
! !character(kind=CK,len=*),intent(in) :: str !! input string
! !character(kind=CK,len=(len(str))) :: s_lower !! lowercase version of the string
character
(
len
=*
),
intent
(
in
)
::
str
!! input string
character
(
len
=
(
len
(
str
)))
::
s_lower
!! lowercase version of the string
integer
::
i
!! counter
integer
::
n
!! length of input string
implicit
none
s_lower
=
CK_''
n
=
len_trim
(
str
)
character
(
kind
=
CK
,
len
=*
),
intent
(
in
)
::
str
!! input string
character
(
kind
=
CK
,
len
=
(
len
(
str
)))
::
s_lower
!! lowercase version of the string
if
(
n
>
0
)
then
!do concurrent (i=1:n) DOES NOT COMPILE ON BGQ
do
i
=
1
,
n
s_lower
(
i
:
i
)
=
lowercase_character
(
str
(
i
:
i
))
end
do
end
if
integer
::
i
!! counter
integer
::
j
!! index of uppercase character
end
function
lowercase_string
s_lower
=
str
do
i
=
1
,
len_trim
(
str
)
j
=
index
(
upper
,
s_lower
(
i
:
i
))
if
(
j
>
0
)
s_lower
(
i
:
i
)
=
lower
(
j
:
j
)
end
do
end
function
lowercase_string
!*****************************************************************************************
!*****************************************************************************************
!>
! Replace all occur
a
nces of `s1` in `str` with `s2`.
! Replace all occur
re
nces of `s1` in `str` with `s2`.
!
! A case-sensitive match is used.
!
...
...
Libraries/Json/json_value_module.f90
View file @
cb1b73ef
This diff is collapsed.
Click to expand it.
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment