From 58c905d318883b4b20d1fb6026c57789c943a9ea Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 8 Feb 2023 08:37:10 +0100 Subject: [PATCH 1/6] strlen returns 'size_t' this is unsinged and on 64bit Linux (LP64) 64bit --- src/C_routines.c | 4 ++-- src/YAML_parse.f90 | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/C_routines.c b/src/C_routines.c index 37364543d..26d704974 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -86,7 +86,7 @@ void inflate_c(const uLong *s_deflated, const uLong *s_inflated, const Byte defl } #ifdef FYAML -void to_flow_c(char **flow, int* length_flow, const char *mixed){ +void to_flow_c(char **flow, long* length_flow, const char *mixed){ struct fy_document *fyd = NULL; enum fy_emitter_cfg_flags emit_flags = FYECF_MODE_FLOW_ONELINE | FYECF_STRIP_LABELS | FYECF_STRIP_TAGS |FYECF_STRIP_DOC; @@ -102,7 +102,7 @@ void to_flow_c(char **flow, int* length_flow, const char *mixed){ } *flow = fy_emit_document_to_string(fyd,emit_flags); - *length_flow = strlen(*flow); + *length_flow = (long) strlen(*flow); fy_document_destroy(fyd); } diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index b1f5aaf71..cd79fe713 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -24,11 +24,11 @@ module YAML_parse interface subroutine to_flow_C(flow,length_flow,mixed) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR, C_PTR + use, intrinsic :: ISO_C_Binding, only: C_LONG, C_CHAR, C_PTR implicit none(type,external) type(C_PTR), intent(out) :: flow - integer(C_INT), intent(out) :: length_flow + integer(C_LONG), intent(out) :: length_flow character(kind=C_CHAR), dimension(*), intent(in) :: mixed end subroutine to_flow_C @@ -216,7 +216,7 @@ function to_flow(mixed) result(flow) character(:,C_CHAR), allocatable :: flow type(C_PTR) :: str_ptr - integer(C_INT) :: strlen + integer(C_LONG) :: strlen call to_flow_C(str_ptr,strlen,f_c_string(mixed)) @@ -226,7 +226,7 @@ function to_flow(mixed) result(flow) block character(len=strlen,kind=c_char), pointer :: s call c_f_pointer(str_ptr,s) - flow = s(:len(s)-1) + flow = s(:len(s,pI64)-1_pI64) end block call free_C(str_ptr) From 4e57df95768e6a623370f839ca8273055f56ec10 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 8 Feb 2023 08:49:08 +0100 Subject: [PATCH 2/6] handle strings/YAML files > 2Gb (32 bit limit) --- src/YAML_parse.f90 | 61 +++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index cd79fe713..89cbcd147 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -95,33 +95,34 @@ end function YAML_parse_str_asDict !-------------------------------------------------------------------------------------------------- recursive function parse_flow(YAML_flow) result(node) - character(len=*), intent(in) :: YAML_flow !< YAML file in flow style - class(tNode), pointer :: node + character(len=*), intent(in) :: YAML_flow !< YAML file in flow style + class(tNode), pointer :: node - class(tNode), pointer :: & + class(tNode), pointer :: & myVal - character(len=:), allocatable :: & + character(len=:), allocatable :: & flow_string, & key - integer :: & + integer(pI64) :: & e, & ! end position of dictionary or list s, & ! start position of dictionary or list d ! position of key: value separator (':') + flow_string = trim(adjustl(YAML_flow)) - if (len_trim(flow_string) == 0) then + if (len_trim(flow_string,pI64) == 0_pI64) then node => emptyDict return elseif (flow_string(1:1) == '{') then ! start of a dictionary - e = 1 + e = 1_pI64 allocate(tDict::node) - do while (e < len_trim(flow_string)) + do while (e < len_trim(flow_string,pI64)) s = e - d = s + scan(flow_string(s+1:),':') - e = d + find_end(flow_string(d+1:),'}') - key = trim(adjustl(flow_string(s+1:d-1))) + d = s + scan(flow_string(s+1_pI64:),':',kind=pI64) + e = d + find_end(flow_string(d+1_pI64:),'}') + key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64))) if (quotedString(key)) key = key(2:len(key)-1) - myVal => parse_flow(flow_string(d+1:e-1)) ! parse items (recursively) + myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively) select type (node) class is (tDict) @@ -129,12 +130,12 @@ recursive function parse_flow(YAML_flow) result(node) end select end do elseif (flow_string(1:1) == '[') then ! start of a list - e = 1 + e = 1_pI64 allocate(tList::node) - do while (e < len_trim(flow_string)) + do while (e < len_trim(flow_string,pI64)) s = e - e = s + find_end(flow_string(s+1:),']') - myVal => parse_flow(flow_string(s+1:e-1)) ! parse items (recursively) + e = s + find_end(flow_string(s+1_pI64:),']') + myVal => parse_flow(flow_string(s+1_pI64:e-1_pI64)) ! parse items (recursively) select type (node) class is (tList) @@ -165,21 +166,21 @@ integer function find_end(str,e_char) character(len=*), intent(in) :: str !< chunk of YAML flow string character, intent(in) :: e_char !< end of list/dict ( '}' or ']') - integer :: N_sq, & !< number of open square brackets - N_cu, & !< number of open curly brackets - i + integer(pI64) :: N_sq, & !< number of open square brackets + N_cu, & !< number of open curly brackets + i - N_sq = 0 - N_cu = 0 - i = 1 - do while(i<=len_trim(str)) - if (scan(str(i:i),IO_QUOTES) == 1) i = i + scan(str(i+1:),str(i:i)) - if (N_sq==0 .and. N_cu==0 .and. scan(str(i:i),e_char//',') == 1) exit - N_sq = N_sq + merge(1,0,str(i:i) == '[') - N_cu = N_cu + merge(1,0,str(i:i) == '{') - N_sq = N_sq - merge(1,0,str(i:i) == ']') - N_cu = N_cu - merge(1,0,str(i:i) == '}') - i = i + 1 + N_sq = 0_pI64 + N_cu = 0_pI64 + i = 1_pI64 + do while(i<=len_trim(str,pI64)) + if (scan(str(i:i),IO_QUOTES,kind=pI64) == 1_pI64) i = i + scan(str(i+1:),str(i:i),kind=pI64) + if (N_sq==0 .and. N_cu==0 .and. scan(str(i:i),e_char//',',kind=pI64) == 1_pI64) exit + N_sq = N_sq + merge(1_pI64,0_pI64,str(i:i) == '[') + N_cu = N_cu + merge(1_pI64,0_pI64,str(i:i) == '{') + N_sq = N_sq - merge(1_pI64,0_pI64,str(i:i) == ']') + N_cu = N_cu - merge(1_pI64,0_pI64,str(i:i) == '}') + i = i + 1_pI64 end do find_end = i From a2bde4a0f04f7094dec23b2c69a281114dc5be7b Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 9 Feb 2023 23:32:39 +0100 Subject: [PATCH 3/6] correct check for CRLF old attempt tried to look only at forst occurence of LF but reported CRLF also for LF endings. --- src/IO.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index c83ea1a22..b7bd5e982 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -136,8 +136,8 @@ function IO_read(fileName) result(fileContent) if (myStat /= 0) call IO_error(102,trim(fileName)) close(fileUnit) - if (scan(fileContent(:index(fileContent,LF)),CR//LF) /= 0) fileContent = CRLF2LF(fileContent) - if (fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF + if (index(fileContent,CR//LF) /= 0) fileContent = CRLF2LF(fileContent) + if (fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF end function IO_read From 3e439503fe0378c63a671bef5f2d34f442649a36 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Thu, 9 Feb 2023 23:34:45 +0100 Subject: [PATCH 4/6] enable strings > 2Gb --- src/IO.f90 | 16 ++++++++-------- src/YAML_parse.f90 | 2 +- src/system_routines.f90 | 14 +++++++------- 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/IO.f90 b/src/IO.f90 index b7bd5e982..2ca2afd70 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -136,7 +136,7 @@ function IO_read(fileName) result(fileContent) if (myStat /= 0) call IO_error(102,trim(fileName)) close(fileUnit) - if (index(fileContent,CR//LF) /= 0) fileContent = CRLF2LF(fileContent) + if (index(fileContent,CR//LF,kind=pI64) /= 0) fileContent = CRLF2LF(fileContent) if (fileContent(fileLength:fileLength) /= IO_EOL) fileContent = fileContent//IO_EOL ! ensure EOL@EOF end function IO_read @@ -607,17 +607,17 @@ pure function CRLF2LF(string) character(len=*), intent(in) :: string character(len=:), allocatable :: CRLF2LF - integer :: c,n + integer(pI64) :: c,n - allocate(character(len=len_trim(string))::CRLF2LF) - if (len(CRLF2LF) == 0) return + allocate(character(len=len_trim(string,pI64))::CRLF2LF) + if (len(CRLF2LF,pI64) == 0) return - n = 0 - do c=1, len_trim(string) + n = 0_pI64 + do c=1_pI64, len_trim(string,pI64) CRLF2LF(c-n:c-n) = string(c:c) - if (c == len_trim(string)) exit - if (string(c:c+1) == CR//LF) n = n + 1 + if (c == len_trim(string,pI64)) exit + if (string(c:c+1_pI64) == CR//LF) n = n + 1_pI64 end do CRLF2LF = CRLF2LF(:c-n) diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index 89cbcd147..d0f047a4a 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -221,7 +221,7 @@ function to_flow(mixed) result(flow) call to_flow_C(str_ptr,strlen,f_c_string(mixed)) - if (strlen < 1) call IO_error(703,ext_msg='libyfaml') + if (strlen < 1_C_LONG) call IO_error(703,ext_msg='libyfaml') allocate(character(len=strlen,kind=c_char) :: flow) block diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 74aa4685b..6b9f7d908 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -181,15 +181,15 @@ pure function c_f_string(c_string) result(f_string) character(kind=C_CHAR), dimension(:), intent(in) :: c_string character(len=:), allocatable :: f_string - integer :: i + integer(pI64) :: i - allocate(character(len=size(c_string))::f_string) - arrayToString: do i=1,len(f_string) + allocate(character(len=size(c_string,kind=pI64))::f_string) + arrayToString: do i=1_pI64,len(f_string,pI64) if (c_string(i) /= C_NULL_CHAR) then f_string(i:i)=c_string(i) else - f_string = f_string(:i-1) + f_string = f_string(:i-1_pI64) exit end if end do arrayToString @@ -203,11 +203,11 @@ end function c_f_string !-------------------------------------------------------------------------------------------------- pure function f_c_string(f_string) result(c_string) - character(len=*), intent(in) :: f_string - character(kind=C_CHAR), dimension(len_trim(f_string)+1) :: c_string + character(len=*), intent(in) :: f_string + character(kind=C_CHAR), dimension(len_trim(f_string,pI64)+1_pI64) :: c_string - c_string = transfer(trim(f_string)//C_NULL_CHAR,c_string,size=size(c_string)) + c_string = transfer(trim(f_string)//C_NULL_CHAR,c_string,size=size(c_string,kind=pI64)) end function f_c_string From 9e4db451d9d4df5b16c6a9a39b18eef152d687fc Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Sat, 11 Feb 2023 08:10:12 +0100 Subject: [PATCH 5/6] enable to write large strings SIZE_T is the correct type (and 64bit instead of 32bit as for HSIZE_T) for H5Tset_size_f --- src/HDF5_utilities.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 index a87046c5a..7c766998d 100644 --- a/src/HDF5_utilities.f90 +++ b/src/HDF5_utilities.f90 @@ -1550,19 +1550,19 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName) integer(HID_T) :: filetype_id, memtype_id, space_id, dataset_id, dcpl integer :: hdferr - character(len=len_trim(dataset),kind=C_CHAR), target :: dataset_ + character(len=len_trim(dataset,pI64),kind=C_CHAR), target :: dataset_ dataset_ = trim(dataset) call H5Tcopy_f(H5T_C_S1, filetype_id, hdferr) if (hdferr < 0) error stop 'HDF5 error' - call H5Tset_size_f(filetype_id, int(len(dataset_)+1,HSIZE_T), hdferr) ! +1 for NULL + call H5Tset_size_f(filetype_id, len(dataset_,SIZE_T)+1_SIZE_T, hdferr) ! +1 for NULL if (hdferr < 0) error stop 'HDF5 error' call H5Tcopy_f(H5T_FORTRAN_S1, memtype_id, hdferr) if (hdferr < 0) error stop 'HDF5 error' - call H5Tset_size_f(memtype_id, int(len(dataset_),HSIZE_T), hdferr) + call H5Tset_size_f(memtype_id, len(dataset_,SIZE_T), hdferr) if (hdferr < 0) error stop 'HDF5 error' call H5Pcreate_f(H5P_DATASET_CREATE_F, dcpl, hdferr) @@ -1571,7 +1571,7 @@ subroutine HDF5_write_str(dataset,loc_id,datasetName) if (hdferr < 0) error stop 'HDF5 error' call H5Pset_Fletcher32_f(dcpl,hdferr) if (hdferr < 0) error stop 'HDF5 error' - if (compression_possible .and. len(dataset) > 1024*256) then + if (compression_possible .and. len(dataset,pI64) > 1024_pI64*256_pI64) then call H5Pset_shuffle_f(dcpl, hdferr) if (hdferr < 0) error stop 'HDF5 error' call H5Pset_deflate_f(dcpl, 6, hdferr) From 0698c17ff276b20df690c9f26aea23eceec076a7 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 14 Feb 2023 17:37:43 +0100 Subject: [PATCH 6/6] improved documentation --- src/YAML_parse.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index d51a0ca98..fc06eae87 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -90,7 +90,7 @@ end function YAML_parse_str_asDict !-------------------------------------------------------------------------------------------------- -!> @brief reads the flow style string and stores it in the form of dictionaries, lists and scalars. +!> @brief Read the flow style string and store it in the form of dictionaries, lists and scalars. !> @details A node type pointer can either point to a dictionary, list or scalar type entities. !-------------------------------------------------------------------------------------------------- recursive function parse_flow(YAML_flow) result(node) @@ -122,7 +122,7 @@ recursive function parse_flow(YAML_flow) result(node) e = d + find_end(flow_string(d+1_pI64:),'}') key = trim(adjustl(flow_string(s+1_pI64:d-1_pI64))) if (quotedString(key)) key = key(2:len(key)-1) - myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively) + myVal => parse_flow(flow_string(d+1_pI64:e-1_pI64)) ! parse items (recursively) select type (node) class is (tDict) @@ -135,7 +135,7 @@ recursive function parse_flow(YAML_flow) result(node) do while (e < len_trim(flow_string,pI64)) s = e e = s + find_end(flow_string(s+1_pI64:),']') - myVal => parse_flow(flow_string(s+1_pI64:e-1_pI64)) ! parse items (recursively) + myVal => parse_flow(flow_string(s+1_pI64:e-1_pI64)) ! parse items (recursively) select type (node) class is (tList) @@ -158,7 +158,7 @@ end function parse_flow !-------------------------------------------------------------------------------------------------- -!> @brief finds location of chunk end: ',' or '}' or ']' +!> @brief Find location of chunk end: ',' or '}' or ']'. !> @details leaves nested lists ( '[...]' and dicts '{...}') intact !-------------------------------------------------------------------------------------------------- integer function find_end(str,e_char) @@ -188,7 +188,7 @@ end function find_end !-------------------------------------------------------------------------------------------------- -! @brief check whether a string is enclosed with single or double quotes +! @brief Check whether a string is enclosed with single or double quotes. !-------------------------------------------------------------------------------------------------- logical function quotedString(line) @@ -254,7 +254,7 @@ end function indentDepth !-------------------------------------------------------------------------------------------------- -! @brief check whether a string is in flow style, i.e. starts with '{' or '[' +! @brief Check whether a string is in flow style, i.e. starts with '{' or '[' !-------------------------------------------------------------------------------------------------- logical function isFlow(line)