From 723252ef15e613d3a7f5706a50d6a5f6ba519710 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 12 Apr 2022 22:14:04 +0200 Subject: [PATCH] libfyaml backend currently it simply converts the whole file content to flow mode. The nice thing is: It can convert EVERYTHING to flow mode. libfyaml is the only library that passes the whole YAML test suite --- CMakeLists.txt | 10 ++++-- src/C_routines.c | 27 ++++++++++++++ src/IO.f90 | 4 ++- src/YAML_parse.f90 | 75 ++++++++++++++++++++++++++++++++------ src/system_routines.f90 | 80 ++++++++++++++++++++++------------------- 5 files changed, 146 insertions(+), 50 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index cad36e42c..6994afc77 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -115,8 +115,14 @@ if(CMAKE_BUILD_TYPE STREQUAL "DEBUG") set(CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} ${DEBUG_FLAGS}") endif() -set(CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${PETSC_INCLUDES} ${BUILDCMD_POST}") -set(CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} -o -L${PETSC_LIBRARY_DIRS} -lpetsc ${PETSC_EXTERNAL_LIB} -lz ${BUILDCMD_POST}") +set(CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE} "${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}} ${PETSC_INCLUDES} ${BUILDCMD_POST}") + +set(CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} -o -L${PETSC_LIBRARY_DIRS} -lpetsc ${PETSC_EXTERNAL_LIB} -lz") +if(fYAML_FOUND STREQUAL "1") + set(CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} -L${fYAML_LIBRARY_DIRS} -l${fYAML_LIBRARIES}") + add_definitions(-DFYAML) +endif() +set(CMAKE_Fortran_LINK_EXECUTABLE "${CMAKE_Fortran_LINK_EXECUTABLE} ${BUILDCMD_POST}") message("Fortran Compiler Flags:\n${CMAKE_Fortran_FLAGS_${CMAKE_BUILD_TYPE}}\n") message("C Compiler Flags:\n${CMAKE_C_FLAGS_${CMAKE_BUILD_TYPE}}\n") diff --git a/src/C_routines.c b/src/C_routines.c index 3d62a87c2..c4ebb4d6b 100644 --- a/src/C_routines.c +++ b/src/C_routines.c @@ -9,6 +9,10 @@ #include #include "zlib.h" +#ifdef FYAML +#include +#endif + #define PATHLEN 4096 #define STRLEN 256 @@ -80,3 +84,26 @@ 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){ + struct fy_document *fyd = NULL; + enum fy_emitter_cfg_flags emit_flags = FYECF_MODE_FLOW_ONELINE | FYECF_STRIP_LABELS | FYECF_STRIP_DOC; + + fyd = fy_document_build_from_string(NULL, mixed, -1); + if (!fyd) { + *length_flow = -1; + return; + } + int err = fy_document_resolve(fyd); + if (err) { + *length_flow = -1; + return; + } + + *flow = fy_emit_document_to_string(fyd,emit_flags); + *length_flow = strlen(*flow); + + fy_document_destroy(fyd); +} +#endif diff --git a/src/IO.f90 b/src/IO.f90 index 493970824..240c9e992 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -483,7 +483,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (701) msg = 'Incorrect indent/Null value not allowed' case (702) - msg = 'Invalid use of flow yaml' + msg = 'Invalid use of flow YAML' + case (703) + msg = 'Invalid YAML' case (704) msg = 'Space expected after a colon for : pair' case (705) diff --git a/src/YAML_parse.f90 b/src/YAML_parse.f90 index 8a3264cff..e589758c9 100644 --- a/src/YAML_parse.f90 +++ b/src/YAML_parse.f90 @@ -8,6 +8,9 @@ module YAML_parse use prec use IO use YAML_types +#ifdef FYAML + use system_routines +#endif implicit none private @@ -16,14 +19,34 @@ module YAML_parse YAML_parse_init, & YAML_parse_str +#ifdef FYAML + interface + + subroutine to_flow_C(flow,length_flow,mixed) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR, C_PTR + + type(C_PTR), intent(out) :: flow + integer(C_INT), intent(out) :: length_flow + character(kind=C_CHAR), dimension(*), intent(in) :: mixed + end subroutine to_flow_C + + end interface +#endif + + contains !-------------------------------------------------------------------------------------------------- !> @brief Do sanity checks. !-------------------------------------------------------------------------------------------------- -subroutine YAML_parse_init +subroutine YAML_parse_init() - call selfTest + print'(/,1x,a)', '<<<+- YAML_parse init -+>>>' +#ifdef FYAML + print'(/,1x,a)', 'libfyaml powered' +#else + call selfTest() +#endif end subroutine YAML_parse_init @@ -155,8 +178,37 @@ logical function quotedString(line) end function quotedString +#ifdef FYAML !-------------------------------------------------------------------------------------------------- -! @brief Returns Indentation. +! @brief Convert all block style YAML parts to flow style. +!-------------------------------------------------------------------------------------------------- +function to_flow(mixed) result(flow) + + character(len=*), intent(in) :: mixed + character(:,C_CHAR), allocatable :: flow + + type(C_PTR) :: str_ptr + integer(C_INT) :: strlen + + + call to_flow_C(str_ptr,strlen,f_c_string(mixed)) + if (strlen < 1) call IO_error(703,ext_msg='libyfaml') + allocate(character(len=strlen,kind=c_char) :: flow) + + block + character(len=strlen,kind=c_char), pointer :: s + call c_f_pointer(str_ptr,s) + flow = s + end block + + call free_C(str_ptr) + +end function to_flow + + +#else +!-------------------------------------------------------------------------------------------------- +! @brief Determine Indentation. ! @details It determines the indentation level for a given block/line. ! In cases for nested lists, an offset is added to determine the indent of the item block (skip ! leading dashes) @@ -280,7 +332,7 @@ subroutine skip_empty_lines(blck,s_blck) enddo end subroutine skip_empty_lines - + !-------------------------------------------------------------------------------------------------- ! @brief skip file header @@ -303,7 +355,7 @@ subroutine skip_file_header(blck,s_blck) call IO_error(708,ext_msg = line) end if end if - + end subroutine skip_file_header @@ -371,7 +423,7 @@ subroutine list_item_inline(blck,s_blck,inline,offset) character(len=:), allocatable :: line integer :: indent,indent_next - + indent = indentDepth(blck(s_blck:),offset) line = IO_rmComment(blck(s_blck:s_blck + index(blck(s_blck:),IO_EOL) - 2)) inline = line(indent-offset+3:) @@ -385,7 +437,7 @@ subroutine list_item_inline(blck,s_blck,inline,offset) indent_next = indentDepth(blck(s_blck:)) enddo - if(scan(inline,",") > 0) inline = '"'//inline//'"' + if(scan(inline,",") > 0) inline = '"'//inline//'"' end subroutine list_item_inline @@ -737,7 +789,7 @@ end subroutine !-------------------------------------------------------------------------------------------------- -! @brief convert all block style YAML parts to flow style +! @brief Convert all block style YAML parts to flow style. !-------------------------------------------------------------------------------------------------- function to_flow(blck) @@ -749,7 +801,7 @@ function to_flow(blck) s_flow, & !< start position in flow offset, & !< counts leading '- ' in nested lists end_line - + allocate(character(len=len(blck)*2)::to_flow) s_flow = 1 s_blck = 1 @@ -876,7 +928,7 @@ subroutine selfTest character(len=*), parameter :: flow = & '{a: ["b", {c: "d"}, "e"]}' - + if( .not. to_flow(flow_multi) == flow) error stop 'to_flow' end block multi_line_flow1 @@ -889,7 +941,7 @@ subroutine selfTest "[c,"//IO_EOL//& "d"//IO_EOL//& "e, f]}"//IO_EOL - + character(len=*), parameter :: flow = & "[{a: {b: [c, d e, f]}}]" @@ -921,5 +973,6 @@ subroutine selfTest end block basic_mixed end subroutine selfTest +#endif end module YAML_parse diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 2eb0b7958..e0adf9dc0 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -17,59 +17,67 @@ module system_routines getUserName, & signalterm_C, & signalusr1_C, & - signalusr2_C + signalusr2_C, & + f_c_string, & + free_C interface - function setCWD_C(cwd) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR + function setCWD_C(cwd) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR - integer(C_INT) :: setCWD_C - character(kind=C_CHAR), dimension(*), intent(in) :: cwd - end function setCWD_C + integer(C_INT) :: setCWD_C + character(kind=C_CHAR), dimension(*), intent(in) :: cwd + end function setCWD_C - subroutine getCWD_C(cwd, stat) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR - use prec + subroutine getCWD_C(cwd, stat) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR + use prec - character(kind=C_CHAR), dimension(pPathLen+1), intent(out) :: cwd ! NULL-terminated array - integer(C_INT), intent(out) :: stat - end subroutine getCWD_C + character(kind=C_CHAR), dimension(pPathLen+1), intent(out) :: cwd ! NULL-terminated array + integer(C_INT), intent(out) :: stat + end subroutine getCWD_C - subroutine getHostName_C(hostname, stat) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR - use prec + subroutine getHostName_C(hostname, stat) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR + use prec - character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array - integer(C_INT), intent(out) :: stat - end subroutine getHostName_C + character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array + integer(C_INT), intent(out) :: stat + end subroutine getHostName_C - subroutine getUserName_C(username, stat) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR - use prec + subroutine getUserName_C(username, stat) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR + use prec - character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array - integer(C_INT), intent(out) :: stat - end subroutine getUserName_C + character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array + integer(C_INT), intent(out) :: stat + end subroutine getUserName_C - subroutine signalterm_C(handler) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_FUNPTR + subroutine signalterm_C(handler) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_FUNPTR - type(C_FUNPTR), intent(in), value :: handler - end subroutine signalterm_C + type(C_FUNPTR), intent(in), value :: handler + end subroutine signalterm_C - subroutine signalusr1_C(handler) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_FUNPTR + subroutine signalusr1_C(handler) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_FUNPTR - type(C_FUNPTR), intent(in), value :: handler - end subroutine signalusr1_C + type(C_FUNPTR), intent(in), value :: handler + end subroutine signalusr1_C - subroutine signalusr2_C(handler) bind(C) - use, intrinsic :: ISO_C_Binding, only: C_FUNPTR + subroutine signalusr2_C(handler) bind(C) + use, intrinsic :: ISO_C_Binding, only: C_FUNPTR + + type(C_FUNPTR), intent(in), value :: handler + end subroutine signalusr2_C + + subroutine free_C(ptr) bind(C,name='free') + import c_ptr + type(c_ptr), value :: ptr + end subroutine free_C - type(C_FUNPTR), intent(in), value :: handler - end subroutine signalusr2_C end interface