Skip to content

GitLab

Commit cb1b73ef authored by Marco Govoni's avatar Marco Govoni
Browse files

Upgraded Json to 6.3.0

parent bc9c3563
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 occurances of `s1` in `str` with `s2`.
! Replace all occurrences 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.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment