Created
March 11, 2015 04:33
-
-
Save zbeekman/1a05b23c089f24927094 to your computer and use it in GitHub Desktop.
Diff showing changes to enable unicode support
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
diff --git a/src/json_module.F90 b/src/json_module.F90 | |
index 3986a22..a3094a4 100644 | |
--- a/src/json_module.F90 | |
+++ b/src/json_module.F90 | |
@@ -120,12 +120,75 @@ | |
! CK | |
! | |
! DESCRIPTION | |
- ! Default character kind. | |
- ! This is 1 byte for the Intel and Gfortran compilers | |
+ ! Default character kind used by json-fortran. | |
+ ! If ISO 10646 (UCS4) support is available, use that, | |
+ ! otherwise, gracefully fall back on 'DEFAULT' characters. | |
+ ! Currently only gfortran >= 4.9.2 will correctly support | |
+ ! UCS4 which is stored in 4 bytes. | |
! (and perhaps others). | |
! | |
+ ! NOTE | |
+ ! CK and CDK are the json-fortran character kind and json-fortran default | |
+ ! character kind respectively. Client code must ensure characters of kind=CK | |
+ ! are used for all character variables and strings passed to the json-fortran | |
+ ! library *EXCEPT* for file names which must be of 'DEFAULT' character kind, | |
+ ! provided here as JDCK. In particular, any: | |
+ ! - json path | |
+ ! - character or string | |
+ ! - object name | |
+ ! passed to the json-fortran library *MUST* be of type CK. | |
+ ! | |
+ ! | |
+ ! SOURCE | |
+ ! | |
+# define STRING_KIND 'DEFAULT' | |
+ ! this is the string kind to use unless compiling with GFortran AND | |
+ ! UCS4/ISO 10646 support is requested | |
+# define FILE_ENCODING | |
+ ! don't ask for utf-8 file encoding unless using UCS4 | |
+ ! this may let us use unformatted stream io to read in files more quickly | |
+ ! even with unicode support turned on `inquire( ... encoding=FL_ENCODING)` | |
+ ! may be able to detect json files in which each character is exactly one | |
+ ! byte | |
+# ifdef __GFORTRAN__ | |
+# ifdef USE_UCS4 | |
+ ! gfortran compiler AND UCS4 support requested, & silence redefine warning: | |
+# undef STRING_KIND | |
+# define STRING_KIND 'ISO_10646' | |
+ ! Make sure we output files with utf-8 encoding too | |
+# undef FILE_ENCODING | |
+# define FILE_ENCODING ,encoding='utf-8' | |
+# endif | |
+# endif | |
+ integer,parameter,public :: CK = selected_char_kind( STRING_KIND ) | |
+ !********************************************************* | |
+ | |
+ !********************************************************* | |
+ !****d* json_module/CDK | |
+ ! | |
+ ! NAME | |
+ ! CDK | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Processor dependendant 'DEFAULT' character kind. | |
+ ! This is 1 byte for the Intel and Gfortran compilers | |
+ ! | |
+ ! NOTE | |
+ ! CK and CDK are the json-fortran character kind and json-fortran default | |
+ ! character kind respectively. Client code must ensure characters of kind=CK | |
+ ! are used for all character variables and strings passed to the json-fortran | |
+ ! library *EXCEPT* for file names which must be of 'DEFAULT' character kind, | |
+ ! provided here as CDK. In particular, any: | |
+ ! - file name | |
+ ! - format statement | |
+ ! - file path | |
+ ! passed to the json-fortran library *MUST* be of type CDK. This | |
+ ! will be the case for all string literals nor prepended with CK_ and only | |
+ ! if ISO 10646 is supported and enabled, will strings of kind CK be different | |
+ ! than CDK | |
+ ! | |
! SOURCE | |
- integer,parameter :: CK = character_kinds(1) | |
+ integer,parameter,public :: CDK = selected_char_kind('DEFAULT') | |
!********************************************************* | |
!********************************************************* | |
@@ -145,10 +208,50 @@ | |
integer,parameter :: LK = logical_kinds(min(3,size(logical_kinds))) | |
!********************************************************* | |
- !parameters: | |
+ !********************************************************* | |
+ !****id* json_module/MAYBEWRAP | |
+ ! | |
+ ! NAME | |
+ ! MAYBEWRAP | |
+ ! | |
+ ! DESCRIPTION | |
+ ! This C preprocessor macro will take a procedure name as an | |
+ ! input, and output either that same procedure name if the | |
+ ! code is compiled without USE_UCS4 being defined or it will | |
+ ! expand the procedure name to the original procedure name, | |
+ ! followed by a comma and then the original procedure name | |
+ ! with 'wrap_' prepended to it. This is suitable for creating | |
+ ! overloaded interfaces that will accept UCS4 character actual | |
+ ! arguments as well as DEFAULT/ASCII character arguments, | |
+ ! based on whether or not ISO 10646 is supported and requested. | |
+ ! | |
+ ! SOURCE | |
+# ifdef USE_UCS4 | |
+# ifdef __GFORTRAN__ | |
+ ! gfortran uses cpp in old-school compatibility mode so | |
+ ! the # stringify and ## concatenate operators don't work | |
+ ! but we can use C/C++ style comment to ensure PROCEDURE is | |
+ ! correctly tokenized and prepended with 'wrap_' when the | |
+ ! macro is expanded | |
+# define MAYBEWRAP(PROCEDURE) PROCEDURE , wrap_/**/PROCEDURE | |
+# endif | |
+! ifdef __INTEL_COMPILER | |
+ ! Intel's fpp does support the more contemporary ## concatenation | |
+ ! operator, but doesn't treat the C/C++ coMments the same way. | |
+ ! If you use the gfortran approach and pass the -noB switch to | |
+ ! fpp, the macro will expand, but with a space between wrap_ and | |
+ ! whatever PROCEDURE expands to | |
+ ! Intel doesn't support ISO 10646 yet, but this is here to | |
+ ! ease the transition once they do. | |
+! define MAYBEWRAP(PROCEDURE) PROCEDURE , wrap_##PROCEDURE | |
+! endif | |
+# else | |
+# define MAYBEWRAP(PROCEDURE) PROCEDURE | |
+# endif | |
+ !********************************************************* | |
!JSON file extension | |
- character(kind=CK,len=*),parameter,public :: json_ext = '.json' | |
+ character(kind=CDK,len=*),parameter,public :: json_ext = '.json' !JSON file extension | |
!special JSON characters | |
character(kind=CK,len=*),parameter :: space = ' ' | |
@@ -158,9 +261,6 @@ | |
character(kind=CK,len=*),parameter :: end_array = ']' | |
character(kind=CK,len=*),parameter :: delimiter = ',' | |
character(kind=CK,len=*),parameter :: colon_char = ':' | |
- character(kind=CK,len=*),parameter :: null_str = 'null' | |
- character(kind=CK,len=*),parameter :: true_str = 'true' | |
- character(kind=CK,len=*),parameter :: false_str = 'false' | |
character(kind=CK,len=*),parameter :: bspace = achar(8) | |
character(kind=CK,len=*),parameter :: horizontal_tab = achar(9) | |
character(kind=CK,len=*),parameter :: newline = achar(10) | |
@@ -170,10 +270,15 @@ | |
character(kind=CK,len=*),parameter :: slash = achar(47) | |
character(kind=CK,len=*),parameter :: backslash = achar(92) | |
+ ! Control characters, possibly in unicode | |
+ integer, private :: i | |
+ character(kind=CK,len=*),parameter :: control_chars(32) = [(achar(i),i=1,31), achar(127)] | |
+ | |
!for indenting (Note: jsonlint.com uses 4 spaces) | |
integer(IK),parameter :: spaces_per_tab = 2 | |
- !find out the precision of the floating point number system, in io use 4Xprecision | |
+ !find out the precision of the floating point number system | |
+ !and set safety factors | |
integer(IK),parameter :: rp_safety_factor = 1 | |
integer(IK),parameter :: rp_addl_safety = 1 | |
integer(IK),parameter :: real_precision = rp_safety_factor*precision(1.0_RK) + & | |
@@ -184,13 +289,11 @@ | |
real(max(maxexponent(1.0_RK),abs(minexponent(1.0_RK))),& | |
kind=RK) ) ) | |
- !4*precision to prevent rounding errors | |
!6 = sign + leading 0 + decimal + 'E' + exponent sign + 1 extra | |
integer(IK),parameter :: max_numeric_str_len = real_precision + real_exponent_digits + 6 | |
- | |
- !real format set by library initialization | |
- character(kind=CK,len=*),parameter :: int_fmt = '(I0)' !minimum width format for integers | |
- character(kind=CK,len=*),parameter :: star = '*' !for invalid numbers | |
+ ! real format set by library initialization | |
+ character(kind=CDK,len=*),parameter :: int_fmt = '(I0)' !minimum width format for integers | |
+ character(kind=CK, len=*),parameter :: star = '*' !for invalid numbers | |
!********************************************************* | |
!****d* json_module/var_type | |
@@ -305,11 +408,12 @@ | |
contains | |
procedure,public :: load_file => json_file_load | |
- procedure,public :: load_from_string => json_file_load_from_string | |
+ | |
+ generic, public :: load_from_string => MAYBEWRAP(json_file_load_from_string) | |
procedure,public :: destroy => json_file_destroy | |
procedure,public :: move => json_file_move_pointer | |
- procedure,public :: info => json_file_variable_info | |
+ generic ,public :: info => MAYBEWRAP(json_file_variable_info) | |
procedure,public :: print_to_string => json_file_print_to_string | |
@@ -317,37 +421,54 @@ | |
json_file_print_1, & | |
json_file_print_2 | |
- generic,public :: get => json_file_get_object, & | |
- json_file_get_integer, & | |
- json_file_get_double, & | |
- json_file_get_logical, & | |
- json_file_get_string, & | |
- json_file_get_integer_vec, & | |
- json_file_get_double_vec, & | |
- json_file_get_logical_vec, & | |
- json_file_get_string_vec | |
- | |
- generic,public :: update => json_file_update_integer, & | |
- json_file_update_logical, & | |
- json_file_update_real, & | |
- json_file_update_string | |
+ generic,public :: get => MAYBEWRAP(json_file_get_object), & | |
+ MAYBEWRAP(json_file_get_integer), & | |
+ MAYBEWRAP(json_file_get_double), & | |
+ MAYBEWRAP(json_file_get_logical), & | |
+ MAYBEWRAP(json_file_get_string), & | |
+ MAYBEWRAP(json_file_get_integer_vec), & | |
+ MAYBEWRAP(json_file_get_double_vec), & | |
+ MAYBEWRAP(json_file_get_logical_vec), & | |
+ MAYBEWRAP(json_file_get_string_vec) | |
+ | |
+ | |
+ | |
+ | |
+ generic,public :: update => MAYBEWRAP(json_file_update_integer), & | |
+ MAYBEWRAP(json_file_update_logical), & | |
+ MAYBEWRAP(json_file_update_real), & | |
+ MAYBEWRAP(json_file_update_string) | |
+# ifdef USE_UCS4 | |
+ generic,public :: update => json_file_update_string_name_ascii, & | |
+ json_file_update_string_val_ascii | |
+# endif | |
+ | |
+ !load from string: | |
+ procedure :: MAYBEWRAP(json_file_load_from_string) | |
+ | |
+ !git info: | |
+ procedure :: MAYBEWRAP(json_file_variable_info) | |
!get: | |
- procedure :: json_file_get_object | |
- procedure :: json_file_get_integer | |
- procedure :: json_file_get_double | |
- procedure :: json_file_get_logical | |
- procedure :: json_file_get_string | |
- procedure :: json_file_get_integer_vec | |
- procedure :: json_file_get_double_vec | |
- procedure :: json_file_get_logical_vec | |
- procedure :: json_file_get_string_vec | |
+ procedure :: MAYBEWRAP(json_file_get_object) | |
+ procedure :: MAYBEWRAP(json_file_get_integer) | |
+ procedure :: MAYBEWRAP(json_file_get_double) | |
+ procedure :: MAYBEWRAP(json_file_get_logical) | |
+ procedure :: MAYBEWRAP(json_file_get_string) | |
+ procedure :: MAYBEWRAP(json_file_get_integer_vec) | |
+ procedure :: MAYBEWRAP(json_file_get_double_vec) | |
+ procedure :: MAYBEWRAP(json_file_get_logical_vec) | |
+ procedure :: MAYBEWRAP(json_file_get_string_vec) | |
!update: | |
- procedure :: json_file_update_integer | |
- procedure :: json_file_update_logical | |
- procedure :: json_file_update_real | |
- procedure :: json_file_update_string | |
+ procedure :: MAYBEWRAP(json_file_update_integer) | |
+ procedure :: MAYBEWRAP(json_file_update_logical) | |
+ procedure :: MAYBEWRAP(json_file_update_real) | |
+ procedure :: MAYBEWRAP(json_file_update_string) | |
+# ifdef USE_UCS4 | |
+ procedure :: json_file_update_string_name_ascii | |
+ procedure :: json_file_update_string_val_ascii | |
+# endif | |
!print_file: | |
procedure :: json_file_print_to_console | |
@@ -381,6 +502,18 @@ | |
end interface | |
!************************************************************************************* | |
+# ifdef USE_UCS4 | |
+ ! Provide a means to convert to UCS4 while concatenating UCS4 and default strings | |
+ interface operator(//) | |
+ module procedure ucs4_join_default, default_join_ucs4 | |
+ end interface | |
+ | |
+ ! Provide a string comparison operator that works with mixed kinds | |
+ interface operator(==) | |
+ module procedure ucs4_comp_default, default_comp_ucs4 | |
+ end interface | |
+# endif | |
+ | |
!************************************************************************************* | |
!****I* json_module/json_get_child | |
! | |
@@ -397,7 +530,7 @@ | |
! SOURCE | |
interface json_get_child | |
module procedure json_value_get_by_index | |
- module procedure json_value_get_by_name_chars | |
+ module procedure MAYBEWRAP(json_value_get_by_name_chars) | |
end interface json_get_child | |
!************************************************************************************* | |
@@ -416,10 +549,20 @@ | |
! SOURCE | |
interface json_add | |
module procedure json_value_add_member | |
- module procedure json_value_add_integer, json_value_add_integer_vec | |
- module procedure json_value_add_double, json_value_add_double_vec | |
- module procedure json_value_add_logical, json_value_add_logical_vec | |
- module procedure json_value_add_string, json_value_add_string_vec | |
+ module procedure MAYBEWRAP(json_value_add_integer) | |
+ module procedure MAYBEWRAP(json_value_add_integer_vec) | |
+ module procedure MAYBEWRAP(json_value_add_double) | |
+ module procedure MAYBEWRAP(json_value_add_double_vec) | |
+ module procedure MAYBEWRAP(json_value_add_logical) | |
+ module procedure MAYBEWRAP(json_value_add_logical_vec) | |
+ module procedure MAYBEWRAP(json_value_add_string) | |
+ module procedure MAYBEWRAP(json_value_add_string_vec) | |
+# ifdef USE_UCS4 | |
+ module procedure json_value_add_string_name_ascii | |
+ module procedure json_value_add_string_val_ascii | |
+ module procedure json_value_add_string_vec_name_ascii | |
+ module procedure json_value_add_string_vec_val_ascii | |
+# endif | |
end interface json_add | |
!************************************************************************************* | |
@@ -442,10 +585,14 @@ | |
! | |
! SOURCE | |
interface json_update | |
- module procedure json_update_logical,& | |
- json_update_double,& | |
- json_update_integer,& | |
- json_update_string | |
+ module procedure MAYBEWRAP(json_update_logical),& | |
+ MAYBEWRAP(json_update_double),& | |
+ MAYBEWRAP(json_update_integer),& | |
+ MAYBEWRAP(json_update_string) | |
+# ifdef USE_UCS4 | |
+ module procedure json_update_string_name_ascii | |
+ module procedure json_update_string_val_ascii | |
+# endif | |
end interface json_update | |
!************************************************************************************* | |
@@ -460,12 +607,16 @@ | |
! | |
! SOURCE | |
interface json_get | |
- module procedure json_get_by_path | |
- module procedure json_get_integer, json_get_integer_vec | |
- module procedure json_get_double, json_get_double_vec | |
- module procedure json_get_logical, json_get_logical_vec | |
- module procedure json_get_string, json_get_string_vec | |
- module procedure json_get_array | |
+ module procedure MAYBEWRAP(json_get_by_path) | |
+ module procedure json_get_integer, MAYBEWRAP(json_get_integer_with_path) | |
+ module procedure json_get_integer_vec, MAYBEWRAP(json_get_integer_vec_with_path) | |
+ module procedure json_get_double, MAYBEWRAP(json_get_double_with_path) | |
+ module procedure json_get_double_vec, MAYBEWRAP(json_get_double_vec_with_path) | |
+ module procedure json_get_logical, MAYBEWRAP(json_get_logical_with_path) | |
+ module procedure json_get_logical_vec, MAYBEWRAP(json_get_logical_vec_with_path) | |
+ module procedure json_get_string, MAYBEWRAP(json_get_string_with_path) | |
+ module procedure json_get_string_vec, MAYBEWRAP(json_get_string_vec_with_path) | |
+ module procedure json_get_array, MAYBEWRAP(json_get_array_with_path) | |
end interface json_get | |
!************************************************************************************* | |
@@ -576,10 +727,235 @@ | |
! | |
! SOURCE | |
interface json_remove_if_present | |
- module procedure json_value_remove_if_present | |
+ module procedure MAYBEWRAP(json_value_remove_if_present) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/json_create_double | |
+ ! | |
+ ! NAME | |
+ ! json_create_double | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Allocate a json_value pointer and make it a double variable. | |
+ ! The pointer should not already be allocated. | |
+ ! | |
+ ! EXAMPLE | |
+ ! Example usage: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_create_double(p,'value',1.0d0) | |
+ ! | |
+ ! AUTHOR | |
+ ! Jacob Williams | |
+ ! | |
+ ! SOURCE | |
+ interface json_create_double | |
+ module procedure MAYBEWRAP(json_value_create_double) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/json_create_array | |
+ ! | |
+ ! NAME | |
+ ! json_create_array | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Allocate a json_value pointer and make it an array variable. | |
+ ! The pointer should not already be allocated. | |
+ ! | |
+ ! EXAMPLE | |
+ ! Example usage: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_create(p,'arrayname') | |
+ ! | |
+ ! AUTHOR | |
+ ! Jacob Williams | |
+ ! | |
+ ! SOURCE | |
+ interface json_create_array | |
+ module procedure MAYBEWRAP(json_value_create_array) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/json_create_object | |
+ ! | |
+ ! NAME | |
+ ! json_create_object | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Allocate a json_value pointer and make it an object variable. | |
+ ! The pointer should not already be allocated. | |
+ ! | |
+ ! EXAMPLE | |
+ ! Example usage: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_create(p,'objectname') | |
+ ! | |
+ ! NOTES | |
+ ! The name is not significant for the root structure or an array element. | |
+ ! In those cases, an empty string can be used. | |
+ ! | |
+ ! AUTHOR | |
+ ! Jacob Williams | |
+ ! | |
+ ! SOURCE | |
+ interface json_create_object | |
+ module procedure MAYBEWRAP(json_value_create_object) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/json_create_null | |
+ ! | |
+ ! NAME | |
+ ! json_create_null | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Allocate a json_value pointer and make it a null variable. | |
+ ! The pointer should not already be allocated. | |
+ ! | |
+ ! EXAMPLE | |
+ ! Example usage: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_create_null(p,'value') | |
+ ! | |
+ ! AUTHOR | |
+ ! Jacob Williams | |
+ ! | |
+ ! SOURCE | |
+ interface json_create_null | |
+ module procedure MAYBEWRAP(json_value_create_null) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/json_create_string | |
+ ! | |
+ ! NAME | |
+ ! json_create_string | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Allocate a json_value pointer and make it a string variable. | |
+ ! The pointer should not already be allocated. | |
+ ! | |
+ ! EXAMPLE | |
+ ! Example usage: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_create_string(p,'value','foobar') | |
+ ! | |
+ ! AUTHOR | |
+ ! Jacob Williams | |
+ ! | |
+ ! SOURCE | |
+ interface json_create_string | |
+ module procedure MAYBEWRAP(json_value_create_string) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/json_create_integer | |
+ ! | |
+ ! NAME | |
+ ! json_create_integer | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Allocate a json_value pointer and make it an integer variable. | |
+ ! The pointer should not already be allocated. | |
+ ! | |
+ ! EXAMPLE | |
+ ! Example usage: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_create_integer(p,'value',42) | |
+ ! | |
+ ! AUTHOR | |
+ ! Jacob Williams | |
+ ! | |
+ ! SOURCE | |
+ interface json_create_integer | |
+ module procedure MAYBEWRAP(json_value_create_integer) | |
end interface | |
!************************************************************************************* | |
+ !************************************************************************************* | |
+ !****I* json_module/json_create_logical | |
+ ! | |
+ ! NAME | |
+ ! json_create_logical | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Allocate a json_value pointer and make it a logical variable. | |
+ ! The pointer should not already be allocated. | |
+ ! | |
+ ! EXAMPLE | |
+ ! Example usage: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_create_logical(p,'value',.true.) | |
+ ! | |
+ ! AUTHOR | |
+ ! Jacob Williams | |
+ ! | |
+ ! SOURCE | |
+ interface json_create_logical | |
+ module procedure MAYBEWRAP(json_value_create_logical) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/json_parse | |
+ ! | |
+ ! NAME | |
+ ! json_parse | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Parse the JSON file and populate the json_value tree. | |
+ ! | |
+ ! INPUTS | |
+ ! The inputs can be: | |
+ ! * file and unit : the specified unit is used to read JSON from file. | |
+ ! [note if unit is already open, then the filename is ignored] | |
+ ! * file : JSON is read from file using internal unit number | |
+ ! * str : JSON data is read from the string instead | |
+ ! | |
+ ! EXAMPLE | |
+ ! Consider the following example: | |
+ ! type(json_value),pointer :: p | |
+ ! call json_parse(file='myfile.json', p=p) | |
+ ! | |
+ ! NOTES | |
+ ! When calling this routine, any exceptions thrown from previous | |
+ ! calls will automatically be cleared. | |
+ ! | |
+ ! HISTORY | |
+ ! Jacob Williams : 1/13/2015 : added read from string option. | |
+ ! | |
+ ! SOURCE | |
+ interface json_parse | |
+ module procedure json_parse_file, MAYBEWRAP(json_parse_string) | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ !************************************************************************************* | |
+ !****I* json_module/to_unicode | |
+ ! | |
+ ! NAME | |
+ ! to_unicode | |
+ ! | |
+ ! DESCRIPTION | |
+ ! Convert a 'DEFAULT' kind character input to 'ISO_10646' kind and return it | |
+ ! | |
+ ! SOURCE | |
+ interface to_unicode | |
+ module procedure to_uni, to_uni_vec | |
+ end interface | |
+ !************************************************************************************* | |
+ | |
+ interface throw_exception | |
+ module procedure MAYBEWRAP(json_throw_exception) | |
+ end interface throw_exception | |
+ | |
!public routines: | |
public :: json_add !add data to a JSON structure | |
public :: json_check_for_errors !check for error and get error message | |
@@ -605,13 +981,19 @@ | |
public :: json_remove_if_present !remove from a JSON structure (if it is present) | |
public :: json_update !update a value in a JSON structure | |
public :: json_print_error_message | |
+ public :: to_unicode !Function to convert from 'DEFAULT' to 'ISO_10646' strings | |
+ | |
+# ifdef USE_UCS4 | |
+ public :: operator(//) | |
+ public :: operator(==) | |
+# endif | |
! | |
! Note: the following global variables make this module non thread safe. | |
! | |
!real string printing: | |
- character(kind=CK,len=:),allocatable :: real_fmt !the format string to use for real numbers | |
+ character(kind=CDK,len=:),allocatable :: real_fmt !the format string to use for real numbers | |
! [set in json_initialize] | |
logical(LK) :: compact_real = .true. !to use the "compact" form of real numbers for output | |
@@ -626,6 +1008,12 @@ | |
integer(IK) :: pushed_index = 0 | |
character(kind=CK,len=10) :: pushed_char = '' !JW : what is this magic number 10?? | |
+ !These were parameters, but gfortran bug (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=65141) | |
+ !necessitates moving them here to be variables | |
+ character(kind=CK,len=4) :: null_str = 'null' | |
+ character(kind=CK,len=4) :: true_str = 'true' | |
+ character(kind=CK,len=5) :: false_str = 'false' | |
+ | |
contains | |
!***************************************************************************************** | |
@@ -752,7 +1140,7 @@ | |
implicit none | |
class(json_file),intent(inout) :: me | |
- character(kind=CK,len=*),intent(in) :: filename | |
+ character(kind=CDK,len=*),intent(in) :: filename | |
integer(IK),intent(in),optional :: unit | |
call json_parse(file=filename, p=me%p, unit=unit) | |
@@ -791,6 +1179,18 @@ | |
end subroutine json_file_load_from_string | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_load_from_string(me, str) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: str | |
+ | |
+ call json_file_load_from_string(me,to_unicode(str)) | |
+ | |
+ end subroutine wrap_json_file_load_from_string | |
+ | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_print_to_console | |
! | |
@@ -892,11 +1292,11 @@ | |
implicit none | |
class(json_file),intent(inout) :: me | |
- character(kind=CK,len=*),intent(in) :: filename | |
+ character(kind=CDK,len=*),intent(in) :: filename | |
integer(IK) :: iunit,istat | |
- open(newunit=iunit,file=filename,status='REPLACE',iostat=istat) | |
+ open(newunit=iunit,file=filename,status='REPLACE',iostat=istat FILE_ENCODING ) | |
if (istat==0) then | |
call me%print_file(iunit) !call the other routine | |
close(iunit,iostat=istat) | |
@@ -998,6 +1398,21 @@ | |
end subroutine json_file_variable_info | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_variable_info(me,path,found,var_type,n_children) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ logical(LK),intent(out) :: found | |
+ integer(IK),intent(out) :: var_type | |
+ integer(IK),intent(out) :: n_children | |
+ | |
+ call json_file_variable_info(me,to_unicode(path),found,var_type,n_children) | |
+ | |
+ end subroutine wrap_json_file_variable_info | |
+ | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_info | |
! | |
@@ -1057,6 +1472,19 @@ | |
end subroutine json_file_get_object | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_object(me, path, p, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ type(json_value),pointer,intent(out) :: p | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_object(me, to_unicode(path), p, found) | |
+ | |
+ end subroutine wrap_json_file_get_object | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_get_integer | |
! | |
@@ -1088,6 +1516,19 @@ | |
end subroutine json_file_get_integer | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_integer(me, path, val, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ integer(IK),intent(out) :: val | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_integer(me, to_unicode(path), val, found) | |
+ | |
+ end subroutine wrap_json_file_get_integer | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_get_integer_vec | |
! | |
@@ -1119,6 +1560,19 @@ | |
end subroutine json_file_get_integer_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_integer_vec(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ integer(IK),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_integer_vec(me, to_unicode(path), vec, found) | |
+ | |
+ end subroutine wrap_json_file_get_integer_vec | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_get_double | |
! | |
@@ -1150,6 +1604,19 @@ | |
end subroutine json_file_get_double | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_double (me, path, val, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ real(RK),intent(out) :: val | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_double(me, to_unicode(path), val, found) | |
+ | |
+ end subroutine | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_get_double_vec | |
! | |
@@ -1181,6 +1648,19 @@ | |
end subroutine json_file_get_double_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_double_vec(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ real(RK),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_double_vec(me, to_unicode(path), vec, found) | |
+ | |
+ end subroutine wrap_json_file_get_double_vec | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_get_logical | |
! | |
@@ -1212,6 +1692,19 @@ | |
end subroutine json_file_get_logical | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_logical(me,path,val,found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ logical(LK),intent(out) :: val | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_logical(me, to_unicode(path), val, found) | |
+ | |
+ end subroutine wrap_json_file_get_logical | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_get_logical_vec | |
! | |
@@ -1243,6 +1736,19 @@ | |
end subroutine json_file_get_logical_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_logical_vec(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ logical(LK),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_logical_vec(me, to_unicode(path), vec, found) | |
+ | |
+ end subroutine wrap_json_file_get_logical_vec | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_get_string | |
! | |
@@ -1275,11 +1781,24 @@ | |
end subroutine json_file_get_string | |
!***************************************************************************************** | |
-!***************************************************************************************** | |
-!****f* json_module/json_file_get_string_vec | |
-! | |
-! NAME | |
-! json_file_get_string_vec | |
+ subroutine wrap_json_file_get_string(me, path, val, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ character(kind=CK,len=:),allocatable,intent(out) :: val | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_string(me, to_unicode(path), val, found) | |
+ | |
+ end subroutine wrap_json_file_get_string | |
+ | |
+!***************************************************************************************** | |
+!****f* json_module/json_file_get_string_vec | |
+! | |
+! NAME | |
+! json_file_get_string_vec | |
! | |
! USAGE | |
! call me%get(path,vec) | |
@@ -1306,6 +1825,19 @@ | |
end subroutine json_file_get_string_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_get_string_vec(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_file_get_string_vec(me, to_unicode(path), vec, found) | |
+ | |
+ end subroutine wrap_json_file_get_string_vec | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_initialize | |
! | |
@@ -1332,12 +1864,23 @@ | |
logical(LK),intent(in),optional :: verbose !mainly useful for debugging (default is false) | |
logical(LK),intent(in),optional :: compact_reals !to compact the real number strings for output | |
- character(kind=CK,len=10) :: w,d,e | |
+ character(kind=CDK,len=10) :: w,d,e | |
integer(IK) :: istat | |
!clear any errors from previous runs: | |
call json_clear_exceptions() | |
+# ifdef USE_UCS4 | |
+ ! reopen stdout and stderr with utf-8 encoding | |
+ open(output_unit,encoding='utf-8') | |
+ open(error_unit, encoding='utf-8') | |
+# endif | |
+ | |
+ !Ensure gfortran bug work around "parameters" are set properly | |
+ null_str = 'null' | |
+ true_str = 'true' | |
+ false_str = 'false' | |
+ | |
!optional inputs (if not present, values remains unchanged): | |
if (present(verbose)) is_verbose = verbose | |
if (present(compact_reals)) compact_real = compact_reals !may be a bug here in Gfortran 5.0.0... check this... | |
@@ -1405,7 +1948,7 @@ | |
! | |
! SOURCE | |
- subroutine throw_exception(msg) | |
+ subroutine json_throw_exception(msg) | |
implicit none | |
@@ -1422,7 +1965,19 @@ | |
write(*,'(A)') '***********************' | |
end if | |
- end subroutine throw_exception | |
+ end subroutine json_throw_exception | |
+ | |
+ | |
+ subroutine wrap_json_throw_exception(msg) | |
+ | |
+ implicit none | |
+ | |
+ character(kind=CDK,len=*),intent(in) :: msg !the error message | |
+ | |
+ call json_throw_exception(to_unicode(msg)) | |
+ | |
+ end subroutine wrap_json_throw_exception | |
+ | |
!***************************************************************************************** | |
!***************************************************************************************** | |
@@ -1441,7 +1996,7 @@ | |
! Consider the following example: | |
! type(json_file) :: json | |
! logical :: status_ok | |
-! character(len=:),allocatable :: error_msg | |
+! character(kind=CK,len=:),allocatable :: error_msg | |
! call json%load_file(filename='myfile.json') | |
! call json_check_for_errors(status_ok, error_msg) | |
! if (.not. status_ok) then | |
@@ -1757,6 +2312,17 @@ | |
end subroutine json_value_remove_if_present | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_remove_if_present(p,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ | |
+ call json_value_remove_if_present(p,to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_remove_if_present | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_update_integer | |
! | |
@@ -1789,6 +2355,18 @@ | |
end subroutine json_file_update_integer | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_update_integer(me,name,val,found) | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ integer(IK),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_file_update_integer(me,to_unicode(name),val,found) | |
+ | |
+ end subroutine wrap_json_file_update_integer | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_update_logical | |
! | |
@@ -1821,6 +2399,18 @@ | |
end subroutine json_file_update_logical | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_update_logical(me,name,val,found) | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ logical(LK),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_file_update_logical(me,to_unicode(name),val,found) | |
+ | |
+ end subroutine wrap_json_file_update_logical | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_update_real | |
! | |
@@ -1853,6 +2443,18 @@ | |
end subroutine json_file_update_real | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_update_real(me,name,val,found) | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ real(RK),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_file_update_real(me,to_unicode(name),val,found) | |
+ | |
+ end subroutine wrap_json_file_update_real | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_file_update_string | |
! | |
@@ -1885,6 +2487,44 @@ | |
end subroutine json_file_update_string | |
!***************************************************************************************** | |
+ subroutine wrap_json_file_update_string(me,name,val,found) | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_file_update_string(me,to_unicode(name),to_unicode(val),found) | |
+ | |
+ end subroutine wrap_json_file_update_string | |
+ | |
+ | |
+ subroutine json_file_update_string_name_ascii(me,name,val,found) | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CK, len=*),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_file_update_string(me,to_unicode(name),val,found) | |
+ | |
+ end subroutine json_file_update_string_name_ascii | |
+ | |
+ | |
+ subroutine json_file_update_string_val_ascii(me,name,val,found) | |
+ implicit none | |
+ | |
+ class(json_file),intent(inout) :: me | |
+ character(kind=CK, len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_file_update_string(me,name,to_unicode(val),found) | |
+ | |
+ end subroutine json_file_update_string_val_ascii | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_update_logical | |
! | |
@@ -1933,6 +2573,19 @@ | |
end subroutine json_update_logical | |
!***************************************************************************************** | |
+ subroutine wrap_json_update_logical(p,name,val,found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ logical(LK),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_update_logical(p,to_unicode(name),val,found) | |
+ | |
+ end subroutine wrap_json_update_logical | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_update_double | |
! | |
@@ -1981,6 +2634,19 @@ | |
end subroutine json_update_double | |
!***************************************************************************************** | |
+ subroutine wrap_json_update_double(p,name,val,found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ real(RK),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_update_double(p,to_unicode(name),val,found) | |
+ | |
+ end subroutine wrap_json_update_double | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_update_integer | |
! | |
@@ -2029,6 +2695,19 @@ | |
end subroutine json_update_integer | |
!***************************************************************************************** | |
+ subroutine wrap_json_update_integer(p,name,val,found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ integer(IK),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_update_integer(p,to_unicode(name),val,found) | |
+ | |
+ end subroutine wrap_json_update_integer | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_update_string | |
! | |
@@ -2077,6 +2756,47 @@ | |
end subroutine json_update_string | |
!***************************************************************************************** | |
+ subroutine wrap_json_update_string(p,name,val,found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_update_string(p,to_unicode(name),to_unicode(val),found) | |
+ | |
+ end subroutine wrap_json_update_string | |
+ | |
+ | |
+ subroutine json_update_string_name_ascii(p,name,val,found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CK, len=*),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_update_string(p,to_unicode(name),val,found) | |
+ | |
+ end subroutine json_update_string_name_ascii | |
+ | |
+ | |
+ subroutine json_update_string_val_ascii(p,name,val,found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p | |
+ character(kind=CK, len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),intent(in) :: val | |
+ logical(LK),intent(out) :: found | |
+ | |
+ call json_update_string(p,name,to_unicode(val),found) | |
+ | |
+ end subroutine json_update_string_val_ascii | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_add_member | |
! | |
@@ -2162,6 +2882,18 @@ | |
end subroutine json_value_add_double | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_double(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ real(RK),intent(in) :: val | |
+ | |
+ call json_value_add_double(me, to_unicode(name), val) | |
+ | |
+ end subroutine wrap_json_value_add_double | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_add_double_vec | |
! | |
@@ -2209,6 +2941,18 @@ | |
end subroutine json_value_add_double_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_double_vec(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ real(RK),dimension(:),intent(in) :: val | |
+ | |
+ call json_value_add_double_vec(me, to_unicode(name), val) | |
+ | |
+ end subroutine wrap_json_value_add_double_vec | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_add_integer | |
! | |
@@ -2250,6 +2994,18 @@ | |
end subroutine json_value_add_integer | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_integer(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ integer(IK),intent(in) :: val | |
+ | |
+ call json_value_add_integer(me, to_unicode(name), val) | |
+ | |
+ end subroutine wrap_json_value_add_integer | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_add_integer_vec | |
! | |
@@ -2297,6 +3053,18 @@ | |
end subroutine json_value_add_integer_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_integer_vec(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ integer(IK),dimension(:),intent(in) :: val | |
+ | |
+ call json_value_add_integer_vec(me, to_unicode(name), val) | |
+ | |
+ end subroutine wrap_json_value_add_integer_vec | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_add_logical | |
! | |
@@ -2338,6 +3106,18 @@ | |
end subroutine json_value_add_logical | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_logical(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ logical(LK),intent(in) :: val | |
+ | |
+ call json_value_add_logical(me, to_unicode(name), val) | |
+ | |
+ end subroutine wrap_json_value_add_logical | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_add_logical_vec | |
! | |
@@ -2385,6 +3165,18 @@ | |
end subroutine json_value_add_logical_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_logical_vec(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ logical(LK),dimension(:),intent(in) :: val | |
+ | |
+ call json_value_add_logical_vec(me, to_unicode(name), val) | |
+ | |
+ end subroutine wrap_json_value_add_logical_vec | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_add_string | |
! | |
@@ -2430,6 +3222,44 @@ | |
end subroutine json_value_add_string | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_string(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),intent(in) :: val | |
+ | |
+ call json_value_add_string(me, to_unicode(name), to_unicode(val)) | |
+ | |
+ end subroutine wrap_json_value_add_string | |
+ | |
+ | |
+ subroutine json_value_add_string_name_ascii(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CK, len=*),intent(in) :: val | |
+ | |
+ call json_value_add_string(me, to_unicode(name), val) | |
+ | |
+ end subroutine json_value_add_string_name_ascii | |
+ | |
+ | |
+ subroutine json_value_add_string_val_ascii(me, name, val) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CK, len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),intent(in) :: val | |
+ | |
+ call json_value_add_string(me, name, to_unicode(val)) | |
+ | |
+ end subroutine json_value_add_string_val_ascii | |
+ | |
!***************************************************************************************** | |
!****if* json_module/escape_string | |
! | |
@@ -2557,6 +3387,50 @@ | |
end subroutine json_value_add_string_vec | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_add_string_vec(me, name, val, trim_str, adjustl_str) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),dimension(:),intent(in) :: val | |
+ logical(LK),intent(in),optional :: trim_str | |
+ logical(LK),intent(in),optional :: adjustl_str | |
+ | |
+ call json_value_add_string_vec(me, to_unicode(name), to_unicode(val), trim_str, adjustl_str) | |
+ | |
+ end subroutine wrap_json_value_add_string_vec | |
+ | |
+ | |
+ subroutine json_value_add_string_vec_name_ascii(me, name, val, trim_str, adjustl_str) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CK, len=*),dimension(:),intent(in) :: val | |
+ logical(LK),intent(in),optional :: trim_str | |
+ logical(LK),intent(in),optional :: adjustl_str | |
+ | |
+ call json_value_add_string_vec(me, to_unicode(name), val, trim_str, adjustl_str) | |
+ | |
+ end subroutine json_value_add_string_vec_name_ascii | |
+ | |
+ | |
+ subroutine json_value_add_string_vec_val_ascii(me, name, val, trim_str, adjustl_str) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CK, len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),dimension(:),intent(in) :: val | |
+ logical(LK),intent(in),optional :: trim_str | |
+ logical(LK),intent(in),optional :: adjustl_str | |
+ | |
+ call json_value_add_string_vec(me, name, to_unicode(val), trim_str, adjustl_str) | |
+ | |
+ end subroutine json_value_add_string_vec_val_ascii | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_count | |
! | |
@@ -2698,6 +3572,18 @@ | |
end subroutine json_value_get_by_name_chars | |
!***************************************************************************************** | |
+ subroutine wrap_json_value_get_by_name_chars(me, name, p) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ type(json_value),pointer :: p | |
+ | |
+ call json_value_get_by_name_chars(me,to_unicode(name),p) | |
+ | |
+ end subroutine wrap_json_value_get_by_name_chars | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_value_to_string | |
! | |
@@ -2748,7 +3634,6 @@ | |
type(json_value),pointer,intent(in) :: me | |
integer(IK),intent(in) :: iunit !must be non-zero | |
- | |
character(kind=CK,len=:),allocatable :: dummy | |
if (iunit/=0) then | |
@@ -2781,11 +3666,10 @@ | |
implicit none | |
type(json_value),pointer,intent(in) :: me | |
- character(kind=CK,len=*),intent(in) :: filename !file to print to | |
- | |
+ character(kind=CDK,len=*),intent(in) :: filename | |
integer(IK) :: iunit,istat | |
- open(newunit=iunit,file=filename,status='REPLACE',iostat=istat) | |
+ open(newunit=iunit,file=filename,status='REPLACE',iostat=istat FILE_ENCODING ) | |
if (istat==0) then | |
call json_print(me,iunit) | |
close(iunit,iostat=istat) | |
@@ -3126,7 +4010,7 @@ | |
c = path(i:i) | |
select case (c) | |
- case ('$') | |
+ case (CK_'$') | |
! root | |
do while (associated (p%parent)) | |
@@ -3134,13 +4018,13 @@ | |
end do | |
child_i = i + 1 | |
- case ('@') | |
+ case (CK_'@') | |
! this | |
p => me | |
child_i = i + 1 | |
- case ('.') | |
+ case (CK_'.') | |
! get child member from p | |
if (child_i < i) then | |
@@ -3242,6 +4126,19 @@ | |
end subroutine json_get_by_path | |
!***************************************************************************************** | |
+ subroutine wrap_json_get_by_path(me, path, p, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ type(json_value),pointer,intent(out) :: p | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_by_path(me, to_unicode(path), p, found) | |
+ | |
+ end subroutine wrap_json_get_by_path | |
+ | |
!***************************************************************************************** | |
!****if* json_module/string_to_integer | |
! | |
@@ -3263,14 +4160,21 @@ | |
implicit none | |
- integer :: ival | |
+ integer :: ival, ndigits_digits, ndigits | |
character(kind=CK,len=*),intent(in) :: str | |
+ character(kind=CDK,len=:),allocatable :: digits | |
integer(IK) :: ierr | |
if (.not. exception_thrown) then | |
- read(str,*,iostat=ierr) ival !string to integer | |
+ ! 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) | |
+ 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 | |
if (ierr/=0) then !if there was an error | |
ival = 0 | |
@@ -3332,78 +4236,93 @@ | |
! | |
! SOURCE | |
- subroutine json_get_integer(me, path, value, found) | |
+ subroutine json_get_integer(me, value) | |
implicit none | |
type(json_value),pointer,intent(in) :: me | |
- character(kind=CK,len=*),optional :: path | |
integer(IK),intent(out) :: value | |
- logical(LK),intent(out),optional :: found | |
- | |
- type(json_value),pointer :: p | |
- | |
- if (.not. exception_thrown) then | |
- nullify(p) | |
- if (present(path)) then | |
- call json_get_by_path(me=me, path=path, p=p) | |
+ value = 0 | |
+ if ( exception_thrown ) return | |
+ | |
+ select case(me%var_type) | |
+ case (json_integer) | |
+ value = me%int_value | |
+ case (json_double) | |
+ value = int(me%dbl_value) | |
+ case (json_logical) | |
+ if (me%log_value) then | |
+ value = 1 | |
else | |
- p => me | |
+ value = 0 | |
end if | |
+ case default | |
+ call throw_exception('Error in get_integer:'//& | |
+ ' Unable to resolve value to integer: '//me%name) | |
+ end select | |
- if (.not. associated(p)) then | |
+ end subroutine json_get_integer | |
+!***************************************************************************************** | |
- call throw_exception('Error in json_get_integer:'//& | |
- ' Unable to resolve path: '// trim(path)) | |
+ subroutine json_get_integer_with_path(me, path, value, found) | |
- else | |
+ implicit none | |
- select case(p%var_type) | |
- case (json_integer) | |
- value = p%int_value | |
- case (json_double) | |
- value = int(p%dbl_value) | |
- case (json_logical) | |
- if (p%log_value) then | |
- value = 1 | |
- else | |
- value = 0 | |
- end if | |
- case default | |
- call throw_exception('Error in get_integer:'//& | |
- ' Unable to resolve value to integer: '//& | |
- trim(path)) | |
- end select | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CK,len=*),intent(in) :: path | |
+ integer(IK),intent(out) :: value | |
+ logical(LK),intent(out),optional :: found | |
- nullify(p) | |
+ type(json_value),pointer :: p | |
- end if | |
+ value = 0 | |
+ if ( exception_thrown ) then | |
+ if ( present(found) ) found = .false. | |
+ return | |
+ end if | |
- if (exception_thrown) then | |
- if (present(found)) then | |
- found = .false. | |
- call json_clear_exceptions() | |
- end if | |
- else | |
- if (present(found)) found = .true. | |
- end if | |
+ nullify(p) | |
+ call json_get_by_path(me=me, path=path, p=p) | |
+ | |
+ if (.not. associated(p)) then | |
+ call throw_exception('Error in json_get_integer:'//& | |
+ ' Unable to resolve path: '// trim(path)) | |
+ else | |
+ call json_get_integer(p,value) | |
+ nullify(p) | |
+ end if | |
+ if ( exception_thrown ) then | |
+ if ( present(found) ) then | |
+ found = .false. | |
+ call json_clear_exceptions() | |
+ end if | |
else | |
+ if ( present(found) ) found = .true. | |
+ end if | |
- value = 0 | |
- if (present(found)) found = .false. | |
+ end subroutine json_get_integer_with_path | |
- end if | |
- end subroutine json_get_integer | |
-!***************************************************************************************** | |
+ subroutine wrap_json_get_integer_with_path(me, path, value, found) | |
-!***************************************************************************************** | |
-!****f* json_module/json_get_integer_vec | |
-! | |
-! NAME | |
-! json_get_integer_vec | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ integer(IK),intent(out) :: value | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_integer_with_path(me, to_unicode(path), value, found) | |
+ | |
+ end subroutine wrap_json_get_integer_with_path | |
+ | |
+!***************************************************************************************** | |
+!****f* json_module/json_get_integer_vec | |
+! | |
+! NAME | |
+! json_get_integer_vec | |
! | |
! DESCRIPTION | |
! Get an integer vector from a JSON value. | |
@@ -3413,14 +4332,12 @@ | |
! | |
! SOURCE | |
- subroutine json_get_integer_vec(me, path, vec, found) | |
+ subroutine json_get_integer_vec(me, vec) | |
implicit none | |
type(json_value),pointer :: me | |
- character(kind=CK,len=*),intent(in) :: path | |
integer(IK),dimension(:),allocatable,intent(out) :: vec | |
- logical(LK),intent(out),optional :: found | |
logical(LK) :: initialized | |
@@ -3429,7 +4346,7 @@ | |
if (allocated(vec)) deallocate(vec) | |
!the callback function is called for each element of the array: | |
- call json_get(me, path=path, array_callback=get_int_from_array, found=found) | |
+ call json_get(me, array_callback=get_int_from_array) | |
contains | |
@@ -3455,6 +4372,61 @@ | |
end subroutine json_get_integer_vec | |
!***************************************************************************************** | |
+ | |
+ subroutine json_get_integer_vec_with_path(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CK,len=*),intent(in) :: path | |
+ integer(IK),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ logical(LK) :: initialized | |
+ | |
+ initialized = .false. | |
+ | |
+ call json_get(me, path=path, array_callback=get_int_from_array, found=found) | |
+ | |
+ ! need to duplicate callback function, no other way | |
+ contains | |
+ | |
+ ! callback function for integer | |
+ subroutine get_int_from_array(element, i, count) | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: element | |
+ integer(IK),intent(in) :: i !index | |
+ integer(IK),intent(in) :: count !size of array | |
+ | |
+ !size the output array: | |
+ if (.not. initialized) then | |
+ allocate(vec(count)) | |
+ initialized = .true. | |
+ end if | |
+ | |
+ !populate the elements: | |
+ call json_get(element, value=vec(i)) | |
+ | |
+ end subroutine get_int_from_array | |
+ | |
+ end subroutine json_get_integer_vec_with_path | |
+ | |
+ | |
+ subroutine wrap_json_get_integer_vec_with_path(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ integer(IK),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_integer_vec_with_path(me,path=to_unicode(path),vec=vec,found=found) | |
+ | |
+ end subroutine wrap_json_get_integer_vec_with_path | |
+ | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_get_double | |
! | |
@@ -3466,73 +4438,96 @@ | |
! | |
! SOURCE | |
- subroutine json_get_double(me, path, value, found) | |
+ subroutine json_get_double(me, value) | |
implicit none | |
type(json_value),pointer :: me | |
- character(kind=CK,len=*), optional :: path | |
real(RK),intent(out) :: value | |
- logical(LK),intent(out),optional :: found | |
- type(json_value),pointer :: p | |
+ value = 0.0_RK | |
+ if ( exception_thrown ) return | |
+ | |
+ select case (me%var_type) | |
+ case (json_integer) | |
+ value = me%int_value | |
+ case (json_double) | |
+ value = me%dbl_value | |
+ case (json_logical) | |
+ if (me%log_value) then | |
+ value = 1.0_RK | |
+ else | |
+ value = 0.0_RK | |
+ end if | |
+ case default | |
- if (.not. exception_thrown) then | |
+ call throw_exception('Error in json_get_double:'//& | |
+ ' Unable to resolve value to double: '//me%name) | |
- nullify(p) | |
+ end select | |
- if (present(path)) then | |
- call json_get_by_path(me=me, path=path, p=p) | |
- else | |
- p => me | |
- end if | |
+ end subroutine json_get_double | |
+!***************************************************************************************** | |
- if (.not. associated(p)) then | |
- call throw_exception('Error in json_get_double:'//& | |
- ' Unable to resolve path: '//trim(path)) | |
+ subroutine json_get_double_with_path(me, path, value, found) | |
- else | |
+ implicit none | |
- select case (p%var_type) | |
- case (json_integer) | |
- value = p%int_value | |
- case (json_double) | |
- value = p%dbl_value | |
- case (json_logical) | |
- if (p%log_value) then | |
- value = 1.0_RK | |
- else | |
- value = 0.0_RK | |
- end if | |
- case default | |
- call throw_exception('Error in json_get_double:'//& | |
- ' Unable to resolve value to double: '//& | |
- trim(path)) | |
- end select | |
+ type(json_value),pointer :: me | |
+ character(kind=CK,len=*),intent(in) :: path | |
+ real(RK),intent(out) :: value | |
+ logical(LK),intent(out),optional :: found | |
- nullify(p) | |
+ type(json_value),pointer :: p | |
- end if | |
+ value = 0.0_RK | |
+ if ( exception_thrown ) then | |
+ if ( present(found) ) found = .false. | |
+ return | |
+ end if | |
- if (exception_thrown) then | |
- if (present(found)) then | |
- found = .false. | |
- call json_clear_exceptions() | |
- end if | |
- else | |
- if (present(found)) found = .true. | |
- end if | |
+ nullify(p) | |
+ | |
+ call json_get_by_path(me=me, path=path, p=p) | |
+ | |
+ if (.not. associated(p)) then | |
+ | |
+ call throw_exception('Error in json_get_double:'//& | |
+ ' Unable to resolve path: '//trim(path)) | |
else | |
- value = 0.0_RK | |
- if (present(found)) found = .false. | |
+ call json_get_double(p,value) | |
+ nullify(p) | |
end if | |
- end subroutine json_get_double | |
-!***************************************************************************************** | |
+ if (exception_thrown) then | |
+ if (present(found)) then | |
+ found = .false. | |
+ call json_clear_exceptions() | |
+ end if | |
+ else | |
+ if (present(found)) found = .true. | |
+ end if | |
+ | |
+ end subroutine | |
+ | |
+ | |
+ subroutine wrap_json_get_double_with_path(me, path, value, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ real(RK),intent(out) :: value | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_double_with_path(me,to_unicode(path),value,found) | |
+ | |
+ end subroutine wrap_json_get_double_with_path | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_get_double_vec | |
@@ -3548,7 +4543,48 @@ | |
! | |
! SOURCE | |
- subroutine json_get_double_vec(me, path, vec, found) | |
+ subroutine json_get_double_vec(me, vec) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ real(RK),dimension(:),allocatable,intent(out) :: vec | |
+ | |
+ logical(LK) :: initialized | |
+ | |
+ initialized = .false. | |
+ | |
+ if (allocated(vec)) deallocate(vec) | |
+ | |
+ !the callback function is called for each element of the array: | |
+ call json_get(me, array_callback=get_double_from_array) | |
+ | |
+ contains | |
+ | |
+ ! callback function for double | |
+ subroutine get_double_from_array(element, i, count) | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: element | |
+ integer(IK),intent(in) :: i !index | |
+ integer(IK),intent(in) :: count !size of array | |
+ | |
+ !size the output array: | |
+ if (.not. initialized) then | |
+ allocate(vec(count)) | |
+ initialized = .true. | |
+ end if | |
+ | |
+ !populate the elements: | |
+ call json_get(element, value=vec(i)) | |
+ | |
+ end subroutine get_double_from_array | |
+ | |
+ end subroutine json_get_double_vec | |
+!***************************************************************************************** | |
+ | |
+ | |
+ subroutine json_get_double_vec_with_path(me, path, vec, found) | |
implicit none | |
@@ -3587,8 +4623,22 @@ | |
end subroutine get_double_from_array | |
- end subroutine json_get_double_vec | |
-!***************************************************************************************** | |
+ end subroutine json_get_double_vec_with_path | |
+ | |
+ | |
+ subroutine wrap_json_get_double_vec_with_path(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ real(RK),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_double_vec_with_path(me, to_unicode(path), vec, found) | |
+ | |
+ end subroutine wrap_json_get_double_vec_with_path | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_get_logical | |
@@ -3601,67 +4651,88 @@ | |
! | |
! SOURCE | |
- subroutine json_get_logical(me, path, value, found) | |
+ subroutine json_get_logical(me, value) | |
implicit none | |
type(json_value),pointer,intent(in) :: me | |
- character(kind=CK,len=*),optional :: path | |
+ logical(LK) :: value | |
+ | |
+ value = .false. | |
+ if ( exception_thrown ) return | |
+ | |
+ select case (me%var_type) | |
+ case (json_integer) | |
+ value = (me%int_value > 0) | |
+ case (json_logical) | |
+ value = me % log_value | |
+ case default | |
+ call throw_exception('Error in json_get_logical:'//& | |
+ ' Unable to resolve value to logical: '//me%name) | |
+ end select | |
+ | |
+ end subroutine json_get_logical | |
+!***************************************************************************************** | |
+ | |
+ | |
+ subroutine json_get_logical_with_path(me, path, value, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CK,len=*),intent(in) :: path | |
logical(LK) :: value | |
logical(LK),intent(out),optional :: found | |
type(json_value),pointer :: p | |
- if (.not. exception_thrown) then | |
+ value = .false. | |
+ if ( exception_thrown) then | |
+ if ( present(found) ) found = .false. | |
+ return | |
+ end if | |
- nullify(p) | |
+ nullify(p) | |
- if (present(path)) then | |
- call json_get_by_path(me=me, path=path, p=p) | |
- else | |
- p => me | |
- end if | |
+ call json_get_by_path(me=me, path=path, p=p) | |
- if (.not. associated(p)) then | |
+ if (.not. associated(p)) then | |
- call throw_exception('Error in json_get_logical:'//& | |
- ' Unable to resolve path: '//trim(path)) | |
+ call throw_exception('Error in json_get_logical:'//& | |
+ ' Unable to resolve path: '//trim(path)) | |
- else | |
+ else | |
- select case (p%var_type) | |
- case (json_integer) | |
- value = (p%int_value > 0) | |
- case (json_logical) | |
- value = p % log_value | |
- case default | |
- call throw_exception('Error in json_get_logical:'//& | |
- ' Unable to resolve value to logical: '//& | |
- trim(path)) | |
- end select | |
+ call json_get_logical(p,value) | |
+ nullify(p) | |
- nullify(p) | |
+ end if | |
+ if (exception_thrown) then | |
+ if (present(found)) then | |
+ found = .false. | |
+ call json_clear_exceptions() | |
end if | |
+ else | |
+ if (present(found)) found = .true. | |
+ end if | |
- if (exception_thrown) then | |
- if (present(found)) then | |
- found = .false. | |
- call json_clear_exceptions() | |
- end if | |
- else | |
- if (present(found)) found = .true. | |
- end if | |
+ end subroutine json_get_logical_with_path | |
- else | |
- value = .false. | |
- if (present(found)) found = .false. | |
+ subroutine wrap_json_get_logical_with_path(me, path, value, found) | |
- end if | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ logical(LK) :: value | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_logical_with_path(me,to_unicode(path),value,found) | |
+ | |
+ end subroutine wrap_json_get_logical_with_path | |
- end subroutine json_get_logical | |
-!***************************************************************************************** | |
!***************************************************************************************** | |
!****f* json_module/json_get_logical_vec | |
@@ -3677,7 +4748,48 @@ | |
! | |
! SOURCE | |
- subroutine json_get_logical_vec(me, path, vec, found) | |
+ subroutine json_get_logical_vec(me, vec) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ logical(LK),dimension(:),allocatable,intent(out) :: vec | |
+ | |
+ logical(LK) :: initialized | |
+ | |
+ initialized = .false. | |
+ | |
+ if (allocated(vec)) deallocate(vec) | |
+ | |
+ !the callback function is called for each element of the array: | |
+ call json_get(me, array_callback=get_logical_from_array) | |
+ | |
+ contains | |
+ | |
+ ! callback function for logical | |
+ subroutine get_logical_from_array(element, i, count) | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: element | |
+ integer(IK),intent(in) :: i !index | |
+ integer(IK),intent(in) :: count !size of array | |
+ | |
+ !size the output array: | |
+ if (.not. initialized) then | |
+ allocate(vec(count)) | |
+ initialized = .true. | |
+ end if | |
+ | |
+ !populate the elements: | |
+ call json_get(element, value=vec(i)) | |
+ | |
+ end subroutine get_logical_from_array | |
+ | |
+ end subroutine json_get_logical_vec | |
+!***************************************************************************************** | |
+ | |
+ | |
+ subroutine json_get_logical_vec_with_path(me, path, vec, found) | |
implicit none | |
@@ -3716,8 +4828,22 @@ | |
end subroutine get_logical_from_array | |
- end subroutine json_get_logical_vec | |
-!***************************************************************************************** | |
+ end subroutine json_get_logical_vec_with_path | |
+ | |
+ | |
+ subroutine wrap_json_get_logical_vec_with_path(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ logical(LK),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_logical_vec_with_path(me,to_unicode(path),vec,found) | |
+ | |
+ end subroutine wrap_json_get_logical_vec_with_path | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_get_string | |
@@ -3730,204 +4856,226 @@ | |
! | |
! SOURCE | |
- subroutine json_get_string(me, path, value, found) | |
+ subroutine json_get_string(me, value) | |
implicit none | |
type(json_value),pointer,intent(in) :: me | |
- character(kind=CK,len=*),intent(in),optional :: path | |
character(kind=CK,len=:),allocatable,intent(out) :: value | |
- logical(LK),intent(out),optional :: found | |
- type(json_value),pointer :: p | |
- character(kind=CK,len=:),allocatable :: s,pre,post | |
+ character(kind=CK ,len=:),allocatable :: s,pre,post | |
integer(IK) :: j,jprev,n | |
character(kind=CK,len=1) :: c | |
- if (.not. exception_thrown) then | |
+ value = '' | |
+ if ( exception_thrown) return | |
- nullify(p) | |
+ select case (me%var_type) | |
- if (present(path)) then | |
- call json_get_by_path(me=me, path=path, p=p) | |
- else | |
- p => me | |
- end if | |
+ case (json_string) | |
- if (.not. associated(p)) then | |
+ if (allocated(me%str_value)) then | |
- call throw_exception('Error in json_get_string:'//& | |
- ' Unable to resolve path: '//trim(path)) | |
+ !get the value as is: | |
+ s = me%str_value | |
- else | |
+ ! Now, have to remove the escape characters: | |
+ ! | |
+ ! '\"' quotation mark | |
+ ! '\\' reverse solidus | |
+ ! '\/' solidus | |
+ ! '\b' backspace | |
+ ! '\f' formfeed | |
+ ! '\n' newline (LF) | |
+ ! '\r' carriage return (CR) | |
+ ! '\t' horizontal tab | |
+ ! '\uXXXX' 4 hexadecimal digits | |
+ ! | |
+ | |
+ !initialize: | |
+ n = len(s) | |
+ j = 1 | |
- select case (p%var_type) | |
- | |
- case (json_string) | |
- | |
- if (allocated(p%str_value)) then | |
- | |
- !get the value as is: | |
- s = p%str_value | |
- | |
- ! Now, have to remove the escape characters: | |
- ! | |
- ! '\"' quotation mark | |
- ! '\\' reverse solidus | |
- ! '\/' solidus | |
- ! '\b' backspace | |
- ! '\f' formfeed | |
- ! '\n' newline (LF) | |
- ! '\r' carriage return (CR) | |
- ! '\t' horizontal tab | |
- ! '\uXXXX' 4 hexadecimal digits | |
- ! | |
- | |
- !initialize: | |
- n = len(s) | |
- j = 1 | |
- | |
- do | |
- | |
- jprev = j !initialize | |
- j = index(s(j:n),backslash) !look for an escape character | |
- | |
- if (j>0) then !an escape character was found | |
- | |
- !index in full string of the escape character: | |
- j = j + (jprev-1) | |
- | |
- if (j<n) then | |
- | |
- !save the bit before the escape character: | |
- if (j>1) then | |
- pre = s( 1 : j-1 ) | |
- else | |
- pre = '' | |
- end if | |
- | |
- !character after the escape character: | |
- c = s( j+1 : j+1 ) | |
- | |
- select case (c) | |
- case(quotation_mark,backslash,slash,& | |
- 'b','f','n','r','t') | |
- | |
- !save the bit after the escape characters: | |
- if (j+2<n) then | |
- post = s(j+2:n) | |
- else | |
- post = '' | |
- end if | |
- | |
- select case(c) | |
- case(quotation_mark,backslash,slash) | |
- !use c as is | |
- case('b') | |
- c = bspace | |
- case('f') | |
- c = formfeed | |
- case('n') | |
- c = newline | |
- case('r') | |
- c = carriage_return | |
- case('t') | |
- c = horizontal_tab | |
- end select | |
- | |
- s = pre//c//post | |
- | |
- n = n-1 !backslash character has been | |
- ! removed from the string | |
- | |
- case('u') !expecting 4 hexadecimal digits after | |
- ! the escape character [\uXXXX] | |
- | |
- !for now, we are just printing them as is | |
- ![not checking to see if it is a valid hex value] | |
- | |
- if (j+5<=n) then | |
- j=j+4 | |
- else | |
- call throw_exception(& | |
- 'Error in json_get_string:'//& | |
- ' Invalid hexadecimal sequence'//& | |
- ' in string: '//trim(c)) | |
- exit | |
- end if | |
- | |
- case default | |
- !unknown escape character | |
- call throw_exception('Error in json_get_string:'//& | |
- ' unknown escape sequence in string "'//& | |
- trim(s)//'" ['//backslash//c//']') | |
- exit | |
- end select | |
- | |
- j=j+1 !go to the next character | |
- | |
- if (j>=n) exit !finished | |
+ do | |
+ | |
+ jprev = j !initialize | |
+ j = index(s(j:n),backslash) !look for an escape character | |
+ | |
+ if (j>0) then !an escape character was found | |
+ | |
+ !index in full string of the escape character: | |
+ j = j + (jprev-1) | |
+ | |
+ if (j<n) then | |
+ | |
+ !save the bit before the escape character: | |
+ if (j>1) then | |
+ pre = s( 1 : j-1 ) | |
+ else | |
+ pre = '' | |
+ end if | |
+ !character after the escape character: | |
+ c = s( j+1 : j+1 ) | |
+ | |
+ if (any(c == [quotation_mark,backslash,slash, & | |
+ to_unicode(['b','f','n','r','t'])])) then | |
+ | |
+ !save the bit after the escape characters: | |
+ if (j+2<n) then | |
+ post = s(j+2:n) | |
else | |
- !an escape character is the last character in | |
- ! the string [this may not be valid syntax, | |
- ! but just keep it] | |
+ post = '' | |
+ end if | |
+ | |
+ select case(c) | |
+ case (quotation_mark,backslash,slash) | |
+ !use c as is | |
+ case (CK_'b') | |
+ c = bspace | |
+ case (CK_'f') | |
+ c = formfeed | |
+ case (CK_'n') | |
+ c = newline | |
+ case (CK_'r') | |
+ c = carriage_return | |
+ case (CK_'t') | |
+ c = horizontal_tab | |
+ end select | |
+ | |
+ s = pre//c//post | |
+ | |
+ n = n-1 !backslash character has been | |
+ ! removed from the string | |
+ | |
+ else if (c == 'u') then !expecting 4 hexadecimal digits after | |
+ !the escape character [\uXXXX] | |
+ | |
+ !for now, we are just printing them as is | |
+ ![not checking to see if it is a valid hex value] | |
+ | |
+ if (j+5<=n) then | |
+ j=j+4 | |
+ else | |
+ call throw_exception('Error in json_get_string:'//& | |
+ ' Invalid hexadecimal sequence'//& | |
+ ' in string: '//trim(c)) | |
exit | |
end if | |
else | |
- exit !no more escape characters in the string | |
+ !unknown escape character | |
+ call throw_exception('Error in json_get_string:'//& | |
+ ' unknown escape sequence in string "'//& | |
+ trim(s)//'" ['//backslash//c//']') | |
+ exit | |
end if | |
- end do | |
+ j=j+1 !go to the next character | |
+ | |
+ if (j>=n) exit !finished | |
- if (exception_thrown) then | |
- if (allocated(value)) deallocate(value) | |
else | |
- value = s | |
+ !an escape character is the last character in | |
+ ! the string [this may not be valid syntax, | |
+ ! but just keep it] | |
+ exit | |
end if | |
else | |
- call throw_exception('Error in json_get_string:'//& | |
- ' p%value not allocated') | |
+ exit !no more escape characters in the string | |
end if | |
- case default | |
+ end do | |
- call throw_exception('Error in json_get_string:'//& | |
- ' Unable to resolve value to characters: '//& | |
- trim(path)) | |
+ if (exception_thrown) then | |
+ if (allocated(value)) deallocate(value) | |
+ else | |
+ value = s | |
+ end if | |
- ! Note: for the other cases, we could do val to string conversions. | |
+ else | |
+ call throw_exception('Error in json_get_string:'//& | |
+ ' me%value not allocated') | |
+ end if | |
- end select | |
+ case default | |
+ call throw_exception('Error in json_get_string:'//& | |
+ ' Unable to resolve value to characters: '//me%name) | |
- end if | |
+ ! Note: for the other cases, we could do val to string conversions. | |
- if (allocated(value) .and. .not. exception_thrown) then | |
- if (present(found)) found = .true. | |
- else | |
- if (present(found)) then | |
- found = .false. | |
- call json_clear_exceptions() | |
- end if | |
- end if | |
+ end select | |
- !cleanup: | |
- if (associated(p)) nullify(p) | |
- if (allocated(s)) deallocate(s) | |
- if (allocated(pre)) deallocate(pre) | |
- if (allocated(post)) deallocate(post) | |
+ !cleanup: | |
+ if (allocated(s)) deallocate(s) | |
+ if (allocated(pre)) deallocate(pre) | |
+ if (allocated(post)) deallocate(post) | |
+ | |
+ end subroutine json_get_string | |
+!***************************************************************************************** | |
+ | |
+ | |
+ subroutine json_get_string_with_path(me, path, value, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CK,len=*),intent(in) :: path | |
+ character(kind=CK,len=:),allocatable,intent(out) :: value | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ type(json_value),pointer :: p | |
+ | |
+ value = '' | |
+ if ( exception_thrown ) then | |
+ if ( present(found) ) found = .false. | |
+ return | |
+ end if | |
+ | |
+ nullify(p) | |
+ | |
+ call json_get_by_path(me=me, path=path, p=p) | |
+ | |
+ if (.not. associated(p)) then | |
+ call throw_exception('Error in json_get_string:'//& | |
+ ' Unable to resolve path: '//trim(path)) | |
else | |
- value = '' | |
- found = .false. | |
+ call json_get_string(p,value) | |
+ nullify(p) | |
end if | |
- end subroutine json_get_string | |
-!***************************************************************************************** | |
+ if (allocated(value) .and. .not. exception_thrown) then | |
+ if (present(found)) found = .true. | |
+ else | |
+ if (present(found)) then | |
+ found = .false. | |
+ call json_clear_exceptions() | |
+ end if | |
+ end if | |
+ | |
+ !cleanup: | |
+ if (associated(p)) nullify(p) | |
+ | |
+ end subroutine json_get_string_with_path | |
+ | |
+ | |
+ subroutine wrap_json_get_string_with_path(me, path, value, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ character(kind=CK,len=:),allocatable,intent(out) :: value | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_string_with_path(me,to_unicode(path),value,found) | |
+ | |
+ end subroutine wrap_json_get_string_with_path | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_get_string_vec | |
@@ -3943,7 +5091,57 @@ | |
! | |
! SOURCE | |
- subroutine json_get_string_vec(me, path, vec, found) | |
+ subroutine json_get_string_vec(me, vec) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec | |
+ | |
+ logical(LK) :: initialized | |
+ | |
+ initialized = .false. | |
+ | |
+ if (allocated(vec)) deallocate(vec) | |
+ | |
+ !the callback function is called for each element of the array: | |
+ call json_get(me, array_callback=get_chars_from_array) | |
+ | |
+ contains | |
+ | |
+ ! callback function for chars | |
+ subroutine get_chars_from_array(element, i, count) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: element | |
+ integer(IK),intent(in) :: i !index | |
+ integer(IK),intent(in) :: count !size of array | |
+ | |
+ character(kind=CK,len=:),allocatable :: cval | |
+ | |
+ !size the output array: | |
+ if (.not. initialized) then | |
+ allocate(vec(count)) | |
+ initialized = .true. | |
+ end if | |
+ | |
+ !populate the elements: | |
+ call json_get(element, value=cval) | |
+ if (allocated(cval)) then | |
+ vec(i) = cval | |
+ deallocate(cval) | |
+ else | |
+ vec(i) = '' | |
+ end if | |
+ | |
+ end subroutine get_chars_from_array | |
+ | |
+ end subroutine json_get_string_vec | |
+!***************************************************************************************** | |
+ | |
+ | |
+ subroutine json_get_string_vec_with_path(me, path, vec, found) | |
implicit none | |
@@ -3991,8 +5189,22 @@ | |
end subroutine get_chars_from_array | |
- end subroutine json_get_string_vec | |
-!***************************************************************************************** | |
+ end subroutine json_get_string_vec_with_path | |
+ | |
+ | |
+ subroutine wrap_json_get_string_vec_with_path(me, path, vec, found) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec | |
+ logical(LK),intent(out),optional :: found | |
+ | |
+ call json_get_string_vec_with_path(me,to_unicode(path),vec,found) | |
+ | |
+ end subroutine wrap_json_get_string_vec_with_path | |
+ | |
!***************************************************************************************** | |
!****f* json_module/json_get_array | |
@@ -4011,74 +5223,96 @@ | |
! | |
! SOURCE | |
- subroutine json_get_array(me, path, array_callback, found) | |
+ subroutine json_get_array(me, array_callback) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer,intent(in) :: me | |
+ procedure(array_callback_func) :: array_callback | |
+ | |
+ type(json_value),pointer :: element | |
+ integer(IK) :: i, count | |
+ | |
+ if ( exception_thrown ) return | |
+ | |
+ nullify(element) | |
+ | |
+ select case (me%var_type) | |
+ case (json_array) | |
+ count = json_count(me) | |
+ element => me%children | |
+ do i = 1, count ! callback for each child | |
+ call array_callback(element, i, count) | |
+ element => element%next | |
+ end do | |
+ case default | |
+ | |
+ call throw_exception('Error in json_get_array:'//& | |
+ ' Resolved value is not an array ') | |
+ | |
+ end select | |
+ | |
+ !cleanup: | |
+ if (associated(element)) nullify(element) | |
+ | |
+ end subroutine json_get_array | |
+!***************************************************************************************** | |
- implicit none | |
+ subroutine json_get_array_with_path(me, path, array_callback, found) | |
- type(json_value),pointer,intent(in) :: me | |
- character(kind=CK,len=*),intent(in),optional :: path | |
- procedure(array_callback_func) :: array_callback | |
- logical(LK),intent(out),optional :: found | |
+ implicit none | |
- type(json_value),pointer :: element,p | |
- integer(IK) :: i, count | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CK,len=*),intent(in) :: path | |
+ procedure(array_callback_func) :: array_callback | |
+ logical(LK),intent(out),optional :: found | |
- if (.not. exception_thrown) then | |
+ type(json_value),pointer :: p | |
- nullify(p) | |
+ if ( exception_thrown ) then | |
+ if ( present(found) ) found = .false. | |
+ return | |
+ end if | |
- ! resolve the path to the value | |
- if (present(path)) then | |
- call json_get_by_path(me=me, path=path, p=p) | |
- else | |
- p => me | |
- end if | |
+ nullify(p) | |
- if (.not. associated(p)) then | |
+ ! resolve the path to the value | |
+ call json_get_by_path(me=me, path=path, p=p) | |
- call throw_exception('Error in json_get_array:'//& | |
- ' Unable to resolve path: '//trim(path)) | |
+ if (.not. associated(p)) then | |
+ call throw_exception('Error in json_get_array:'//& | |
+ ' Unable to resolve path: '//trim(path)) | |
+ else | |
+ call json_get_array(me=p,array_callback=array_callback) | |
+ nullify(p) | |
+ end if | |
+ if ( exception_thrown ) then | |
+ if ( present(found) ) then | |
+ found = .false. | |
+ call json_clear_exceptions() | |
+ end if | |
+ else | |
+ if ( present(found) ) found = .true. | |
+ end if | |
- else | |
+ end subroutine json_get_array_with_path | |
- select case (p%var_type) | |
- case (json_array) | |
- count = json_count(p) | |
- element => p%children | |
- do i = 1, count ! callback for each child | |
- call array_callback(element, i, count) | |
- element => element%next | |
- end do | |
- case default | |
- call throw_exception('Error in json_get_array:'//& | |
- ' Resolved value is not an array. '//& | |
- trim(path)) | |
- end select | |
- !cleanup: | |
- if (associated(p)) nullify(p) | |
- if (associated(element)) nullify(element) | |
+ subroutine wrap_json_get_array_with_path(me, path, array_callback, found) | |
- end if | |
+ implicit none | |
- if (exception_thrown) then | |
- if (present(found)) then | |
- found = .false. | |
- call json_clear_exceptions() | |
- end if | |
- else | |
- if (present(found)) found = .true. | |
- end if | |
+ type(json_value),pointer,intent(in) :: me | |
+ character(kind=CDK,len=*),intent(in) :: path | |
+ procedure(array_callback_func) :: array_callback | |
+ logical(LK),intent(out),optional :: found | |
- else | |
- if (present(found)) found = .false. | |
- end if | |
+ call json_get_array_with_path(me, to_unicode(path), array_callback, found) | |
- end subroutine json_get_array | |
-!***************************************************************************************** | |
+ end subroutine wrap_json_get_array_with_path | |
!***************************************************************************************** | |
-!****f* json_module/json_parse | |
+!****f* json_module/json_parse_file | |
! | |
! NAME | |
! json_parse | |
@@ -4091,7 +5325,6 @@ | |
! * file and unit : the specified unit is used to read JSON from file. | |
! [note if unit is already open, then the filename is ignored] | |
! * file : JSON is read from file using internal unit number | |
-! * str : JSON data is read from the string instead | |
! | |
! EXAMPLE | |
! Consider the following example: | |
@@ -4103,29 +5336,29 @@ | |
! calls will automatically be cleared. | |
! | |
! HISTORY | |
-! Jacob Williams : 1/13/2015 : added read from string option. | |
+! Jacob Williams : 01/13/2015 : added read from string option. | |
+! Izaak Beekman : 03/08/2015 : moved read from string to separate | |
+! subroutine, and error annotation | |
+! to separate subroutine | |
! | |
! SOURCE | |
- subroutine json_parse(file, p, unit, str) | |
+ subroutine json_parse_file(file, p, unit) | |
implicit none | |
- character(kind=CK,len=*),intent(in),optional :: file !JSON file name | |
+ character(kind=CDK,len=*),intent(in) :: file !JSON file name | |
type(json_value),pointer :: p !output structure | |
integer(IK),intent(in),optional :: unit !file unit number (/= 0) | |
- character(kind=CK,len=*),intent(in),optional :: str !string with JSON data | |
- integer(IK) :: iunit, istat, i, i_nl_prev, i_nl | |
- character(kind=CK,len=:),allocatable :: line, arrow_str | |
- character(kind=CK,len=10) :: line_str, char_str | |
+ integer(IK) :: iunit, istat | |
logical(LK) :: is_open | |
- character(len=:),allocatable :: buffer | |
+ character(kind=CK,len=:),allocatable :: buffer | |
!clear any exceptions and initialize: | |
call json_initialize() | |
- if (present(unit) .and. present(file) .and. .not. present(str)) then | |
+ if ( present(unit) ) then | |
if (unit==0) then | |
call throw_exception('Error in json_parse: unit number must not be 0.') | |
@@ -4145,10 +5378,10 @@ | |
action = 'READ', & | |
form = 'FORMATTED', & | |
position = 'REWIND', & | |
- iostat = istat) | |
+ iostat = istat FILE_ENCODING ) | |
end if | |
- else if (.not. present(unit) .and. present(file) .and. .not. present(str)) then | |
+ else | |
! open the file with a new unit number: | |
open ( newunit = iunit, & | |
@@ -4157,17 +5390,8 @@ | |
action = 'READ', & | |
form = 'FORMATTED', & | |
position = 'REWIND', & | |
- iostat = istat) | |
+ iostat = istat FILE_ENCODING ) | |
- else if (.not. present(unit) .and. .not. present(file) .and. present(str)) then | |
- | |
- buffer = str | |
- iunit = 0 !indicates that json data will be read from buffer | |
- istat = 0 | |
- | |
- else | |
- call throw_exception('Error in json_parse: Invalid inputs') | |
- return | |
end if | |
if (istat==0) then | |
@@ -4177,75 +5401,136 @@ | |
! Note: the name of the root json_value doesn't really matter, | |
! but we'll allocate something here just in case. | |
- if (present(file)) then | |
- p%name = trim(file) !use the file name | |
- else | |
- p%name = '' !if reading it from the string | |
- end if | |
+ p%name = trim(file) !use the file name | |
! parse as a value | |
+ buffer = '' | |
call parse_value(unit=iunit, str=buffer, value=p) | |
+ if ( exception_thrown ) call annotate_invalid_json(iunit,buffer) | |
+ | |
! cleanup: | |
if (allocated(buffer)) deallocate(buffer) | |
- ! | |
- ! If there was an error reading the file, then | |
- ! print the line where the error occurred: | |
- ! | |
- if (exception_thrown) then | |
+ ! close the file if necessary | |
+ if (iunit/=0) close(unit=iunit, iostat=istat) | |
- !the counters for the current line and the last character read: | |
- call integer_to_string(line_count, line_str) | |
- call integer_to_string(char_count, char_str) | |
+ else | |
- !draw the arrow string that points to the current character: | |
- arrow_str = repeat('-',max( 0, char_count - 1) )//'^' | |
+ call throw_exception('Error in json_parse: Error opening file: '//trim(file)) | |
+ nullify(p) | |
- if (iunit/=0) then | |
+ end if | |
- call get_current_line_from_file(iunit,line) | |
+ end subroutine json_parse_file | |
+!***************************************************************************************** | |
- else | |
- !get the current line from the string: | |
- ! [this is done by counting the newline characters] | |
- i_nl_prev = 0 !index of previous newline character | |
- do i=1,line_count | |
- i_nl = index(str(i_nl_prev+1:),newline) | |
- if (i_nl==0) then !last line - no newline character | |
- i_nl = len(str)+1 | |
- exit | |
- end if | |
- i_nl = i_nl + i_nl_prev !index of current newline character | |
- i_nl_prev = i_nl !update for next iteration | |
- end do | |
- line = str(i_nl_prev+1 : i_nl-1) !extract current line | |
+ subroutine json_parse_string(p, str) | |
- end if | |
+ implicit none | |
- !create the error message: | |
- err_message = err_message//newline//& | |
- 'line: '//trim(adjustl(line_str))//', '//& | |
- 'character: '//trim(adjustl(char_str))//newline//& | |
- trim(line)//newline//arrow_str | |
+ type(json_value),pointer :: p !output structure | |
+ character(kind=CK,len=*),intent(in) :: str !string with JSON data | |
- if (allocated(line)) deallocate(line) | |
+ integer(IK) :: iunit | |
+ character(kind=CK,len=:),allocatable :: buffer | |
- end if | |
+ if ( exception_thrown ) return ! to caller | |
- ! close the file if necessary | |
- if (iunit/=0) close(unit=iunit, iostat=istat) | |
+ !clear any exceptions and initialize: | |
+ call json_initialize() | |
- else | |
+ buffer = str | |
+ iunit = 0 !indicates that json data will be read from buffer | |
- call throw_exception('Error in json_parse: Error opening file: '//trim(file)) | |
- nullify(p) | |
+ ! create the value and associate the pointer | |
+ call json_value_create(p) | |
+ | |
+ ! Note: the name of the root json_value doesn't really matter, | |
+ ! but we'll allocate something here just in case. | |
+ p%name = '' !if reading it from the string | |
+ | |
+ ! parse as a value | |
+ call parse_value(unit=iunit, str=buffer, value=p) | |
+ | |
+ if ( exception_thrown ) call annotate_invalid_json(iunit,str) ! always 0 | |
+ | |
+ ! cleanup: | |
+ if (allocated(buffer)) deallocate(buffer) | |
+ | |
+ end subroutine json_parse_string | |
+ | |
+ | |
+ subroutine wrap_json_parse_string(p, str) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: p !output structure | |
+ character(kind=CDK,len=*),intent(in) :: str !string with JSON data | |
+ | |
+ call json_parse_string(p,to_unicode(str)) | |
+ | |
+ end subroutine wrap_json_parse_string | |
+ | |
+ | |
+ subroutine annotate_invalid_json(iunit,str) | |
+ | |
+ implicit none | |
+ | |
+ integer(IK),intent(in) :: iunit | |
+ character(kind=CK,len=*),intent(in) :: str | |
+ | |
+ character(kind=CK,len=:),allocatable :: line, arrow_str | |
+ character(kind=CK,len=10) :: line_str, char_str | |
+ integer(IK) :: i, i_nl_prev, i_nl | |
+ ! | |
+ ! If there was an error reading the file, then | |
+ ! print the line where the error occurred: | |
+ ! | |
+ if (exception_thrown) then | |
+ | |
+ !the counters for the current line and the last character read: | |
+ call integer_to_string(line_count, line_str) | |
+ call integer_to_string(char_count, char_str) | |
+ | |
+ !draw the arrow string that points to the current character: | |
+ arrow_str = repeat('-',max( 0, char_count - 1) )//'^' | |
+ | |
+ if (iunit/=0) then | |
+ | |
+ call get_current_line_from_file(iunit,line) | |
+ | |
+ else | |
+ | |
+ !get the current line from the string: | |
+ ! [this is done by counting the newline characters] | |
+ i_nl_prev = 0 !index of previous newline character | |
+ do i=1,line_count | |
+ i_nl = index(str(i_nl_prev+1:),newline) | |
+ if (i_nl==0) then !last line - no newline character | |
+ i_nl = len(str)+1 | |
+ exit | |
+ end if | |
+ i_nl = i_nl + i_nl_prev !index of current newline character | |
+ i_nl_prev = i_nl !update for next iteration | |
+ end do | |
+ line = str(i_nl_prev+1 : i_nl-1) !extract current line | |
+ | |
+ end if | |
+ | |
+ !create the error message: | |
+ err_message = err_message//newline//& | |
+ 'line: '//trim(adjustl(line_str))//', '//& | |
+ 'character: '//trim(adjustl(char_str))//newline//& | |
+ trim(line)//newline//arrow_str | |
+ | |
+ if (allocated(line)) deallocate(line) | |
end if | |
- end subroutine json_parse | |
-!***************************************************************************************** | |
+ end subroutine annotate_invalid_json | |
+ | |
!***************************************************************************************** | |
!****if* json_module/get_current_line_from_file | |
@@ -4270,7 +5555,7 @@ | |
character(kind=CK,len=:),allocatable,intent(out) :: line | |
integer(IK),parameter :: n_chunk = 256 ! chunk size [arbitrary] | |
- character(kind=CK,len=*),parameter :: nfmt = '(A256)' ! corresponding format statement | |
+ character(kind=CDK,len=*),parameter :: nfmt = '(A256)' ! corresponding format statement | |
character(kind=CK,len=n_chunk) :: chunk | |
integer(IK) :: istat,isize | |
@@ -4367,27 +5652,27 @@ | |
deallocate(tmp) ! | |
end select | |
- case (true_str(1:1)) | |
+ case (CK_'t') !true_str(1:1) gfortran bug work around | |
!true | |
call parse_for_chars(unit, str, true_str(2:)) | |
!allocate class and set value: | |
if (.not. exception_thrown) call to_logical(value,.true.) | |
- case (false_str(1:1)) | |
+ case (CK_'f') !false_str(1:1) gfortran bug work around | |
!false | |
call parse_for_chars(unit, str, false_str(2:)) | |
!allocate class and set value: | |
if (.not. exception_thrown) call to_logical(value,.false.) | |
- case (null_str(1:1)) | |
+ case (CK_'n') !null_str(1:1) gfortran bug work around | |
!null | |
call parse_for_chars(unit, str, null_str(2:)) | |
if (.not. exception_thrown) call to_null(value) !allocate class | |
- case('-', '0': '9') | |
+ case(CK_'-', CK_'0': CK_'9') | |
call push_char(c) | |
call parse_number(unit, str, value) | |
@@ -4407,10 +5692,10 @@ | |
!***************************************************************************************** | |
!***************************************************************************************** | |
-!****f* json_module/json_create_logical | |
+!****if* json_module/json_value_create_logical | |
! | |
! NAME | |
-! json_create_logical | |
+! json_value_create_logical | |
! | |
! DESCRIPTION | |
! Allocate a json_value pointer and make it a logical variable. | |
@@ -4426,7 +5711,7 @@ | |
! | |
! SOURCE | |
- subroutine json_create_logical(me,val,name) | |
+ subroutine json_value_create_logical(me,val,name) | |
implicit none | |
@@ -4437,14 +5722,42 @@ | |
call json_value_create(me) | |
call to_logical(me,val,name) | |
- end subroutine json_create_logical | |
+ end subroutine json_value_create_logical | |
+!***************************************************************************************** | |
+ | |
+!***************************************************************************************** | |
+!****if* json_module/wrap_json_value_create_logical | |
+! | |
+! NAME | |
+! wrap_json_value_create_logical | |
+! | |
+! DESCRIPTION | |
+! Wrapper for json_value_create_logical so json_create_logical can | |
+! be called with name of character kind 'DEFAULT' or 'ISO_10646' | |
+! | |
+! AUTHOR | |
+! Izaak Beekman | |
+! | |
+! SOURCE | |
+ | |
+ subroutine wrap_json_value_create_logical(me,val,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ logical(LK),intent(in) :: val | |
+ | |
+ call json_value_create_logical(me,val,to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_create_logical | |
!***************************************************************************************** | |
!***************************************************************************************** | |
-!****f* json_module/json_create_integer | |
+!****if* json_module/wrap_json_value_create_integer | |
! | |
! NAME | |
-! json_create_integer | |
+! wrap_json_value_create_integer | |
! | |
! DESCRIPTION | |
! Allocate a json_value pointer and make it an integer variable. | |
@@ -4460,7 +5773,7 @@ | |
! | |
! SOURCE | |
- subroutine json_create_integer(me,val,name) | |
+ subroutine json_value_create_integer(me,val,name) | |
implicit none | |
@@ -4471,14 +5784,43 @@ | |
call json_value_create(me) | |
call to_integer(me,val,name) | |
- end subroutine json_create_integer | |
+ end subroutine json_value_create_integer | |
+!***************************************************************************************** | |
+ | |
+!***************************************************************************************** | |
+!****if* json_module/json_value_create_integer | |
+! | |
+! NAME | |
+! json_value_create_integer | |
+! | |
+! DESCRIPTION | |
+! A wrapper procedure for json_value_create_integer so that json_create_integer | |
+! may be called with either a 'DEFAULT' or 'ISO_10646' character kind 'name' | |
+! actual argument. | |
+! | |
+! AUTHOR | |
+! Izaak Beekman | |
+! | |
+! SOURCE | |
+ | |
+ subroutine wrap_json_value_create_integer(me,val,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ integer(IK),intent(in) :: val | |
+ | |
+ call json_value_create_integer(me,val,to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_create_integer | |
!***************************************************************************************** | |
!***************************************************************************************** | |
-!****f* json_module/json_create_double | |
+!****if* json_module/json_value_create_double | |
! | |
! NAME | |
-! json_create_double | |
+! json_value_create_double | |
! | |
! DESCRIPTION | |
! Allocate a json_value pointer and make it a double variable. | |
@@ -4494,7 +5836,7 @@ | |
! | |
! SOURCE | |
- subroutine json_create_double(me,val,name) | |
+ subroutine json_value_create_double(me,val,name) | |
implicit none | |
@@ -4505,14 +5847,43 @@ | |
call json_value_create(me) | |
call to_double(me,val,name) | |
- end subroutine json_create_double | |
+ end subroutine json_value_create_double | |
+!***************************************************************************************** | |
+ | |
+!***************************************************************************************** | |
+!****if* json_module/wrap_json_value_create_double | |
+! | |
+! NAME | |
+! wrap_json_value_create_double | |
+! | |
+! DESCRIPTION | |
+! A wrapper for json_value_create_double so that json_create_double may be | |
+! called with an actual argument corresponding to the dummy argument, 'name' | |
+! that may be of 'DEFAULT' or 'ISO_10646' character kind. | |
+! | |
+! AUTHOR | |
+! Izaak Beekman | |
+! | |
+! SOURCE | |
+ | |
+ subroutine wrap_json_value_create_double(me,val,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ real(RK),intent(in) :: val | |
+ | |
+ call json_value_create_double(me,val,to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_create_double | |
!***************************************************************************************** | |
!***************************************************************************************** | |
-!****f* json_module/json_create_string | |
+!****if* json_module/json_value_create_string | |
! | |
! NAME | |
-! json_create_string | |
+! json_value_create_string | |
! | |
! DESCRIPTION | |
! Allocate a json_value pointer and make it a string variable. | |
@@ -4528,7 +5899,7 @@ | |
! | |
! SOURCE | |
- subroutine json_create_string(me,val,name) | |
+ subroutine json_value_create_string(me,val,name) | |
implicit none | |
@@ -4539,14 +5910,43 @@ | |
call json_value_create(me) | |
call to_string(me,val,name) | |
- end subroutine json_create_string | |
+ end subroutine json_value_create_string | |
+!***************************************************************************************** | |
+ | |
+!***************************************************************************************** | |
+!****if* json_module/wrap_json_value_create_string | |
+! | |
+! NAME | |
+! wrap_json_value_create_string | |
+! | |
+! DESCRIPTION | |
+! Wrap json_value-create_string so that json_create_string may be called with actual | |
+! character string arguments for 'name' and 'val' that are BOTH of 'DEFAULT' or | |
+! 'ISO_10646' character kind. | |
+! | |
+! AUTHOR | |
+! Izaak Beekman | |
+! | |
+! SOURCE | |
+ | |
+ subroutine wrap_json_value_create_string(me,val,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ character(kind=CDK,len=*),intent(in) :: val | |
+ | |
+ call json_value_create_string(me,to_unicode(val),to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_create_string | |
!***************************************************************************************** | |
!***************************************************************************************** | |
-!****f* json_module/json_create_null | |
+!****if* json_module/json_value_create_null | |
! | |
! NAME | |
-! json_create_null | |
+! json_value_create_null | |
! | |
! DESCRIPTION | |
! Allocate a json_value pointer and make it a null variable. | |
@@ -4562,7 +5962,7 @@ | |
! | |
! SOURCE | |
- subroutine json_create_null(me,name) | |
+ subroutine json_value_create_null(me,name) | |
implicit none | |
@@ -4572,14 +5972,42 @@ | |
call json_value_create(me) | |
call to_null(me,name) | |
- end subroutine json_create_null | |
+ end subroutine json_value_create_null | |
+!***************************************************************************************** | |
+ | |
+!***************************************************************************************** | |
+!****if* json_module/wrap_json_value_create_null | |
+! | |
+! NAME | |
+! wrap_json_value_create_null | |
+! | |
+! DESCRIPTION | |
+! Wrap json_value_create_null so that json_create_null may be called with an actual | |
+! argument corresponding to the dummy argument 'name' that is either of 'DEFAULT' or | |
+! 'ISO_10646' character kind. | |
+! | |
+! AUTHOR | |
+! Izaak Beekman | |
+! | |
+! SOURCE | |
+ | |
+ subroutine wrap_json_value_create_null(me,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ | |
+ call json_value_create_null(me,to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_create_null | |
!***************************************************************************************** | |
!***************************************************************************************** | |
-!****f* json_module/json_create_object | |
+!****if* json_module/json_value_create_object | |
! | |
! NAME | |
-! json_create_object | |
+! json_value_create_object | |
! | |
! DESCRIPTION | |
! Allocate a json_value pointer and make it an object variable. | |
@@ -4599,7 +6027,7 @@ | |
! | |
! SOURCE | |
- subroutine json_create_object(me,name) | |
+ subroutine json_value_create_object(me,name) | |
implicit none | |
@@ -4609,14 +6037,42 @@ | |
call json_value_create(me) | |
call to_object(me,name) | |
- end subroutine json_create_object | |
+ end subroutine json_value_create_object | |
+!***************************************************************************************** | |
+ | |
+!***************************************************************************************** | |
+!****if* json_module/wrap_json_value_create_object | |
+! | |
+! NAME | |
+! wrap_json_value_create_object | |
+! | |
+! DESCRIPTION | |
+! Wrap json_value_create_object so that json_create_object may be called with an actual | |
+! argument corresponding to the dummy argument 'name' that is of either 'DEFAULT' or | |
+! 'ISO_10646' character kind. | |
+! | |
+! AUTHOR | |
+! Izaak Beekman | |
+! | |
+! SOURCE | |
+ | |
+ subroutine wrap_json_value_create_object(me,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ | |
+ call json_value_create_object(me,to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_create_object | |
!***************************************************************************************** | |
!***************************************************************************************** | |
-!****f* json_module/json_create_array | |
+!****if* json_module/json_value_create_array | |
! | |
! NAME | |
-! json_create_array | |
+! json_value_create_array | |
! | |
! DESCRIPTION | |
! Allocate a json_value pointer and make it an array variable. | |
@@ -4632,7 +6088,7 @@ | |
! | |
! SOURCE | |
- subroutine json_create_array(me,name) | |
+ subroutine json_value_create_array(me,name) | |
implicit none | |
@@ -4642,7 +6098,35 @@ | |
call json_value_create(me) | |
call to_array(me,name) | |
- end subroutine json_create_array | |
+ end subroutine json_value_create_array | |
+!***************************************************************************************** | |
+ | |
+!***************************************************************************************** | |
+!****if* json_module/wrap_json_value_create_array | |
+! | |
+! NAME | |
+! wrap_json_value_create_array | |
+! | |
+! DESCRIPTION | |
+! A wrapper for json_value_create_array so that json_create_array may be called with | |
+! an actual argument, corresponding to the dummy argument 'name', that is either of | |
+! 'DEFAULT' or 'ISO_10646' character kind. | |
+! | |
+! AUTHOR | |
+! Izaak Beekman | |
+! | |
+! SOURCE | |
+ | |
+ subroutine wrap_json_value_create_array(me,name) | |
+ | |
+ implicit none | |
+ | |
+ type(json_value),pointer :: me | |
+ character(kind=CDK,len=*),intent(in) :: name | |
+ | |
+ call json_value_create_array(me,to_unicode(name)) | |
+ | |
+ end subroutine wrap_json_value_create_array | |
!***************************************************************************************** | |
!***************************************************************************************** | |
@@ -5037,7 +6521,7 @@ | |
if (eof) then | |
! The file ended before array was finished: | |
call throw_exception('Error in parse_array: '//& | |
- 'End of file encountered when parsing an array.') | |
+ 'End iffile encountered when parsing an array.') | |
exit | |
else if (delimiter == c) then | |
! parse the next element | |
@@ -5106,8 +6590,8 @@ | |
else if (quotation_mark == c .and. last /= backslash) then | |
- if (is_hex) call throw_exception('Error in parse_string:'//& | |
- ' incomplete hex string: \u'//trim(hex)) | |
+ if (is_hex) call throw_exception('Error in parse_string: '//& | |
+ 'incomplete hex string: \u'//trim(hex)) | |
exit | |
else | |
@@ -5126,8 +6610,8 @@ | |
hex = '' | |
is_hex = .false. | |
else | |
- call throw_exception('Error in parse_string:'//& | |
- ' invalid hex string: \u'//trim(hex)) | |
+ call throw_exception('Error in parse_string: '//& | |
+ 'invalid hex string: \u'//trim(hex)) | |
exit | |
end if | |
end if | |
@@ -5187,12 +6671,12 @@ | |
do i = 1, length | |
c = pop_char(unit, str=str, eof = eof, skip_ws = .true.) | |
if (eof) then | |
- call throw_exception('Error in parse_for_chars:'//& | |
- ' Unexpected end of file while parsing array.') | |
+ call throw_exception('Error in parse_for_chars: '//& | |
+ 'Unexpected end of file while parsing array.') | |
return | |
else if (c /= chars(i:i)) then | |
- call throw_exception('Error in parse_for_chars:'//& | |
- ' Unexpected character.: "'//c//'" '//chars(i:i)) | |
+ call throw_exception('Error in parse_for_chars: '//& | |
+ 'Unexpected character.: "'//c//'" '//chars(i:i)) | |
return | |
end if | |
end do | |
@@ -5255,21 +6739,21 @@ | |
else | |
select case (c) | |
- case('-','+') !note: allowing a '+' as the first character here. | |
+ case(CK_'-',CK_'+') !note: allowing a '+' as the first character here. | |
if (is_integer .and. (.not. first)) is_integer = .false. | |
!add it to the string: | |
tmp = tmp // c | |
- case('.','E','e') !can be present in real numbers | |
+ case(CK_'.',CK_'E',CK_'e') !can be present in real numbers | |
if (is_integer) is_integer = .false. | |
!add it to the string: | |
tmp = tmp // c | |
- case('0':'9') !valid characters for numbers | |
+ case(CK_'0':CK_'9') !valid characters for numbers | |
!add it to the string: | |
tmp = tmp // c | |
@@ -5396,8 +6880,7 @@ | |
end if | |
- if (iachar(c) <= 31) then !JW : fixed so it will read spaces | |
- ! in the string (was 32) | |
+ if (any(c == control_chars)) then | |
! non printing ascii characters | |
cycle | |
@@ -5450,8 +6933,8 @@ | |
pushed_char(pushed_index:pushed_index) = c | |
else | |
call integer_to_string(pushed_index,istr) | |
- call throw_exception('Error in push_char:'//& | |
- ' invalid valid of pushed_index: '//trim(istr)) | |
+ call throw_exception('Error in push_char: '//& | |
+ 'invalid valid of pushed_index: '//trim(istr)) | |
end if | |
end if | |
@@ -5575,7 +7058,7 @@ | |
sig_trim = len(trim(significand)) | |
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s | |
!but save one after the decimal place | |
- if (significand(i:i) == CK_'0') then | |
+ if (significand(i:i) == '0') then | |
sig_trim = i-1 | |
else | |
exit | |
@@ -5588,21 +7071,21 @@ | |
significand = str(1:exp_start-1) | |
sig_trim = len(trim(significand)) | |
do i = len(trim(significand)),decimal_pos+2,-1 !look from right to left at 0s | |
- if (significand(i:i) == CK_'0') then | |
+ if (significand(i:i) == '0') then | |
sig_trim = i-1 | |
else | |
exit | |
end if | |
end do | |
expnt = adjustl(str(exp_start+1:)) | |
- if (expnt(1:1) == CK_'+' .or. expnt(1:1) == CK_'-') then | |
+ if (expnt(1:1) == '+' .or. expnt(1:1) == '-') then | |
separator = trim(adjustl(separator))//expnt(1:1) | |
exp_start = exp_start + 1 | |
expnt = adjustl(str(exp_start+1:)) | |
end if | |
exp_trim = 1 | |
do i = 1,(len(trim(expnt))-1) !look at exponent leading zeros saving last | |
- if (expnt(i:i) == CK_'0') then | |
+ if (expnt(i:i) == '0') then | |
exp_trim = i+1 | |
else | |
exit | |
@@ -5666,7 +7149,60 @@ | |
end if | |
end function valid_json_hex | |
-!***************************************************************************************** | |
+ | |
+ | |
+ function to_uni(str) | |
+ character(kind=CDK,len=*), intent(in) :: str | |
+ character(kind=CK,len=len(str)) :: to_uni | |
+ | |
+ to_uni = str | |
+ | |
+ end function to_uni | |
+ | |
+ function to_uni_vec(str) | |
+ character(kind=CDK,len=*), dimension(:), intent(in) :: str | |
+ character(kind=CK,len=len(str)), dimension(size(str)) :: to_uni_vec | |
+ | |
+ to_uni_vec = str | |
+ | |
+ end function to_uni_vec | |
+ | |
+ function ucs4_join_default(ucs4_str,def_str) result(res) | |
+ character(kind=CK, len=*), intent(in) :: ucs4_str | |
+ character(kind=CDK,len=*), intent(in) :: def_str | |
+ character(kind=CK,len=(len(ucs4_str)+len(def_str))) :: res | |
+ | |
+ res = ucs4_str//to_unicode(def_str) | |
+ | |
+ end function ucs4_join_default | |
+ | |
+ function default_join_ucs4(def_str,ucs4_str) result(res) | |
+ character(kind=CDK,len=*), intent(in) :: def_str | |
+ character(kind=CK, len=*), intent(in) :: ucs4_str | |
+ character(kind=CK,len=(len(def_str)+len(ucs4_str))) :: res | |
+ | |
+ res = to_unicode(def_str)//ucs4_str | |
+ | |
+ end function default_join_ucs4 | |
+ | |
+ function ucs4_comp_default(ucs4_str,def_str) result(res) | |
+ character(kind=CK, len=*), intent(in) :: ucs4_str | |
+ character(kind=CDK,len=*), intent(in) :: def_str | |
+ logical(LK) :: res | |
+ | |
+ res = ( ucs4_str == to_unicode(def_str) ) | |
+ | |
+ end function ucs4_comp_default | |
+ | |
+ function default_comp_ucs4(def_str,ucs4_str) result(res) | |
+ character(kind=CDK,len=*), intent(in) :: def_str | |
+ character(kind=CK, len=*), intent(in) :: ucs4_str | |
+ logical(LK) :: res | |
+ | |
+ res = ( to_unicode(def_str) == ucs4_str) | |
+ | |
+ end function default_comp_ucs4 | |
+ | |
!***************************************************************************************** | |
!****if* json_module/json_print_error_message | |
@@ -5691,9 +7227,9 @@ | |
implicit none | |
- integer,intent(in),optional :: io_unit | |
+ integer, intent(in), optional :: io_unit | |
- character(len=:),allocatable :: error_msg | |
+ character(kind=CK,len=:),allocatable :: error_msg | |
logical :: status_ok | |
!get error message: |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment