From b3fdb182b8176f2c8633a3e7c26b99ee804ad542 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Feb 2024 05:53:34 +0300 Subject: [PATCH 01/27] Extract zip, unfinished array mapping --- CMakeLists.txt | 3 + example/io/example_loadnpy.f90 | 2 +- example/io/example_savenpy.f90 | 2 +- src/CMakeLists.txt | 8 +- src/stdlib_array.f90 | 68 --- src/stdlib_array.fypp | 88 ++++ src/stdlib_io_minizip.f90 | 124 +++++ src/{stdlib_io_npy.fypp => stdlib_io_np.fypp} | 94 ++-- src/stdlib_io_npy_load.fypp | 5 +- src/stdlib_io_npy_save.fypp | 2 +- src/stdlib_io_npz_load.fypp | 105 ++++ src/stdlib_io_npz_save.fypp | 35 ++ src/stdlib_io_zip.f90 | 134 +++++ test/CMakeLists.txt | 1 + test/io/CMakeLists.txt | 3 +- test/io/{test_npy.f90 => test_np.f90} | 462 ++++++++++-------- test/io/test_zip.f90 | 193 ++++++++ 17 files changed, 1022 insertions(+), 307 deletions(-) delete mode 100644 src/stdlib_array.f90 create mode 100644 src/stdlib_array.fypp create mode 100644 src/stdlib_io_minizip.f90 rename src/{stdlib_io_npy.fypp => stdlib_io_np.fypp} (64%) create mode 100644 src/stdlib_io_npz_load.fypp create mode 100644 src/stdlib_io_npz_save.fypp create mode 100644 src/stdlib_io_zip.f90 rename test/io/{test_npy.f90 => test_np.f90} (51%) create mode 100644 test/io/test_zip.f90 diff --git a/CMakeLists.txt b/CMakeLists.txt index b10e1f73d..855e31e60 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -48,6 +48,9 @@ if(NOT FYPP) message(FATAL_ERROR "Preprocessor fypp not found! Please install fypp following the instructions in https://fypp.readthedocs.io/en/stable/fypp.html#installing") endif() +# --- find dependencies +find_library(MINIZIP_LIBRARY NAMES minizip HINTS /opt/homebrew/Caskroom/miniconda/base/envs/minizip/lib) + # Custom preprocessor flags if(DEFINED CMAKE_MAXIMUM_RANK) set(fyppFlags "-DMAXRANK=${CMAKE_MAXIMUM_RANK}") diff --git a/example/io/example_loadnpy.f90 b/example/io/example_loadnpy.f90 index b037312ec..8bdd2ec3a 100644 --- a/example/io/example_loadnpy.f90 +++ b/example/io/example_loadnpy.f90 @@ -1,5 +1,5 @@ program example_loadnpy - use stdlib_io_npy, only: load_npy + use stdlib_io_np, only: load_npy implicit none real, allocatable :: x(:, :) call load_npy('example.npy', x) diff --git a/example/io/example_savenpy.f90 b/example/io/example_savenpy.f90 index b6929f40f..df1440c42 100644 --- a/example/io/example_savenpy.f90 +++ b/example/io/example_savenpy.f90 @@ -1,5 +1,5 @@ program example_savenpy - use stdlib_io_npy, only: save_npy + use stdlib_io_np, only: save_npy implicit none real :: x(3, 2) = 1 call save_npy('example.npy', x) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 0c2f76c8d..ecbd68d80 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -2,6 +2,7 @@ # Create a list of the files to be preprocessed set(fppFiles + stdlib_array.fypp stdlib_ascii.fypp stdlib_bitsets.fypp stdlib_bitsets_64.fypp @@ -15,9 +16,12 @@ set(fppFiles stdlib_hash_64bit_pengy.fypp stdlib_hash_64bit_spookyv2.fypp stdlib_io.fypp - stdlib_io_npy.fypp + stdlib_io_np.fypp stdlib_io_npy_load.fypp + stdlib_io_npz_load.fypp stdlib_io_npy_save.fypp + stdlib_io_npz_load.fypp + stdlib_io_npz_save.fypp stdlib_kinds.fypp stdlib_linalg.fypp stdlib_linalg_diag.fypp @@ -83,6 +87,8 @@ set(SRC stdlib_specialfunctions_legendre.f90 stdlib_quadrature_gauss.f90 stdlib_stringlist_type.f90 + stdlib_io_zip.f90 + stdlib_io_minizip.f90 ${outFiles} ) diff --git a/src/stdlib_array.f90 b/src/stdlib_array.f90 deleted file mode 100644 index c5e4fa004..000000000 --- a/src/stdlib_array.f90 +++ /dev/null @@ -1,68 +0,0 @@ -! SPDX-Identifier: MIT - -!> Module for index manipulation and general array handling -!> -!> The specification of this module is available [here](../page/specs/stdlib_array.html). -module stdlib_array - implicit none - private - - public :: trueloc, falseloc - -contains - - !> Version: experimental - !> - !> Return the positions of the true elements in array. - !> [Specification](../page/specs/stdlib_array.html#trueloc) - pure function trueloc(array, lbound) result(loc) - !> Mask of logicals - logical, intent(in) :: array(:) - !> Lower bound of array to index - integer, intent(in), optional :: lbound - !> Locations of true elements - integer :: loc(count(array)) - - call logicalloc(loc, array, .true., lbound) - end function trueloc - - !> Version: experimental - !> - !> Return the positions of the false elements in array. - !> [Specification](../page/specs/stdlib_array.html#falseloc) - pure function falseloc(array, lbound) result(loc) - !> Mask of logicals - logical, intent(in) :: array(:) - !> Lower bound of array to index - integer, intent(in), optional :: lbound - !> Locations of false elements - integer :: loc(count(.not.array)) - - call logicalloc(loc, array, .false., lbound) - end function falseloc - - !> Return the positions of the truthy elements in array - pure subroutine logicalloc(loc, array, truth, lbound) - !> Locations of truthy elements - integer, intent(out) :: loc(:) - !> Mask of logicals - logical, intent(in) :: array(:) - !> Truthy value - logical, intent(in) :: truth - !> Lower bound of array to index - integer, intent(in), optional :: lbound - integer :: i, pos, offset - - offset = 0 - if (present(lbound)) offset = lbound - 1 - - i = 0 - do pos = 1, size(array) - if (array(pos).eqv.truth) then - i = i + 1 - loc(i) = pos + offset - end if - end do - end subroutine logicalloc - -end module stdlib_array diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp new file mode 100644 index 000000000..f5087a857 --- /dev/null +++ b/src/stdlib_array.fypp @@ -0,0 +1,88 @@ +! SPDX-Identifier: MIT + +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES + +!> Module for index manipulation and general array handling +!> +!> The specification of this module is available [here](../page/specs/stdlib_array.html). +module stdlib_array + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp + implicit none + private + + public :: trueloc, falseloc + + type, public :: t_array_bundle + class(t_array), allocatable :: files(:) + end type + + type, abstract, public :: t_array + character(:), allocatable :: name + end type + + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + type, extends(t_array), public :: t_array_${t1[0]}$${k1}$_${rank}$ + ${t1}$, allocatable :: values${ranksuffix(rank)}$ + end type + #:endfor + #:endfor + +contains + + !> Version: experimental + !> + !> Return the positions of the true elements in array. + !> [Specification](../page/specs/stdlib_array.html#trueloc) + pure function trueloc(array, lbound) result(loc) + !> Mask of logicals + logical, intent(in) :: array(:) + !> Lower bound of array to index + integer, intent(in), optional :: lbound + !> Locations of true elements + integer :: loc(count(array)) + + call logicalloc(loc, array, .true., lbound) + end function trueloc + + !> Version: experimental + !> + !> Return the positions of the false elements in array. + !> [Specification](../page/specs/stdlib_array.html#falseloc) + pure function falseloc(array, lbound) result(loc) + !> Mask of logicals + logical, intent(in) :: array(:) + !> Lower bound of array to index + integer, intent(in), optional :: lbound + !> Locations of false elements + integer :: loc(count(.not. array)) + + call logicalloc(loc, array, .false., lbound) + end + + !> Return the positions of the truthy elements in array + pure subroutine logicalloc(loc, array, truth, lbound) + !> Locations of truthy elements + integer, intent(out) :: loc(:) + !> Mask of logicals + logical, intent(in) :: array(:) + !> Truthy value + logical, intent(in) :: truth + !> Lower bound of array to index + integer, intent(in), optional :: lbound + integer :: i, pos, offset + + offset = 0 + if (present(lbound)) offset = lbound - 1 + + i = 0 + do pos = 1, size(array) + if (array(pos) .eqv. truth) then + i = i + 1 + loc(i) = pos + offset + end if + end do + end +end diff --git a/src/stdlib_io_minizip.f90 b/src/stdlib_io_minizip.f90 new file mode 100644 index 000000000..51189c800 --- /dev/null +++ b/src/stdlib_io_minizip.f90 @@ -0,0 +1,124 @@ +!> Interface to the minizip library for creating and extracting zip files. +module stdlib_io_minizip + use, intrinsic :: iso_c_binding, only: c_char, c_ptr, c_int, c_long + implicit none + private + + integer, parameter, public :: UNZ_OK = 0 + integer, parameter, public :: UNZ_END_OF_LIST_OF_FILE = -100 + integer, parameter, public :: UNZ_ERRNO = -1 + integer, parameter, public :: UNZ_EOF = 0 + integer, parameter, public :: UNZ_PARAMERROR = -102 + integer, parameter, public :: UNZ_BADZIPFILE = -103 + integer, parameter, public :: UNZ_INTERNALERROR = -104 + integer, parameter, public :: UNZ_CRCERROR = -105 + + public :: unz_get_global_info + public :: unz_open + public :: unz_go_to_first_file + public :: unz_get_current_file_info + public :: unz_open_current_file + public :: unz_read_current_file + public :: unz_close_current_file + public :: unz_go_to_next_file + public :: unz_close + + type, bind(c), public :: unz_global_info + integer(kind=c_long) :: number_of_files + integer(kind=c_long) :: comment_size + end type + + type, bind(c), public :: unz_file_info + integer(kind=c_long) :: version + integer(kind=c_long) :: version_needed + integer(kind=c_long) :: flag + integer(kind=c_long) :: compression_method + integer(kind=c_long) :: dos_date + integer(kind=c_long) :: crc + integer(kind=c_long) :: compressed_size + integer(kind=c_long) :: uncompressed_size + integer(kind=c_long) :: size_filename + integer(kind=c_long) :: size_file_extra + integer(kind=c_long) :: size_file_comment + integer(kind=c_long) :: disk_num_start + integer(kind=c_long) :: internal_file_attributes + integer(kind=c_long) :: external_file_attributes + end type + + interface + function unz_open(path) bind(c, name='unzOpen') + import :: c_char, c_ptr + implicit none + character(kind=c_char), intent(in) :: path + type(c_ptr) :: unz_open + end + + function unz_get_global_info(file, global_info) bind(c, name='unzGetGlobalInfo') + import :: c_ptr, c_int, unz_global_info + implicit none + type(c_ptr), intent(in), value :: file + type(unz_global_info), intent(out) :: global_info + integer(kind=c_int) :: unz_get_global_info + end + + function unz_go_to_first_file(file) bind(c, name='unzGoToFirstFile') + import :: c_ptr, c_int + implicit none + type(c_ptr), intent(in), value :: file + integer(kind=c_int) :: unz_go_to_first_file + end + + function unz_get_current_file_info(file, file_info, filename, filename_buffer_size, & + & extra_field, extra_field_buffer_size, comment, comment_buffer_size) & + & bind(c, name='unzGetCurrentFileInfo') + import :: c_ptr, c_int, c_char, c_long, unz_file_info + implicit none + type(c_ptr), intent(in), value :: file + type(unz_file_info), intent(out) :: file_info + character(kind=c_char), intent(out) :: filename(*) + integer(kind=c_long), intent(in), value :: filename_buffer_size + character(kind=c_char), intent(out) :: extra_field(*) + integer(kind=c_long), intent(in), value :: extra_field_buffer_size + character(kind=c_char), intent(out) :: comment(*) + integer(kind=c_long), intent(in), value :: comment_buffer_size + integer(kind=c_int) :: unz_get_current_file_info + end + + function unz_open_current_file(file) bind(c, name='unzOpenCurrentFile') + import :: c_ptr, c_int + implicit none + type(c_ptr), intent(in), value :: file + integer(kind=c_int) :: unz_open_current_file + end + + function unz_read_current_file(file, buffer, size) bind(c, name='unzReadCurrentFile') + import :: c_ptr, c_int, c_char + implicit none + type(c_ptr), intent(in), value :: file + character(kind=c_char), intent(out) :: buffer(*) + integer(kind=c_int), intent(in), value :: size + integer(kind=c_int) :: unz_read_current_file + end + + function unz_go_to_next_file(file) bind(c, name='unzGoToNextFile') + import :: c_ptr, c_int + implicit none + type(c_ptr), intent(in), value :: file + integer(kind=c_int) :: unz_go_to_next_file + end + + function unz_close_current_file(file) bind(c, name='unzCloseCurrentFile') + import :: c_ptr, c_int + implicit none + type(c_ptr), intent(in), value :: file + integer(kind=c_int) :: unz_close_current_file + end + + function unz_close(file) bind(c, name='unzClose') + import :: c_ptr, c_int + implicit none + type(c_ptr), intent(in), value :: file + integer(kind=c_int) :: unz_close + end + end interface +end diff --git a/src/stdlib_io_npy.fypp b/src/stdlib_io_np.fypp similarity index 64% rename from src/stdlib_io_npy.fypp rename to src/stdlib_io_np.fypp index bf69a6a0c..2aa9bcd31 100644 --- a/src/stdlib_io_npy.fypp +++ b/src/stdlib_io_np.fypp @@ -68,59 +68,79 @@ !> !> This version replaces the ASCII string (which in practice was latin1) with a !> utf8-encoded string, so supports structured types with any unicode field names. -module stdlib_io_npy - use stdlib_kinds, only : int8, int16, int32, int64, sp, dp, xdp, qp +module stdlib_io_np + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp + use stdlib_array, only: t_array_bundle implicit none private - public :: save_npy, load_npy + public :: load_npy, save_npy, load_npz, save_npz + character(len=*), parameter :: & + type_iint8 = " Version: experimental + !> + !> Load multidimensional array in npy format + !> ([Specification](../page/specs/stdlib_io.html#load_npy)) + interface load_npy + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + module subroutine load_npy_${t1[0]}$${k1}$_${rank}$ (filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$ + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end + #:endfor + #:endfor + end interface !> Version: experimental !> !> Save multidimensional array in npy format !> ([Specification](../page/specs/stdlib_io.html#save_npy)) interface save_npy - #:for k1, t1 in KINDS_TYPES - #:for rank in RANKS - module subroutine save_npy_${t1[0]}$${k1}$_${rank}$(filename, array, iostat, iomsg) + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + module subroutine save_npy_${t1[0]}$${k1}$_${rank}$ (filename, array, iostat, iomsg) + character(len=*), intent(in) :: filename + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + end + #:endfor + #:endfor + end interface + + !> Version: experimental + !> + !> Load multiple multidimensional arrays from a (compressed) npz file. + !> ([Specification](../page/specs/stdlib_io.html#load_npz)) + interface load_npz + module subroutine load_npz_to_bundle(filename, array_bundle, iostat, iomsg) character(len=*), intent(in) :: filename - ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + type(t_array_bundle), intent(out) :: array_bundle integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg - end subroutine save_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor - #:endfor - end interface save_npy + end + end interface !> Version: experimental !> - !> Load multidimensional array in npy format - !> ([Specification](../page/specs/stdlib_io.html#load_npy)) - interface load_npy - #:for k1, t1 in KINDS_TYPES - #:for rank in RANKS - module subroutine load_npy_${t1[0]}$${k1}$_${rank}$(filename, array, iostat, iomsg) + !> Save multidimensional arrays to a compressed or an uncompressed npz file. + !> ([Specification](../page/specs/stdlib_io.html#save_npz)) + interface save_npz + module subroutine save_npz_from_bundle(filename, array_bundle, compressed, iostat, iomsg) character(len=*), intent(in) :: filename - ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$ + type(t_array_bundle), intent(in) :: array_bundle + !> If true, the file is saved in compressed format. The default is false. + logical, intent(in), optional :: compressed integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg - end subroutine load_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor - #:endfor - end interface load_npy - - - character(len=*), parameter :: nl = achar(10) - - character(len=*), parameter :: & - type_iint8 = " Implementation of loading npy files into multidimensional arrays -submodule (stdlib_io_npy) stdlib_io_npy_load +submodule (stdlib_io_np) stdlib_io_npy_load use stdlib_error, only : error_stop use stdlib_strings, only : to_string, starts_with implicit none @@ -69,8 +69,7 @@ contains iostat = stat else if (stat /= 0) then if (allocated(msg)) then - call error_stop("Failed to read array from file '"//filename//"'"//nl//& - & msg) + call error_stop("Failed to read array from file '"//filename//"'"//nl//msg) else call error_stop("Failed to read array from file '"//filename//"'") end if diff --git a/src/stdlib_io_npy_save.fypp b/src/stdlib_io_npy_save.fypp index 706c3cd90..a73202b3b 100644 --- a/src/stdlib_io_npy_save.fypp +++ b/src/stdlib_io_npy_save.fypp @@ -5,7 +5,7 @@ #:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES !> Implementation of saving multidimensional arrays to npy files -submodule (stdlib_io_npy) stdlib_io_npy_save +submodule (stdlib_io_np) stdlib_io_npy_save use stdlib_error, only : error_stop use stdlib_strings, only : to_string implicit none diff --git a/src/stdlib_io_npz_load.fypp b/src/stdlib_io_npz_load.fypp new file mode 100644 index 000000000..48d9b15e0 --- /dev/null +++ b/src/stdlib_io_npz_load.fypp @@ -0,0 +1,105 @@ +! SPDX-Identifier: MIT + +! #:include "common.fypp" +! #:set RANKS = range(1, MAXRANK + 1) +! #:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES + +!> Implementation of loading uncompressed and compressed npz files into multidimensional arrays. +submodule(stdlib_io_np) stdlib_io_npz_load + use stdlib_error, only: error_stop + use stdlib_string_type, only: string_type + use stdlib_io_zip, only: unzip, zip_prefix, zip_suffix, raw_file + implicit none + +contains + + !> Version: experimental + !> + !> Load multidimensional arrays from a compressed or uncompressed npz file. + !> ([Specification](../page/specs/stdlib_io.html#load_npz)) + module subroutine load_npz_to_bundle(filename, bundle, iostat, iomsg) + character(len=*), intent(in) :: filename + type(t_array_bundle), intent(out) :: bundle + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + + logical :: exists + integer :: io_unit, stat + character(len=:), allocatable :: msg + type(raw_file), allocatable :: raw_files(:) + + call unzip(filename, raw_files, stat, msg) + if (stat /= 0) then + call identify_problem(filename, stat, msg) + end if + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read arrays from file '"//filename//"'"//nl//msg) + else + call error_stop("Failed to read arrays from file '"//filename//"'") + end if + end if + + if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) + end + + !> Open file and try to identify the problem. + module subroutine identify_problem(filename, stat, msg) + character(len=*), intent(in) :: filename + integer, intent(inout) :: stat + character(len=:), allocatable, intent(inout) :: msg + + logical :: exists + integer :: io_unit, prev_stat + character(len=:), allocatable :: prev_msg + + ! Keep track of the previous status and message in case no reason can be found. + prev_stat = stat + if (allocated(msg)) call move_alloc(msg, prev_msg) + + inquire (file=filename, exist=exists) + if (.not. exists) then + stat = 1; msg = 'File does not exist: '//filename//'.'; return + end if + open (newunit=io_unit, file=filename, form='unformatted', access='stream', & + & status='old', action='read', iostat=stat, iomsg=msg) + if (stat /= 0) return + + call verify_header(io_unit, stat, msg) + if (stat /= 0) return + + ! Restore previous status and message if no reason could be found. + stat = prev_stat; msg = 'Failed to unzip file: '//filename//nl//prev_msg + end + + module subroutine verify_header(io_unit, stat, msg) + integer, intent(in) :: io_unit + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + + integer :: file_size + character(len=len(zip_prefix)) :: header + + inquire (io_unit, size=file_size) + if (file_size < len(zip_suffix)) then + stat = 1; msg = 'File is too small to be an npz file.'; return + end if + + read (io_unit, iostat=stat) header + if (stat /= 0) then + msg = 'Failed to read header from file'; return + end if + + if (header == zip_suffix) then + stat = 1; msg = 'Empty npz file.'; return + end if + + if (header /= zip_prefix) then + stat = 1; msg = 'Not an npz file.'; return + end if + end + +end diff --git a/src/stdlib_io_npz_save.fypp b/src/stdlib_io_npz_save.fypp new file mode 100644 index 000000000..5eea3aded --- /dev/null +++ b/src/stdlib_io_npz_save.fypp @@ -0,0 +1,35 @@ +! SPDX-Identifier: MIT + +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES + +!> Implementation of loading uncompressed and compressed npz files into multidimensional arrays. +submodule(stdlib_io_np) stdlib_io_npz_save + use stdlib_error, only: error_stop + use stdlib_strings, only: to_string, starts_with + implicit none + +contains + + !> Version: experimental + !> + !> Save multidimensional arrays to a compressed or an uncompressed npz file. + !> ([Specification](../page/specs/stdlib_io.html#save_npz)) + module subroutine save_npz_from_bundle(filename, array_bundle, compressed, iostat, iomsg) + character(len=*), intent(in) :: filename + type(t_array_bundle), intent(in) :: array_bundle + !> If true, the file is saved in compressed format. The default is false. + logical, intent(in), optional :: compressed + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + + logical :: is_compressed + + if (present(compressed)) then + is_compressed = compressed + else + is_compressed = .false. + end if + end +end diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 new file mode 100644 index 000000000..68921a6ed --- /dev/null +++ b/src/stdlib_io_zip.f90 @@ -0,0 +1,134 @@ +module stdlib_io_zip + use stdlib_array, only: t_array_bundle + use stdlib_io_minizip + use iso_c_binding, only: c_ptr, c_associated, c_int, c_long, c_char + implicit none + private + + public :: unzip, zip_prefix, zip_suffix + + character(*), parameter :: zip_prefix = 'PK'//achar(3)//achar(4) + character(*), parameter :: zip_suffix = 'PK'//achar(5)//achar(6) + integer(kind=c_int), parameter :: read_buffer_size = 1024 + integer(kind=c_long), parameter :: buffer_size = 1024 + + interface unzip + module procedure unzip_to_raw + end interface + + !> Contains extracted raw data from a zip file. + type, public :: t_unzipped_bundle + !> The raw data of the files within the zip file. + type(t_unzipped_file), allocatable :: files(:) + end type + + !> Contains the name of the file and its raw data. + type, public :: t_unzipped_file + !> The name of the file. + character(:), allocatable :: name + !> The raw data of the file. + character(:), allocatable :: data + end type + +contains + + module subroutine unzip_to_raw(filename, bundle, iostat, iomsg) + character(len=*), intent(in) :: filename + type(t_unzipped_bundle), intent(out) :: bundle + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + + type(c_ptr) :: file_handle + type(unz_global_info) :: global_info + type(unz_file_info) :: file_info + integer(kind=c_int) :: stat, bytes_read + character(kind=c_char, len=read_buffer_size) :: read_buffer + character(kind=c_char, len=buffer_size) :: file_name, extra_field, comment + integer(kind=c_long) :: i + + if (present(iostat)) iostat = 0 + + file_handle = unz_open(filename) + if (.not. c_associated(file_handle)) then + if (present(iostat)) iostat = 1 + if (present(iomsg)) iomsg = 'Failed to open file '//trim(filename)//'.' + return + end if + + stat = unz_get_global_info(file_handle, global_info) + if (stat /= UNZ_OK) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = 'Failed to get global info for '//trim(filename)//'.' + return + end if + + allocate (bundle%files(global_info%number_of_files)) + + read_files: block + if (size(bundle%files) == 0) exit read_files + + stat = unz_go_to_first_file(file_handle) + if (stat /= UNZ_OK) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = 'Failed to go to first file in '//trim(filename)//'.' + stat = unz_close(file_handle); return + end if + + do i = 1, global_info%number_of_files + stat = unz_open_current_file(file_handle) + if (stat /= UNZ_OK) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = 'Error opening file within '//trim(filename)//'.' + stat = unz_close(file_handle); return + end if + + stat = unz_get_current_file_info(file_handle, file_info, file_name, buffer_size, & + extra_field, buffer_size, comment, buffer_size) + if (stat /= UNZ_OK) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = 'Failed to get current file info in '//trim(filename)//'.' + stat = unz_close(file_handle); return + end if + + bundle%files(i)%name = file_name(1:file_info%size_filename) + bundle%files(i)%data = '' + + do + bytes_read = unz_read_current_file(file_handle, read_buffer, read_buffer_size) + if (bytes_read < 0) then + if (present(iostat)) iostat = bytes_read + if (present(iomsg)) iomsg = 'Error reading file within '//trim(filename)//'.' + stat = unz_close_current_file(file_handle); + stat = unz_close(file_handle); + return + else if (bytes_read == 0) then + stat = unz_close_current_file(file_handle) + if (stat /= UNZ_OK) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = 'Error closing file within '//trim(filename)//'.' + stat = unz_close(file_handle); return + end if + exit + else + bundle%files(i)%data = bundle%files(i)%data//read_buffer(1:bytes_read) + end if + end do + + if (i == global_info%number_of_files) exit + stat = unz_go_to_next_file(file_handle) + if (stat /= UNZ_OK) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = 'Failed to go to next file within '//trim(filename)//'.' + stat = unz_close(file_handle); return + end if + end do + end block read_files + + stat = unz_close(file_handle) + if (stat /= UNZ_OK) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = 'Failed to close file '//trim(filename)//'.' + return + end if + end +end diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 8e199182d..ada9eb193 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -5,6 +5,7 @@ endif() macro(ADDTEST name) add_executable(test_${name} test_${name}.f90) target_link_libraries(test_${name} "${PROJECT_NAME}" "test-drive::test-drive") + target_link_libraries(test_${name} ${PROJECT_NAME} ${MINIZIP_LIBRARY}) add_test(NAME ${name} COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 98794cd88..c2de125b1 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -14,6 +14,7 @@ set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision) set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) ADDTEST(getline) -ADDTEST(npy) +ADDTEST(np) +ADDTEST(zip) ADDTEST(open) ADDTEST(parse_mode) diff --git a/test/io/test_npy.f90 b/test/io/test_np.f90 similarity index 51% rename from test/io/test_npy.f90 rename to test/io/test_np.f90 index c56637030..a3eb7fb8b 100644 --- a/test/io/test_npy.f90 +++ b/test/io/test_np.f90 @@ -1,66 +1,71 @@ -module test_npy - use stdlib_kinds, only : int8, int16, int32, int64, sp, dp - use stdlib_io_npy, only : save_npy, load_npy - use testdrive, only : new_unittest, unittest_type, error_type, check +module test_np + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp + use stdlib_array, only: t_array_bundle + use stdlib_io_np, only: load_npy, save_npy, load_npz + use testdrive, only: new_unittest, unittest_type, error_type, check implicit none private - public :: collect_npy + public :: collect_np contains !> Collect all exported unit tests - subroutine collect_npy(testsuite) + subroutine collect_np(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("read-rdp-r2", test_read_rdp_rank2), & - new_unittest("read-rdp-r3", test_read_rdp_rank3), & - new_unittest("read-rsp-r1", test_read_rsp_rank1), & - new_unittest("read-rsp-r2", test_read_rsp_rank2), & - new_unittest("write-rdp-r2", test_write_rdp_rank2), & - new_unittest("write-rsp-r2", test_write_rsp_rank2), & - new_unittest("write-i2-r4", test_write_int16_rank4), & - new_unittest("invalid-magic-number", test_invalid_magic_number, should_fail=.true.), & - new_unittest("invalid-magic-string", test_invalid_magic_string, should_fail=.true.), & - new_unittest("invalid-major-version", test_invalid_major_version, should_fail=.true.), & - new_unittest("invalid-minor-version", test_invalid_minor_version, should_fail=.true.), & - new_unittest("invalid-header-len", test_invalid_header_len, should_fail=.true.), & - new_unittest("invalid-nul-byte", test_invalid_nul_byte, should_fail=.true.), & - new_unittest("invalid-key", test_invalid_key, should_fail=.true.), & - new_unittest("invalid-comma", test_invalid_comma, should_fail=.true.), & - new_unittest("invalid-string", test_invalid_string, should_fail=.true.), & - new_unittest("duplicate-descr", test_duplicate_descr, should_fail=.true.), & - new_unittest("missing-descr", test_missing_descr, should_fail=.true.), & - new_unittest("missing-fortran_order", test_missing_fortran_order, should_fail=.true.), & - new_unittest("missing-shape", test_missing_shape, should_fail=.true.), & - new_unittest("iomsg-deallocated", test_iomsg_deallocated) & - ] - end subroutine collect_npy + new_unittest("read-rdp-r2", test_read_rdp_rank2), & + new_unittest("read-rdp-r3", test_read_rdp_rank3), & + new_unittest("read-rsp-r1", test_read_rsp_rank1), & + new_unittest("read-rsp-r2", test_read_rsp_rank2), & + new_unittest("write-rdp-r2", test_write_rdp_rank2), & + new_unittest("write-rsp-r2", test_write_rsp_rank2), & + new_unittest("write-i2-r4", test_write_int16_rank4), & + new_unittest("invalid-magic-number", test_invalid_magic_number, should_fail=.true.), & + new_unittest("invalid-magic-string", test_invalid_magic_string, should_fail=.true.), & + new_unittest("invalid-major-version", test_invalid_major_version, should_fail=.true.), & + new_unittest("invalid-minor-version", test_invalid_minor_version, should_fail=.true.), & + new_unittest("invalid-header-len", test_invalid_header_len, should_fail=.true.), & + new_unittest("invalid-nul-byte", test_invalid_nul_byte, should_fail=.true.), & + new_unittest("invalid-key", test_invalid_key, should_fail=.true.), & + new_unittest("invalid-comma", test_invalid_comma, should_fail=.true.), & + new_unittest("invalid-string", test_invalid_string, should_fail=.true.), & + new_unittest("duplicate-descr", test_duplicate_descr, should_fail=.true.), & + new_unittest("missing-descr", test_missing_descr, should_fail=.true.), & + new_unittest("missing-fortran_order", test_missing_fortran_order, should_fail=.true.), & + new_unittest("missing-shape", test_missing_shape, should_fail=.true.), & + new_unittest("iomsg-deallocated", test_iomsg_deallocated), & + new_unittest("npz-nonexistent-file", test_npz_nonexistent_file, should_fail=.true.), & + new_unittest("npz-small-file", test_npz_small_file, should_fail=.true.), & + new_unittest("npz-empty-zip", test_npz_empty_zip, should_fail=.true.), & + new_unittest("npz-not-zip", test_npz_not_zip, should_fail=.true.) & + ] + end subroutine collect_np subroutine test_read_rdp_rank2(error) !> Error handling type(error_type), allocatable, intent(out) :: error character(len=*), parameter :: dict = & - "{'descr': ' 0) then - write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + write (error_unit, '(i0, 1x, a)') stat, "test(s) failed!" error stop end if end program diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 new file mode 100644 index 000000000..f12908d44 --- /dev/null +++ b/test/io/test_zip.f90 @@ -0,0 +1,193 @@ +module test_zip + use stdlib_kinds, only: int8, int16, int32, int64, sp, dp + use stdlib_io_zip, only: t_unzipped_bundle, unzip + use testdrive, only: new_unittest, unittest_type, error_type, check + implicit none + private + + public :: collect_np + +contains + + subroutine collect_np(testsuite) + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest('unexistent-file', test_unexistent_file, should_fail=.true.), & + new_unittest('empty-zip', test_empty_zip), & + new_unittest('empty-array', test_empty_array), & + new_unittest('single-file', test_single_file), & + new_unittest('two-files', test_two_files) & + ] + end + + subroutine test_unexistent_file(error) + type(error_type), allocatable, intent(out) :: error + + character(len=*), parameter :: filename = 'unexistent-file.zip' + type(t_unzipped_bundle) :: bundle + integer :: stat + character(len=:), allocatable :: msg + + call unzip(filename, bundle, stat, msg) + call check(error, stat, msg) + end + + subroutine test_empty_zip(error) + type(error_type), allocatable, intent(out) :: error + + character(len=*), parameter :: filename = 'test_empty_zip.zip' + type(t_unzipped_bundle) :: bundle + integer :: io, stat + character(len=:), allocatable :: msg + + character(*), parameter:: binary_data = 'PK'//char(5)//char(6)//repeat(char(0), 18) + + open (newunit=io, file=filename, form='unformatted', access='stream') + write (io) binary_data + close (io) + + call unzip(filename, bundle, stat, msg) + call delete_file(filename) + + call check(error, stat, msg) + call check(error, size(bundle%files) == 0, 'Files should be empty') + end + + subroutine test_empty_array(error) + type(error_type), allocatable, intent(out) :: error + + character(len=*), parameter :: filename = 'test_empty_array.zip' + type(t_unzipped_bundle) :: bundle + integer :: io, stat + character(len=:), allocatable :: msg + + character(*), parameter :: binary_data = 'PK'//char(3)//char(4)//'-'//repeat(char(0), 7)//'!'//char(0)//'6H[s'// & + & repeat(char(int(z'ff')), 8)//char(9)//char(0)//char(int(z'14'))//char(0)//'arr_0.npy'//char(1)//char(0)// & + & char(int(z'10'))//char(0)//char(int(z'80'))//repeat(char(0), 7)//char(int(z'80'))//repeat(char(0), 7)// & + & char(int(z'93'))//'NUMPY'//char(1)//char(0)//'v'//char(0)// & + & "{'descr': ' 0) then + write (error_unit, '(i0, 1x, a)') stat, 'test(s) failed!' + error stop + end if +end program From 8708ff9d972f536d8c00a8b275dfeb452d6a8ede Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 18 Feb 2024 06:17:48 +0300 Subject: [PATCH 02/27] Finish mapping of npz files --- example/CMakeLists.txt | 1 + src/CMakeLists.txt | 7 +- src/stdlib_io_np.fypp | 15 + ...o_npy_load.fypp => stdlib_io_np_load.fypp} | 259 ++++++++++++++---- src/stdlib_io_np_save.fypp | 154 +++++++++++ src/stdlib_io_npy_save.fypp | 139 ---------- src/stdlib_io_npz_load.fypp | 105 ------- src/stdlib_io_npz_save.fypp | 35 --- 8 files changed, 385 insertions(+), 330 deletions(-) rename src/{stdlib_io_npy_load.fypp => stdlib_io_np_load.fypp} (67%) create mode 100644 src/stdlib_io_np_save.fypp delete mode 100644 src/stdlib_io_npy_save.fypp delete mode 100644 src/stdlib_io_npz_load.fypp delete mode 100644 src/stdlib_io_npz_save.fypp diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index 3dd43694f..cd324f652 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -1,6 +1,7 @@ macro(ADD_EXAMPLE name) add_executable(example_${name} example_${name}.f90) target_link_libraries(example_${name} "${PROJECT_NAME}") + target_link_libraries(example_${name} ${PROJECT_NAME} ${MINIZIP_LIBRARY}) add_test(NAME ${name} COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index ecbd68d80..f986b44f2 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,11 +17,8 @@ set(fppFiles stdlib_hash_64bit_spookyv2.fypp stdlib_io.fypp stdlib_io_np.fypp - stdlib_io_npy_load.fypp - stdlib_io_npz_load.fypp - stdlib_io_npy_save.fypp - stdlib_io_npz_load.fypp - stdlib_io_npz_save.fypp + stdlib_io_np_load.fypp + stdlib_io_np_save.fypp stdlib_kinds.fypp stdlib_linalg.fypp stdlib_linalg_diag.fypp diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 2aa9bcd31..1da8f9f53 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -143,4 +143,19 @@ module stdlib_io_np character(len=:), allocatable, intent(out), optional :: iomsg end end interface + + interface allocate_array + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (array, vshape, stat) + !> Instance of the array to be allocated. + ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$ + !> Dimensions to allocate for. + integer, intent(in) :: vshape(:) + !> Status of allocate. + integer, intent(out) :: stat + end + #:endfor + #:endfor + end interface end diff --git a/src/stdlib_io_npy_load.fypp b/src/stdlib_io_np_load.fypp similarity index 67% rename from src/stdlib_io_npy_load.fypp rename to src/stdlib_io_np_load.fypp index 9b20a368f..87540bd83 100644 --- a/src/stdlib_io_npy_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -5,9 +5,12 @@ #:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES !> Implementation of loading npy files into multidimensional arrays -submodule (stdlib_io_np) stdlib_io_npy_load - use stdlib_error, only : error_stop - use stdlib_strings, only : to_string, starts_with +submodule(stdlib_io_np) stdlib_io_np_load + use stdlib_error, only: error_stop + use stdlib_strings, only: to_string, starts_with + use stdlib_string_type, only: string_type + use stdlib_io_zip, only: unzip, zip_prefix, zip_suffix, t_unzipped_bundle, t_unzipped_file + use stdlib_array implicit none contains @@ -33,28 +36,12 @@ contains open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) catch: block - character(len=:), allocatable :: this_type integer, allocatable :: vshape(:) - call get_descriptor(io, filename, this_type, vshape, stat, msg) + call verify_npy_file(io, filename, vtype, vshape, rank, stat, msg) if (stat /= 0) exit catch - if (this_type /= vtype) then - stat = 1 - msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& - & "but expected '"//vtype//"'" - exit catch - end if - - if (size(vshape) /= rank) then - stat = 1 - msg = "File '"//filename//"' contains data of rank "//& - & to_string(size(vshape))//", but expected "//& - & to_string(rank) - exit catch - end if - - call allocator(array, vshape, stat) + call allocate_array(array, vshape, stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//vtype//"' "//& & "with total size of "//to_string(product(vshape)) @@ -76,30 +63,210 @@ contains end if if (present(iomsg).and.allocated(msg)) call move_alloc(msg, iomsg) - contains + end + #:endfor +#:endfor - !> Wrapped intrinsic allocate to create an allocation from a shape array - subroutine allocator(array, vshape, stat) - !> Instance of the array to be allocated - ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$ - !> Dimensions to allocate for - integer, intent(in) :: vshape(:) - !> Status of allocate + !> Verify header, type and rank of the npy file. + subroutine verify_npy_file(io, filename, vtype, vshape, rank, stat, msg) + !> Access unit to the npy file. + integer, intent(in) :: io + !> Name of the npy file to load from. + character(len=*), intent(in) :: filename + !> Type of the data stored, retrieved from field `descr`. + character(len=*), intent(in) :: vtype + !> Shape of the stored data, retrieved from field `shape`. + integer, allocatable, intent(out) :: vshape(:) + !> Expected rank of the data. + integer, intent(in) :: rank + !> Status of operation. integer, intent(out) :: stat + !> Associated error message in case of non-zero status. + character(len=:), allocatable, intent(out) :: msg + + character(len=:), allocatable :: this_type + + call get_descriptor(io, filename, this_type, vshape, stat, msg) + if (stat /= 0) return + + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + return + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + return + end if + end + + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(array, vshape, stat) + ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$ + integer, intent(in) :: vshape(:) + integer, intent(out) :: stat + + allocate(array( & + #:for i in range(rank-1) + & vshape(${i+1}$), & + #:endfor + & vshape(${rank}$)), & + & stat=stat) + end + #:endfor + #:endfor + + !> Version: experimental + !> + !> Load multidimensional arrays from a compressed or uncompressed npz file. + !> ([Specification](../page/specs/stdlib_io.html#load_npz)) + module subroutine load_npz_to_bundle(filename, array_bundle, iostat, iomsg) + character(len=*), intent(in) :: filename + type(t_array_bundle), intent(out) :: array_bundle + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg - allocate(array( & - #:for i in range(rank-1) - & vshape(${i+1}$), & + type(t_unzipped_bundle) :: unzipped_bundle + integer :: stat + character(len=:), allocatable :: msg + + call unzip(filename, unzipped_bundle, stat, msg) + if (stat == 0) then + call load_raw_to_bundle(unzipped_bundle, array_bundle, stat, msg) + else + call identify_problem(filename, stat, msg) + end if + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + call error_stop("Failed to read arrays from file '"//filename//"'"//nl//msg) + else + call error_stop("Failed to read arrays from file '"//filename//"'") + end if + end if + + if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) + end + + module subroutine load_raw_to_bundle(unzipped_bundle, array_bundle, stat, msg) + type(t_unzipped_bundle), intent(in) :: unzipped_bundle + type(t_array_bundle), intent(out) :: array_bundle + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + + integer :: i, io + + allocate (array_bundle%files(size(unzipped_bundle%files))) + do i = 1, size(unzipped_bundle%files) + array_bundle%files(i)%name = unzipped_bundle%files(i)%name + open (newunit=io, status='scratch', form='unformatted', access='stream', iostat=stat) + if (stat /= 0) return + write (io) unzipped_bundle%files(i)%data + call load_string_to_array(io, unzipped_bundle%files(i), array_bundle%files(i), stat, msg) + close (io, status='delete', iostat=stat) + if (stat /= 0) return + end do + end + + module subroutine load_string_to_array(io, unzipped_file, array, stat, msg) + integer, intent(in) :: io + type(t_unzipped_file), intent(in) :: unzipped_file + class(t_array), intent(inout) :: array + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + ${t1}$, allocatable :: array_${t1[0]}$${k1}$_${rank}$${ranksuffix(rank)}$ #:endfor - & vshape(${rank}$)), & - & stat=stat) + #:endfor - end subroutine allocator + integer, allocatable :: vshape(:) - end subroutine load_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor -#:endfor + select type (arr => array) + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + type is (t_array_${t1[0]}$${k1}$_${rank}$) + call verify_npy_file(io, unzipped_file%name, type_${t1[0]}$${k1}$, vshape, ${rank}$, stat, msg) + if (stat /= 0) return + call allocate_array(array_${t1[0]}$${k1}$_${rank}$, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//type_${t1[0]}$${k1}$//"' "//& + & "with total size of "//to_string(product(vshape)) + return + end if + read (io, iostat=stat) array_${t1[0]}$${k1}$_${rank}$${ranksuffix(rank)}$ + arr%values = array_${t1[0]}$${k1}$_${rank}$${ranksuffix(rank)}$ + #:endfor + #:endfor + class default + stat = 1; msg = 'Unsupported array type.'; return + end select + end + + !> Open file and try to identify the problem. + module subroutine identify_problem(filename, stat, msg) + character(len=*), intent(in) :: filename + integer, intent(inout) :: stat + character(len=:), allocatable, intent(inout) :: msg + logical :: exists + integer :: io_unit, prev_stat + character(len=:), allocatable :: prev_msg + + ! Keep track of the previous status and message in case no reason can be found. + prev_stat = stat + if (allocated(msg)) call move_alloc(msg, prev_msg) + + inquire (file=filename, exist=exists) + if (.not. exists) then + stat = 1; msg = 'File does not exist: '//filename//'.'; return + end if + open (newunit=io_unit, file=filename, form='unformatted', access='stream', & + & status='old', action='read', iostat=stat, iomsg=msg) + if (stat /= 0) return + + call verify_header(io_unit, stat, msg) + if (stat /= 0) return + + ! Restore previous status and message if no reason could be found. + stat = prev_stat; msg = 'Failed to unzip file: '//filename//nl//prev_msg + end + + module subroutine verify_header(io_unit, stat, msg) + integer, intent(in) :: io_unit + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + + integer :: file_size + character(len=len(zip_prefix)) :: header + + inquire (io_unit, size=file_size) + if (file_size < len(zip_suffix)) then + stat = 1; msg = 'File is too small to be an npz file.'; return + end if + + read (io_unit, iostat=stat) header + if (stat /= 0) then + msg = 'Failed to read header from file'; return + end if + + if (header == zip_suffix) then + stat = 1; msg = 'Empty npz file.'; return + end if + + if (header /= zip_prefix) then + stat = 1; msg = 'Not an npz file.'; return + end if + end !> Read the npy header from a binary file and retrieve the descriptor string. subroutine get_descriptor(io, filename, vtype, vshape, stat, msg) @@ -168,7 +335,7 @@ contains if (.not.fortran_order) then vshape = [(vshape(i), i = size(vshape), 1, -1)] end if - end subroutine get_descriptor + end !> Parse the first eight bytes of the npy header to verify the data @@ -214,7 +381,7 @@ contains & "'"//to_string(major)//"."//to_string(minor)//"'" return end if - end subroutine parse_header + end !> Parse the descriptor in the npy header. This routine implements a minimal !> non-recursive parser for serialized Python dictionaries. @@ -367,7 +534,7 @@ contains & "1 | " // input // nl // & & " |" // repeat(" ", first) // repeat("^", last - first + 1) // nl // & & " |" - end function make_message + end !> Parse a tuple of integers into an array of integers subroutine parse_tuple(input, pos, tuple, stat, msg) @@ -427,7 +594,7 @@ contains return end select end do - end subroutine parse_tuple + end !> Get the next allowed token subroutine next_token(input, pos, token, allowed_token, stat, msg) @@ -459,7 +626,7 @@ contains exit end if end do - end subroutine next_token + end !> Tokenize input string subroutine get_token(input, pos, token) @@ -531,8 +698,8 @@ contains token = token_type(pos, pos, invalid) end select - end subroutine get_token + end - end subroutine parse_descriptor + end -end submodule stdlib_io_npy_load +end diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp new file mode 100644 index 000000000..6b50c247d --- /dev/null +++ b/src/stdlib_io_np_save.fypp @@ -0,0 +1,154 @@ +! SPDX-Identifer: MIT + +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES + +!> Implementation of saving multidimensional arrays to npy files +submodule(stdlib_io_np) stdlib_io_np_save + use stdlib_error, only: error_stop + use stdlib_strings, only: to_string + implicit none + +contains + + !> Generate magic header string for npy format + pure function magic_header(major, minor) result(str) + !> Major version of npy format + integer, intent(in) :: major + !> Minor version of npy format + integer, intent(in) :: minor + !> Magic string for npy format + character(len=8) :: str + + str = magic_number//magic_string//achar(major)//achar(minor) + end + + !> Generate header for npy format + pure function npy_header(vtype, vshape) result(str) + !> Type of variable + character(len=*), intent(in) :: vtype + !> Shape of variable + integer, intent(in) :: vshape(:) + !> Header string for npy format + character(len=:), allocatable :: str + + integer, parameter :: len_v10 = 8 + 2, len_v20 = 8 + 4, block_size = 64 + + str = & + "{'descr': '"//vtype// & + "', 'fortran_order': True, 'shape': "// & + shape_str(vshape)//", }" + + if (len(str) + len_v10 >= 65535) then + str = str// & + & repeat(" ", block_size - mod(len(str) + len_v20 + 1, block_size))//nl + str = magic_header(2, 0)//to_bytes_i4(int(len(str)))//str + else + str = str// & + & repeat(" ", block_size - mod(len(str) + len_v10 + 1, block_size))//nl + str = magic_header(1, 0)//to_bytes_i2(int(len(str)))//str + end if + end + + !> Write integer as byte string in little endian encoding + pure function to_bytes_i4(val) result(str) + !> Integer value to convert to bytes + integer, intent(in) :: val + !> String of bytes + character(len=4) :: str + + str = achar(mod(val, 256**1))// & + & achar(mod(val, 256**2)/256**1)// & + & achar(mod(val, 256**3)/256**2)// & + & achar(val/256**3) + end + + !> Write integer as byte string in little endian encoding, 2-byte truncated version + pure function to_bytes_i2(val) result(str) + !> Integer value to convert to bytes + integer, intent(in) :: val + !> String of bytes + character(len=2) :: str + + str = achar(mod(val, 2**8))// & + & achar(mod(val, 2**16)/2**8) + end + + !> Print array shape as tuple of int + pure function shape_str(vshape) result(str) + !> Shape of variable + integer, intent(in) :: vshape(:) + !> Shape string for npy format + character(len=:), allocatable :: str + + integer :: i + + str = "(" + do i = 1, size(vshape) + str = str//to_string(vshape(i))//", " + end do + str = str//")" + end + + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + !> Save ${rank}$-dimensional array in npy format + module subroutine save_npy_${t1[0]}$${k1}$_${rank}$ (filename, array, iostat, iomsg) + !> Name of the npy file to load from + character(len=*), intent(in) :: filename + !> Array to be loaded from the npy file + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + !> Error status of loading, zero on success + integer, intent(out), optional :: iostat + !> Associated error message in case of non-zero status code + character(len=:), allocatable, intent(out), optional :: iomsg + + character(len=*), parameter :: vtype = type_${t1[0]}$${k1}$ + integer :: io, stat + + open (newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) + if (stat == 0) then + write (io, iostat=stat) npy_header(vtype, shape(array)) + end if + if (stat == 0) then + write (io, iostat=stat) array + end if + close (io, iostat=stat) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + call error_stop("Failed to write array to file '"//filename//"'") + end if + + if (present(iomsg)) then + if (stat /= 0) then + iomsg = "Failed to write array to file '"//filename//"'" + end if + end if + end + #:endfor + #:endfor + + !> Version: experimental + !> + !> Save multidimensional arrays to a compressed or an uncompressed npz file. + !> ([Specification](../page/specs/stdlib_io.html#save_npz)) + module subroutine save_npz_from_bundle(filename, array_bundle, compressed, iostat, iomsg) + character(len=*), intent(in) :: filename + type(t_array_bundle), intent(in) :: array_bundle + !> If true, the file is saved in compressed format. The default is false. + logical, intent(in), optional :: compressed + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + + logical :: is_compressed + + if (present(compressed)) then + is_compressed = compressed + else + is_compressed = .false. + end if + end +end diff --git a/src/stdlib_io_npy_save.fypp b/src/stdlib_io_npy_save.fypp deleted file mode 100644 index a73202b3b..000000000 --- a/src/stdlib_io_npy_save.fypp +++ /dev/null @@ -1,139 +0,0 @@ -! SPDX-Identifer: MIT - -#:include "common.fypp" -#:set RANKS = range(1, MAXRANK + 1) -#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES - -!> Implementation of saving multidimensional arrays to npy files -submodule (stdlib_io_np) stdlib_io_npy_save - use stdlib_error, only : error_stop - use stdlib_strings, only : to_string - implicit none - -contains - - - !> Generate magic header string for npy format - pure function magic_header(major, minor) result(str) - !> Major version of npy format - integer, intent(in) :: major - !> Minor version of npy format - integer, intent(in) :: minor - !> Magic string for npy format - character(len=8) :: str - - str = magic_number // magic_string // achar(major) // achar(minor) - end function magic_header - - - !> Generate header for npy format - pure function npy_header(vtype, vshape) result(str) - !> Type of variable - character(len=*), intent(in) :: vtype - !> Shape of variable - integer, intent(in) :: vshape(:) - !> Header string for npy format - character(len=:), allocatable :: str - - integer, parameter :: len_v10 = 8 + 2, len_v20 = 8 + 4, block_size = 64 - - str = & - "{'descr': '"//vtype//& - "', 'fortran_order': True, 'shape': "//& - shape_str(vshape)//", }" - - if (len(str) + len_v10 >= 65535) then - str = str // & - & repeat(" ", block_size - mod(len(str) + len_v20 + 1, block_size)) // nl - str = magic_header(2, 0) // to_bytes_i4(int(len(str))) // str - else - str = str // & - & repeat(" ", block_size - mod(len(str) + len_v10 + 1, block_size)) // nl - str = magic_header(1, 0) // to_bytes_i2(int(len(str))) // str - end if - end function npy_header - - !> Write integer as byte string in little endian encoding - pure function to_bytes_i4(val) result(str) - !> Integer value to convert to bytes - integer, intent(in) :: val - !> String of bytes - character(len=4) :: str - - str = achar(mod(val, 256**1)) // & - & achar(mod(val, 256**2) / 256**1) // & - & achar(mod(val, 256**3) / 256**2) // & - & achar(val / 256**3) - end function to_bytes_i4 - - - !> Write integer as byte string in little endian encoding, 2-byte truncated version - pure function to_bytes_i2(val) result(str) - !> Integer value to convert to bytes - integer, intent(in) :: val - !> String of bytes - character(len=2) :: str - - str = achar(mod(val, 2**8)) // & - & achar(mod(val, 2**16) / 2**8) - end function to_bytes_i2 - - - !> Print array shape as tuple of int - pure function shape_str(vshape) result(str) - !> Shape of variable - integer, intent(in) :: vshape(:) - !> Shape string for npy format - character(len=:), allocatable :: str - - integer :: i - - str = "(" - do i = 1, size(vshape) - str = str//to_string(vshape(i))//", " - enddo - str = str//")" - end function shape_str - - -#:for k1, t1 in KINDS_TYPES - #:for rank in RANKS - !> Save ${rank}$-dimensional array in npy format - module subroutine save_npy_${t1[0]}$${k1}$_${rank}$(filename, array, iostat, iomsg) - !> Name of the npy file to load from - character(len=*), intent(in) :: filename - !> Array to be loaded from the npy file - ${t1}$, intent(in) :: array${ranksuffix(rank)}$ - !> Error status of loading, zero on success - integer, intent(out), optional :: iostat - !> Associated error message in case of non-zero status code - character(len=:), allocatable, intent(out), optional :: iomsg - - character(len=*), parameter :: vtype = type_${t1[0]}$${k1}$ - integer :: io, stat - - open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) - if (stat == 0) then - write(io, iostat=stat) npy_header(vtype, shape(array)) - end if - if (stat == 0) then - write(io, iostat=stat) array - end if - close(io, iostat=stat) - - if (present(iostat)) then - iostat = stat - else if (stat /= 0) then - call error_stop("Failed to write array to file '"//filename//"'") - end if - - if (present(iomsg)) then - if (stat /= 0) then - iomsg = "Failed to write array to file '"//filename//"'" - end if - end if - end subroutine save_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor -#:endfor - -end submodule stdlib_io_npy_save diff --git a/src/stdlib_io_npz_load.fypp b/src/stdlib_io_npz_load.fypp deleted file mode 100644 index 48d9b15e0..000000000 --- a/src/stdlib_io_npz_load.fypp +++ /dev/null @@ -1,105 +0,0 @@ -! SPDX-Identifier: MIT - -! #:include "common.fypp" -! #:set RANKS = range(1, MAXRANK + 1) -! #:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES - -!> Implementation of loading uncompressed and compressed npz files into multidimensional arrays. -submodule(stdlib_io_np) stdlib_io_npz_load - use stdlib_error, only: error_stop - use stdlib_string_type, only: string_type - use stdlib_io_zip, only: unzip, zip_prefix, zip_suffix, raw_file - implicit none - -contains - - !> Version: experimental - !> - !> Load multidimensional arrays from a compressed or uncompressed npz file. - !> ([Specification](../page/specs/stdlib_io.html#load_npz)) - module subroutine load_npz_to_bundle(filename, bundle, iostat, iomsg) - character(len=*), intent(in) :: filename - type(t_array_bundle), intent(out) :: bundle - integer, intent(out), optional :: iostat - character(len=:), allocatable, intent(out), optional :: iomsg - - logical :: exists - integer :: io_unit, stat - character(len=:), allocatable :: msg - type(raw_file), allocatable :: raw_files(:) - - call unzip(filename, raw_files, stat, msg) - if (stat /= 0) then - call identify_problem(filename, stat, msg) - end if - - if (present(iostat)) then - iostat = stat - else if (stat /= 0) then - if (allocated(msg)) then - call error_stop("Failed to read arrays from file '"//filename//"'"//nl//msg) - else - call error_stop("Failed to read arrays from file '"//filename//"'") - end if - end if - - if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) - end - - !> Open file and try to identify the problem. - module subroutine identify_problem(filename, stat, msg) - character(len=*), intent(in) :: filename - integer, intent(inout) :: stat - character(len=:), allocatable, intent(inout) :: msg - - logical :: exists - integer :: io_unit, prev_stat - character(len=:), allocatable :: prev_msg - - ! Keep track of the previous status and message in case no reason can be found. - prev_stat = stat - if (allocated(msg)) call move_alloc(msg, prev_msg) - - inquire (file=filename, exist=exists) - if (.not. exists) then - stat = 1; msg = 'File does not exist: '//filename//'.'; return - end if - open (newunit=io_unit, file=filename, form='unformatted', access='stream', & - & status='old', action='read', iostat=stat, iomsg=msg) - if (stat /= 0) return - - call verify_header(io_unit, stat, msg) - if (stat /= 0) return - - ! Restore previous status and message if no reason could be found. - stat = prev_stat; msg = 'Failed to unzip file: '//filename//nl//prev_msg - end - - module subroutine verify_header(io_unit, stat, msg) - integer, intent(in) :: io_unit - integer, intent(out) :: stat - character(len=:), allocatable, intent(out) :: msg - - integer :: file_size - character(len=len(zip_prefix)) :: header - - inquire (io_unit, size=file_size) - if (file_size < len(zip_suffix)) then - stat = 1; msg = 'File is too small to be an npz file.'; return - end if - - read (io_unit, iostat=stat) header - if (stat /= 0) then - msg = 'Failed to read header from file'; return - end if - - if (header == zip_suffix) then - stat = 1; msg = 'Empty npz file.'; return - end if - - if (header /= zip_prefix) then - stat = 1; msg = 'Not an npz file.'; return - end if - end - -end diff --git a/src/stdlib_io_npz_save.fypp b/src/stdlib_io_npz_save.fypp deleted file mode 100644 index 5eea3aded..000000000 --- a/src/stdlib_io_npz_save.fypp +++ /dev/null @@ -1,35 +0,0 @@ -! SPDX-Identifier: MIT - -#:include "common.fypp" -#:set RANKS = range(1, MAXRANK + 1) -#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES - -!> Implementation of loading uncompressed and compressed npz files into multidimensional arrays. -submodule(stdlib_io_np) stdlib_io_npz_save - use stdlib_error, only: error_stop - use stdlib_strings, only: to_string, starts_with - implicit none - -contains - - !> Version: experimental - !> - !> Save multidimensional arrays to a compressed or an uncompressed npz file. - !> ([Specification](../page/specs/stdlib_io.html#save_npz)) - module subroutine save_npz_from_bundle(filename, array_bundle, compressed, iostat, iomsg) - character(len=*), intent(in) :: filename - type(t_array_bundle), intent(in) :: array_bundle - !> If true, the file is saved in compressed format. The default is false. - logical, intent(in), optional :: compressed - integer, intent(out), optional :: iostat - character(len=:), allocatable, intent(out), optional :: iomsg - - logical :: is_compressed - - if (present(compressed)) then - is_compressed = compressed - else - is_compressed = .false. - end if - end -end From 25fdd87ba16987173631d7ac291c9c0c5213fa85 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 23 Feb 2024 03:13:42 +0300 Subject: [PATCH 03/27] Fix npz loading --- src/stdlib_array.fypp | 40 ++++++++- src/stdlib_io_np.fypp | 10 +-- src/stdlib_io_np_load.fypp | 161 +++++++++++++++++-------------------- src/stdlib_io_np_save.fypp | 4 +- src/stdlib_io_zip.f90 | 5 +- test/io/test_np.f90 | 79 +++++++++++++++--- 6 files changed, 191 insertions(+), 108 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index f5087a857..c2c6b3bf8 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -14,8 +14,18 @@ module stdlib_array public :: trueloc, falseloc - type, public :: t_array_bundle - class(t_array), allocatable :: files(:) + !> Helper class to allocate t_array as an abstract type. + type, public :: t_array_wrapper + class(t_array), allocatable :: array + + contains + + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + generic :: allocate_array => allocate_array_${t1[0]}$${k1}$_${rank}$ + procedure :: allocate_array_${t1[0]}$${k1}$_${rank}$ + #:endfor + #:endfor end type type, abstract, public :: t_array @@ -32,6 +42,30 @@ module stdlib_array contains + #:for k1, t1 in KINDS_TYPES + #:for rank in RANKS + !> Allocate an instance of the array within the wrapper. + module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (wrapper, array, stat, msg) + class(t_array_wrapper), intent(out) :: wrapper + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + + allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: wrapper%array, stat=stat) + if (stat /= 0) then + msg = 'Failed to allocate array.'; return + end if + + select type (typed_array => wrapper%array) + class is (t_array_${t1[0]}$${k1}$_${rank}$) + typed_array%values = array + class default + msg = 'Failed to allocate values.'; stat = 1; return + end select + end + #:endfor + #:endfor + !> Version: experimental !> !> Return the positions of the true elements in array. @@ -45,7 +79,7 @@ contains integer :: loc(count(array)) call logicalloc(loc, array, .true., lbound) - end function trueloc + end !> Version: experimental !> diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 1da8f9f53..8e10c3844 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -70,7 +70,7 @@ !> utf8-encoded string, so supports structured types with any unicode field names. module stdlib_io_np use stdlib_kinds, only: int8, int16, int32, int64, sp, dp, xdp, qp - use stdlib_array, only: t_array_bundle + use stdlib_array, only: t_array_wrapper implicit none private @@ -121,9 +121,9 @@ module stdlib_io_np !> Load multiple multidimensional arrays from a (compressed) npz file. !> ([Specification](../page/specs/stdlib_io.html#load_npz)) interface load_npz - module subroutine load_npz_to_bundle(filename, array_bundle, iostat, iomsg) + module subroutine load_npz_to_arrays(filename, arrays, iostat, iomsg) character(len=*), intent(in) :: filename - type(t_array_bundle), intent(out) :: array_bundle + type(t_array_wrapper), allocatable, intent(out) :: arrays(:) integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg end @@ -134,9 +134,9 @@ module stdlib_io_np !> Save multidimensional arrays to a compressed or an uncompressed npz file. !> ([Specification](../page/specs/stdlib_io.html#save_npz)) interface save_npz - module subroutine save_npz_from_bundle(filename, array_bundle, compressed, iostat, iomsg) + module subroutine save_npz_from_arrays(filename, arrays, compressed, iostat, iomsg) character(len=*), intent(in) :: filename - type(t_array_bundle), intent(in) :: array_bundle + type(t_array_wrapper), intent(in) :: arrays(*) !> If true, the file is saved in compressed format. The default is false. logical, intent(in), optional :: compressed integer, intent(out), optional :: iostat diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 87540bd83..cea334062 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -36,11 +36,27 @@ contains open(newunit=io, file=filename, form="unformatted", access="stream", iostat=stat) catch: block + character(len=:), allocatable :: this_type integer, allocatable :: vshape(:) - call verify_npy_file(io, filename, vtype, vshape, rank, stat, msg) + call get_descriptor(io, filename, this_type, vshape, stat, msg) if (stat /= 0) exit catch + if (this_type /= vtype) then + stat = 1 + msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& + & "but expected '"//vtype//"'" + exit catch + end if + + if (size(vshape) /= rank) then + stat = 1 + msg = "File '"//filename//"' contains data of rank "//& + & to_string(size(vshape))//", but expected "//& + & to_string(rank) + exit catch + end if + call allocate_array(array, vshape, stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//vtype//"' "//& @@ -67,44 +83,6 @@ contains #:endfor #:endfor - !> Verify header, type and rank of the npy file. - subroutine verify_npy_file(io, filename, vtype, vshape, rank, stat, msg) - !> Access unit to the npy file. - integer, intent(in) :: io - !> Name of the npy file to load from. - character(len=*), intent(in) :: filename - !> Type of the data stored, retrieved from field `descr`. - character(len=*), intent(in) :: vtype - !> Shape of the stored data, retrieved from field `shape`. - integer, allocatable, intent(out) :: vshape(:) - !> Expected rank of the data. - integer, intent(in) :: rank - !> Status of operation. - integer, intent(out) :: stat - !> Associated error message in case of non-zero status. - character(len=:), allocatable, intent(out) :: msg - - character(len=:), allocatable :: this_type - - call get_descriptor(io, filename, this_type, vshape, stat, msg) - if (stat /= 0) return - - if (this_type /= vtype) then - stat = 1 - msg = "File '"//filename//"' contains data of type '"//this_type//"', "//& - & "but expected '"//vtype//"'" - return - end if - - if (size(vshape) /= rank) then - stat = 1 - msg = "File '"//filename//"' contains data of rank "//& - & to_string(size(vshape))//", but expected "//& - & to_string(rank) - return - end if - end - #:for k1, t1 in KINDS_TYPES #:for rank in RANKS module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(array, vshape, stat) @@ -126,9 +104,9 @@ contains !> !> Load multidimensional arrays from a compressed or uncompressed npz file. !> ([Specification](../page/specs/stdlib_io.html#load_npz)) - module subroutine load_npz_to_bundle(filename, array_bundle, iostat, iomsg) + module subroutine load_npz_to_arrays(filename, arrays, iostat, iomsg) character(len=*), intent(in) :: filename - type(t_array_bundle), intent(out) :: array_bundle + type(t_array_wrapper), allocatable, intent(out) :: arrays(:) integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg @@ -138,9 +116,9 @@ contains call unzip(filename, unzipped_bundle, stat, msg) if (stat == 0) then - call load_raw_to_bundle(unzipped_bundle, array_bundle, stat, msg) + call load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) else - call identify_problem(filename, stat, msg) + call identify_unzip_problem(filename, stat, msg) end if if (present(iostat)) then @@ -156,64 +134,77 @@ contains if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) end - module subroutine load_raw_to_bundle(unzipped_bundle, array_bundle, stat, msg) + module subroutine load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) type(t_unzipped_bundle), intent(in) :: unzipped_bundle - type(t_array_bundle), intent(out) :: array_bundle + type(t_array_wrapper), allocatable, intent(out) :: arrays(:) integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg integer :: i, io + integer, allocatable :: vshape(:) + character(len=:), allocatable :: this_type + + allocate (arrays(size(unzipped_bundle%files))) - allocate (array_bundle%files(size(unzipped_bundle%files))) do i = 1, size(unzipped_bundle%files) - array_bundle%files(i)%name = unzipped_bundle%files(i)%name - open (newunit=io, status='scratch', form='unformatted', access='stream', iostat=stat) - if (stat /= 0) return - write (io) unzipped_bundle%files(i)%data - call load_string_to_array(io, unzipped_bundle%files(i), array_bundle%files(i), stat, msg) - close (io, status='delete', iostat=stat) + open (newunit=io, status='scratch', form='unformatted', access='stream', iostat=stat, iomsg=msg) if (stat /= 0) return - end do - end - - module subroutine load_string_to_array(io, unzipped_file, array, stat, msg) - integer, intent(in) :: io - type(t_unzipped_file), intent(in) :: unzipped_file - class(t_array), intent(inout) :: array - integer, intent(out) :: stat - character(len=:), allocatable, intent(out) :: msg - #:for k1, t1 in KINDS_TYPES - #:for rank in RANKS - ${t1}$, allocatable :: array_${t1[0]}$${k1}$_${rank}$${ranksuffix(rank)}$ - #:endfor - #:endfor + write (io, iostat=stat) unzipped_bundle%files(i)%data + if (stat /= 0) then + msg = 'Failed to write unzipped data to scratch file.' + close (io, status='delete'); return + end if - integer, allocatable :: vshape(:) + rewind (io) + call get_descriptor(io, unzipped_bundle%files(i)%name, this_type, vshape, stat, msg) + if (stat /= 0) return - select type (arr => array) + select case (this_type) #:for k1, t1 in KINDS_TYPES + case (type_${t1[0]}$${k1}$) + select case (size(vshape)) #:for rank in RANKS - type is (t_array_${t1[0]}$${k1}$_${rank}$) - call verify_npy_file(io, unzipped_file%name, type_${t1[0]}$${k1}$, vshape, ${rank}$, stat, msg) - if (stat /= 0) return - call allocate_array(array_${t1[0]}$${k1}$_${rank}$, vshape, stat) - if (stat /= 0) then - msg = "Failed to allocate array of type '"//type_${t1[0]}$${k1}$//"' "//& - & "with total size of "//to_string(product(vshape)) - return - end if - read (io, iostat=stat) array_${t1[0]}$${k1}$_${rank}$${ranksuffix(rank)}$ - arr%values = array_${t1[0]}$${k1}$_${rank}$${ranksuffix(rank)}$ + case (${rank}$) + block + ${t1}$, allocatable :: array${ranksuffix(rank)}$ + + call allocate_array(array, vshape, stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//this_type//"'."; return + end if + + read (io, iostat=stat) array + if (stat /= 0) then + msg = "Failed to read array of type '"//this_type//"' "//& + & 'with total size of '//to_string(product(vshape)); return + end if + + call arrays(i)%allocate_array(array, stat, msg) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//this_type//"' "//& + & 'with total size of '//to_string(product(vshape)); return + end if + + arrays(i)%array%name = unzipped_bundle%files(i)%name + end block #:endfor + case default + stat = 1; msg = 'Unsupported rank for array of type '//this_type//': '// & + & to_string(size(vshape))//'.'; return + end select #:endfor - class default - stat = 1; msg = 'Unsupported array type.'; return - end select + case default + stat = 1; msg = 'Unsupported array type: '//this_type//'.'; return + end select + + close (io, status='delete') + if (stat /= 0) return + end do end - !> Open file and try to identify the problem. - module subroutine identify_problem(filename, stat, msg) + !> Open file and try to identify the cause of the error that occurred during unzip. + module subroutine identify_unzip_problem(filename, stat, msg) character(len=*), intent(in) :: filename integer, intent(inout) :: stat character(len=:), allocatable, intent(inout) :: msg @@ -291,7 +282,7 @@ contains ! stat should be zero if no error occurred stat = 0 - + read(io, iostat=stat) header if (stat /= 0) return diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 6b50c247d..76d08bd21 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -135,9 +135,9 @@ contains !> !> Save multidimensional arrays to a compressed or an uncompressed npz file. !> ([Specification](../page/specs/stdlib_io.html#save_npz)) - module subroutine save_npz_from_bundle(filename, array_bundle, compressed, iostat, iomsg) + module subroutine save_npz_from_arrays(filename, arrays, compressed, iostat, iomsg) character(len=*), intent(in) :: filename - type(t_array_bundle), intent(in) :: array_bundle + type(t_array_wrapper), intent(in) :: arrays(*) !> If true, the file is saved in compressed format. The default is false. logical, intent(in), optional :: compressed integer, intent(out), optional :: iostat diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 68921a6ed..00c407a98 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -1,5 +1,4 @@ module stdlib_io_zip - use stdlib_array, only: t_array_bundle use stdlib_io_minizip use iso_c_binding, only: c_ptr, c_associated, c_int, c_long, c_char implicit none @@ -13,7 +12,7 @@ module stdlib_io_zip integer(kind=c_long), parameter :: buffer_size = 1024 interface unzip - module procedure unzip_to_raw + module procedure unzip_to_bundle end interface !> Contains extracted raw data from a zip file. @@ -32,7 +31,7 @@ module stdlib_io_zip contains - module subroutine unzip_to_raw(filename, bundle, iostat, iomsg) + module subroutine unzip_to_bundle(filename, bundle, iostat, iomsg) character(len=*), intent(in) :: filename type(t_unzipped_bundle), intent(out) :: bundle integer, intent(out), optional :: iostat diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index a3eb7fb8b..0a6ba087c 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,6 +1,6 @@ module test_np use stdlib_kinds, only: int8, int16, int32, int64, sp, dp - use stdlib_array, only: t_array_bundle + use stdlib_array, only: t_array_wrapper use stdlib_io_np, only: load_npy, save_npy, load_npz use testdrive, only: new_unittest, unittest_type, error_type, check implicit none @@ -40,7 +40,9 @@ subroutine collect_np(testsuite) new_unittest("npz-nonexistent-file", test_npz_nonexistent_file, should_fail=.true.), & new_unittest("npz-small-file", test_npz_small_file, should_fail=.true.), & new_unittest("npz-empty-zip", test_npz_empty_zip, should_fail=.true.), & - new_unittest("npz-not-zip", test_npz_not_zip, should_fail=.true.) & + new_unittest("npz-not-zip", test_npz_not_zip, should_fail=.true.), & + new_unittest("npz-empty-array", test_npz_empty_array), & + new_unittest("npz-exceeded-rank", test_npz_exceeded_rank, should_fail=.true.) & ] end subroutine collect_np @@ -650,11 +652,11 @@ subroutine test_npz_nonexistent_file(error) type(error_type), allocatable, intent(out) :: error character(len=*), parameter :: filename = 'test_nonexistent_file.npz' - type(t_array_bundle) :: bundle + type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(len=:), allocatable :: msg - call load_npz(filename, bundle, stat, msg) + call load_npz(filename, arrays, stat, msg) call check(error, stat, msg) end @@ -665,13 +667,13 @@ subroutine test_npz_small_file(error) integer :: io, stat character(len=:), allocatable :: msg character(len=*), parameter :: filename = '.test-small-file.npz' - type(t_array_bundle) :: bundle + type(t_array_wrapper), allocatable :: arrays(:) open (newunit=io, file=filename, form='unformatted', access='stream') write (io) header close (io) - call load_npz(filename, bundle, stat, msg) + call load_npz(filename, arrays, stat, msg) call delete_file(filename) call check(error, stat, msg) @@ -684,13 +686,13 @@ subroutine test_npz_empty_zip(error) integer :: io, stat character(len=:), allocatable :: msg character(len=*), parameter :: filename = '.test-empty-zip.npz' - type(t_array_bundle) :: bundle + type(t_array_wrapper), allocatable :: arrays(:) open (newunit=io, file=filename, form='unformatted', access='stream') write (io) header close (io) - call load_npz(filename, bundle, stat, msg) + call load_npz(filename, arrays, stat, msg) call delete_file(filename) call check(error, stat, msg) @@ -703,13 +705,70 @@ subroutine test_npz_not_zip(error) integer :: io, stat character(len=:), allocatable :: msg character(len=*), parameter :: filename = '.test-not-zip.npz' - type(t_array_bundle) :: bundle + type(t_array_wrapper), allocatable :: arrays(:) open (newunit=io, file=filename, form='unformatted', access='stream') write (io) header close (io) - call load_npz(filename, bundle, stat, msg) + call load_npz(filename, arrays, stat, msg) + call delete_file(filename) + + call check(error, stat, msg) + end + + subroutine test_npz_empty_array(error) + type(error_type), allocatable, intent(out) :: error + + character(*), parameter :: binary_data = 'PK'//char(3)//char(4)//'-'//repeat(char(0), 7)//'!'//char(0)//'6H[s'// & + & repeat(char(int(z'ff')), 8)//char(9)//char(0)//char(int(z'14'))//char(0)//'arr_0.npy'//char(1)//char(0)// & + & char(int(z'10'))//char(0)//char(int(z'80'))//repeat(char(0), 7)//char(int(z'80'))//repeat(char(0), 7)// & + & char(int(z'93'))//'NUMPY'//char(1)//char(0)//'v'//char(0)// & + & "{'descr': ' Date: Fri, 23 Feb 2024 15:08:04 +0300 Subject: [PATCH 04/27] Add tests for loading npz files --- test/io/test_np.f90 | 131 +++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 128 insertions(+), 3 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 0a6ba087c..157726569 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,8 +1,9 @@ module test_np use stdlib_kinds, only: int8, int16, int32, int64, sp, dp - use stdlib_array, only: t_array_wrapper + use stdlib_array + use stdlib_strings, only: to_string use stdlib_io_np, only: load_npy, save_npy, load_npz - use testdrive, only: new_unittest, unittest_type, error_type, check + use testdrive, only: new_unittest, unittest_type, error_type, check, test_failed implicit none private @@ -42,7 +43,9 @@ subroutine collect_np(testsuite) new_unittest("npz-empty-zip", test_npz_empty_zip, should_fail=.true.), & new_unittest("npz-not-zip", test_npz_not_zip, should_fail=.true.), & new_unittest("npz-empty-array", test_npz_empty_array), & - new_unittest("npz-exceeded-rank", test_npz_exceeded_rank, should_fail=.true.) & + new_unittest("npz-exceeded-rank", test_npz_exceeded_rank, should_fail=.true.), & + new_unittest("npz-single-file-one-dim", test_npz_single_file_one_dim), & + new_unittest("npz-two-files-one-dim", test_npz_two_files) & ] end subroutine collect_np @@ -743,6 +746,16 @@ subroutine test_npz_empty_array(error) call delete_file(filename) call check(error, stat, msg) + call check(error, size(arrays) == 1, 'Size of arrays not 1: '//trim(to_string(size(arrays)))) + call check(error, allocated(arrays(1)%array), 'Array not allocated.') + + select type (array => arrays(1)%array) + type is (t_array_rdp_1) + call check(error, allocated(array%values), 'Values not allocated.') + call check(error, size(array%values) == 0, 'Values not empty: '//trim(to_string(size(array%values)))) + class default + call test_failed(error, 'Array not allocated for correct type.') + end select end subroutine test_npz_exceeded_rank(error) @@ -774,6 +787,118 @@ subroutine test_npz_exceeded_rank(error) call check(error, stat, msg) end + subroutine test_npz_single_file_one_dim(error) + type(error_type), allocatable, intent(out) :: error + + ! arr_0.npy = [2,4,8] + character(*), parameter :: binary_data = 'PK'//char(3)//char(4)//'-'//repeat(char(0), 7)//'!'//char(0)//'&M'// & + & char(int(z'b0'))//char(int(z'd8'))//repeat(char(int(z'ff')), 8)//char(9)//char(0)//char(int(z'14'))// & + & char(0)//'arr_0.npy'//char(1)//char(0)//char(int(z'10'))//char(0)//char(int(z'98'))//repeat(char(0), 7)// & + & char(int(z'98'))//repeat(char(0), 7)//char(int(z'93'))//'NUMPY'//char(1)//char(0)//'v'//char(0)// & + & "{'descr': ' arrays(1)%array) + type is (t_array_iint64_1) + call check(error, array%name == 'arr_0.npy', 'Wrong name: '//trim(array%name)) + call check(error, allocated(array%values), 'Values not allocated.') + call check(error, size(array%values) == 3, 'Not 3 entries in values: '//trim(to_string(size(array%values)))) + call check(error, array%values(1) == 2, 'First value is not 2: '//trim(to_string(array%values(1)))) + call check(error, array%values(2) == 4, 'Second value is not 4: '//trim(to_string(array%values(2)))) + call check(error, array%values(3) == 8, 'Third value is not 8: '//trim(to_string(array%values(3)))) + class default + call test_failed(error, 'Array not allocated for correct type.') + end select + end + + subroutine test_npz_two_files(error) + type(error_type), allocatable, intent(out) :: error + + ! arr_0.npy = [[1,2],[3,4]] + ! arr_1.npy = [1.2,3.4] + character(*), parameter :: binary_data = 'PK'//char(3)//char(4)//'-'//repeat(char(0), 7)//'!'//char(0)//char(int(z'a0'))// & + & 'DK['//repeat(char(int(z'ff')), 8)//char(9)//char(0)//char(int(z'14'))//char(0)//'arr_0.npy'//char(1)// & + & char(0)//char(int(z'10'))//char(0)//char(int(z'a0'))//repeat(char(0), 7)//char(int(z'a0'))// & + & repeat(char(0), 7)//char(int(z'93'))//'NUMPY'//char(1)//char(0)//'v'//char(0)// & + & "{'descr': ' arrays(1)%array) + type is (t_array_iint64_2) + call check(error, array%name == 'arr_0.npy', 'Wrong name: '//trim(array%name)) + call check(error, allocated(array%values), 'Values not allocated.') + call check(error, size(array%values) == 4, 'Not 4 entries in values: '//trim(to_string(size(array%values)))) + call check(error, size(array%values, 1) == 2, 'Not 2 entries in dim 1: '//trim(to_string(size(array%values, 2)))) + call check(error, size(array%values, 2) == 2, 'Not 2 entries in dim 2: '//trim(to_string(size(array%values, 2)))) + call check(error, array%values(1, 1) == 1, 'First value in dim 1 not 1: '//trim(to_string(array%values(1, 1)))) + call check(error, array%values(2, 1) == 2, 'Second value in dim 1 not 2: '//trim(to_string(array%values(2, 1)))) + call check(error, array%values(1, 2) == 3, 'First value in dim 2 not 3: '//trim(to_string(array%values(1, 2)))) + call check(error, array%values(2, 2) == 4, 'Second value in dim 2 not 4: '//trim(to_string(array%values(2, 2)))) + class default + call test_failed(error, 'Array not allocated for correct type.') + end select + + select type (array => arrays(2)%array) + type is (t_array_rdp_1) + call check(error, array%name == 'arr_1.npy', 'Wrong name: '//trim(array%name)) + call check(error, allocated(array%values), 'Values not allocated.') + call check(error, size(array%values) == 2, 'Not 2 entries in values: '//trim(to_string(size(array%values)))) + call check(error, array%values(1) == 1.2_dp, 'First value in dim 1 not 1.2: '//trim(to_string(array%values(1)))) + call check(error, array%values(2) == 3.4_dp, 'Second value in dim 1 not 3.4: '//trim(to_string(array%values(2)))) + class default + call test_failed(error, 'Array not allocated for correct type.') + end select + end + subroutine delete_file(filename) character(len=*), intent(in) :: filename From aba2596c4d40b76d39b83617e8c07a9a01ff1ed7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 3 Mar 2024 21:34:58 +0300 Subject: [PATCH 05/27] Build minizip-ng from source --- CMakeLists.txt | 4 +++- example/CMakeLists.txt | 3 +-- src/stdlib_io_minizip.f90 | 5 ++++- test/CMakeLists.txt | 3 +-- 4 files changed, 9 insertions(+), 6 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 855e31e60..4d45cc7a0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -49,7 +49,9 @@ if(NOT FYPP) endif() # --- find dependencies -find_library(MINIZIP_LIBRARY NAMES minizip HINTS /opt/homebrew/Caskroom/miniconda/base/envs/minizip/lib) +if (NOT TARGET "minizip::minizip") + find_package("minizip" REQUIRED) +endif() # Custom preprocessor flags if(DEFINED CMAKE_MAXIMUM_RANK) diff --git a/example/CMakeLists.txt b/example/CMakeLists.txt index cd324f652..6e15b45a6 100644 --- a/example/CMakeLists.txt +++ b/example/CMakeLists.txt @@ -1,7 +1,6 @@ macro(ADD_EXAMPLE name) add_executable(example_${name} example_${name}.f90) - target_link_libraries(example_${name} "${PROJECT_NAME}") - target_link_libraries(example_${name} ${PROJECT_NAME} ${MINIZIP_LIBRARY}) + target_link_libraries(example_${name} ${PROJECT_NAME} "minizip::minizip") add_test(NAME ${name} COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) diff --git a/src/stdlib_io_minizip.f90 b/src/stdlib_io_minizip.f90 index 51189c800..a9c0b429c 100644 --- a/src/stdlib_io_minizip.f90 +++ b/src/stdlib_io_minizip.f90 @@ -1,4 +1,6 @@ -!> Interface to the minizip library for creating and extracting zip files. +!> Interface to the minizip-ng library for creating and extracting zip files. +!> +!> https://github.com/zlib-ng/minizip-ng module stdlib_io_minizip use, intrinsic :: iso_c_binding, only: c_char, c_ptr, c_int, c_long implicit none @@ -12,6 +14,7 @@ module stdlib_io_minizip integer, parameter, public :: UNZ_BADZIPFILE = -103 integer, parameter, public :: UNZ_INTERNALERROR = -104 integer, parameter, public :: UNZ_CRCERROR = -105 + integer, parameter, public :: UNZ_BADPASSWORD = -106 public :: unz_get_global_info public :: unz_open diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index ada9eb193..8b33d1f8d 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -4,8 +4,7 @@ endif() macro(ADDTEST name) add_executable(test_${name} test_${name}.f90) - target_link_libraries(test_${name} "${PROJECT_NAME}" "test-drive::test-drive") - target_link_libraries(test_${name} ${PROJECT_NAME} ${MINIZIP_LIBRARY}) + target_link_libraries(test_${name} ${PROJECT_NAME} "minizip::minizip" "test-drive::test-drive") add_test(NAME ${name} COMMAND $ ${CMAKE_CURRENT_BINARY_DIR} WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) From dc70f0b8ae3cf5292103336eb1c914ff26cf83ac Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 3 Mar 2024 21:35:12 +0300 Subject: [PATCH 06/27] Add missing file --- config/cmake/Findminizip.cmake | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 config/cmake/Findminizip.cmake diff --git a/config/cmake/Findminizip.cmake b/config/cmake/Findminizip.cmake new file mode 100644 index 000000000..813d3cd16 --- /dev/null +++ b/config/cmake/Findminizip.cmake @@ -0,0 +1,14 @@ +set(_NAME "minizip") +set(_URL "https://github.com/zlib-ng/minizip-ng") +set(_TAG "4.0.4") + +message(STATUS "Retrieving ${_NAME} from ${_URL}") +include(FetchContent) +FetchContent_Declare( + ${_NAME} + GIT_REPOSITORY ${_URL} + GIT_TAG ${_TAG} +) +FetchContent_MakeAvailable(${_NAME}) +add_library("${_NAME}::${_NAME}" INTERFACE IMPORTED) +target_link_libraries("${_NAME}::${_NAME}" INTERFACE "${_NAME}") From 56d9b0bb78cc7f3a5a85dc6e47b6f4eab4830a19 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 17 Apr 2024 15:22:16 +0545 Subject: [PATCH 07/27] Disable test to check --- test/io/test_zip.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index f12908d44..0e44b622f 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -14,7 +14,7 @@ subroutine collect_np(testsuite) testsuite = [ & new_unittest('unexistent-file', test_unexistent_file, should_fail=.true.), & - new_unittest('empty-zip', test_empty_zip), & + ! new_unittest('empty-zip', test_empty_zip), & new_unittest('empty-array', test_empty_array), & new_unittest('single-file', test_single_file), & new_unittest('two-files', test_two_files) & From c2dd7150c42612e6ae023009b1490ed38ea0a89e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 23 Apr 2024 23:05:41 +0545 Subject: [PATCH 08/27] Concatenate with c_null_char --- src/stdlib_io_zip.f90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 00c407a98..fef2510f7 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -1,6 +1,6 @@ module stdlib_io_zip use stdlib_io_minizip - use iso_c_binding, only: c_ptr, c_associated, c_int, c_long, c_char + use iso_c_binding, only: c_ptr, c_associated, c_int, c_long, c_char, c_null_char, c_null_ptr implicit none private @@ -47,7 +47,9 @@ module subroutine unzip_to_bundle(filename, bundle, iostat, iomsg) if (present(iostat)) iostat = 0 - file_handle = unz_open(filename) + file_handle = c_null_ptr + + file_handle = unz_open(filename//c_null_char) if (.not. c_associated(file_handle)) then if (present(iostat)) iostat = 1 if (present(iomsg)) iomsg = 'Failed to open file '//trim(filename)//'.' From 9b7e0e7065672633a95eccb27e283a6a2dc45b7a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 23 Apr 2024 23:55:04 +0545 Subject: [PATCH 09/27] Remove space --- src/stdlib_array.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index c2c6b3bf8..23808501b 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -45,7 +45,7 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS !> Allocate an instance of the array within the wrapper. - module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (wrapper, array, stat, msg) + module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, array, stat, msg) class(t_array_wrapper), intent(out) :: wrapper ${t1}$, intent(in) :: array${ranksuffix(rank)}$ integer, intent(out) :: stat From 79fe67d267eeeffa93b2a9a67b44b89189473882 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 24 Apr 2024 10:48:43 +0545 Subject: [PATCH 10/27] Install minizip-ng on mingw and msys --- .github/workflows/ci_windows.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 27d49f6c5..f24f79a4f 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -38,6 +38,7 @@ jobs: mingw-w64-${{ matrix.arch }}-python-setuptools mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja + mingw-w64-${{ matrix.arch }}-minizip-ng - name: Setup msys POSIX environment uses: msys2/setup-msys2@v2 @@ -53,6 +54,7 @@ jobs: python-pip cmake ninja + minizip-ng - name: Install fypp run: pip install fypp From 0e21adcc2c193b395d136c31b0832da4cc6e9aab Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 24 Apr 2024 11:18:59 +0545 Subject: [PATCH 11/27] Try x86_64 --- .github/workflows/ci_windows.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index f24f79a4f..ba811a580 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -38,7 +38,7 @@ jobs: mingw-w64-${{ matrix.arch }}-python-setuptools mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja - mingw-w64-${{ matrix.arch }}-minizip-ng + mingw-w64-x86_64-minizip-ng - name: Setup msys POSIX environment uses: msys2/setup-msys2@v2 @@ -54,7 +54,7 @@ jobs: python-pip cmake ninja - minizip-ng + mingw-w64-x86_64-minizip-ng - name: Install fypp run: pip install fypp From 3a90b66a1bb9444bc0faffc29e54055d5abad092 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 29 Jul 2024 19:28:11 +0530 Subject: [PATCH 12/27] Fix typo --- src/stdlib_io_np.fypp | 2 +- src/stdlib_io_np_save.fypp | 2 +- test/string/test_string_derivedtype_io.f90 | 2 +- test/string/test_string_intrinsic.f90 | 2 +- test/string/test_string_operator.f90 | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 8e10c3844..37ea2858d 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -1,4 +1,4 @@ -! SPDX-Identifer: MIT +! SPDX-Identifier: MIT #:include "common.fypp" #:set RANKS = range(1, MAXRANK + 1) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 76d08bd21..b6fffbcc3 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -1,4 +1,4 @@ -! SPDX-Identifer: MIT +! SPDX-Identifier: MIT #:include "common.fypp" #:set RANKS = range(1, MAXRANK + 1) diff --git a/test/string/test_string_derivedtype_io.f90 b/test/string/test_string_derivedtype_io.f90 index c99272dac..ccc5cdcaa 100644 --- a/test/string/test_string_derivedtype_io.f90 +++ b/test/string/test_string_derivedtype_io.f90 @@ -1,4 +1,4 @@ -! SPDX-Identifer: MIT +! SPDX-Identifier: MIT module test_string_derivedtype_io use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_string_type, only : string_type, assignment(=), len, & diff --git a/test/string/test_string_intrinsic.f90 b/test/string/test_string_intrinsic.f90 index c84fbbd48..11fa40c13 100644 --- a/test/string/test_string_intrinsic.f90 +++ b/test/string/test_string_intrinsic.f90 @@ -1,4 +1,4 @@ -! SPDX-Identifer: MIT +! SPDX-Identifier: MIT module test_string_intrinsic use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_string_type diff --git a/test/string/test_string_operator.f90 b/test/string/test_string_operator.f90 index 0252f3f45..d2ed2f390 100644 --- a/test/string/test_string_operator.f90 +++ b/test/string/test_string_operator.f90 @@ -1,4 +1,4 @@ -! SPDX-Identifer: MIT +! SPDX-Identifier: MIT module test_string_operator use testdrive, only : new_unittest, unittest_type, error_type, check use stdlib_string_type, only : string_type, assignment(=), len, & From 961d80eb8ff18bf73508f5425b49a2731ee9c62f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 30 Jul 2024 22:04:51 +0530 Subject: [PATCH 13/27] Remove 'module' --- src/stdlib_array.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 23808501b..ab2811ef3 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -45,7 +45,7 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS !> Allocate an instance of the array within the wrapper. - module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, array, stat, msg) + subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, array, stat, msg) class(t_array_wrapper), intent(out) :: wrapper ${t1}$, intent(in) :: array${ranksuffix(rank)}$ integer, intent(out) :: stat From 14604ac960f083e7b866c148a8f8e2245369d1ed Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 30 Jul 2024 22:12:49 +0530 Subject: [PATCH 14/27] Remove the other 'module' --- src/stdlib_io_zip.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index fef2510f7..9d7eac738 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -12,7 +12,7 @@ module stdlib_io_zip integer(kind=c_long), parameter :: buffer_size = 1024 interface unzip - module procedure unzip_to_bundle + procedure unzip_to_bundle end interface !> Contains extracted raw data from a zip file. @@ -31,7 +31,7 @@ module stdlib_io_zip contains - module subroutine unzip_to_bundle(filename, bundle, iostat, iomsg) + subroutine unzip_to_bundle(filename, bundle, iostat, iomsg) character(len=*), intent(in) :: filename type(t_unzipped_bundle), intent(out) :: bundle integer, intent(out), optional :: iostat From b435ce094c6f77e51db0d36b66374e1a7a8126e8 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 30 Jul 2024 22:26:06 +0530 Subject: [PATCH 15/27] Remove more 'module's --- src/stdlib_io_np_load.fypp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index cea334062..046d706d4 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -134,7 +134,7 @@ contains if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) end - module subroutine load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) + subroutine load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) type(t_unzipped_bundle), intent(in) :: unzipped_bundle type(t_array_wrapper), allocatable, intent(out) :: arrays(:) integer, intent(out) :: stat @@ -204,7 +204,7 @@ contains end !> Open file and try to identify the cause of the error that occurred during unzip. - module subroutine identify_unzip_problem(filename, stat, msg) + subroutine identify_unzip_problem(filename, stat, msg) character(len=*), intent(in) :: filename integer, intent(inout) :: stat character(len=:), allocatable, intent(inout) :: msg @@ -232,7 +232,7 @@ contains stat = prev_stat; msg = 'Failed to unzip file: '//filename//nl//prev_msg end - module subroutine verify_header(io_unit, stat, msg) + subroutine verify_header(io_unit, stat, msg) integer, intent(in) :: io_unit integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg From 198af63eceee6e756a9b283b3212f4dcc391f3c2 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 1 Aug 2024 15:49:35 +0530 Subject: [PATCH 16/27] Try installing fypp in another way --- .github/workflows/ci_windows.yml | 7 ++++++- src/stdlib_array.fypp | 4 +--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index ba811a580..6725616fa 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -56,7 +56,12 @@ jobs: ninja mingw-w64-x86_64-minizip-ng - - name: Install fypp + - name: Install fypp (MSYS) + if: contains(matrix.msystem, 'MSYS') + run: pacman -S --noconfirm python-pip && pip install fypp + + - name: Install fypp (MinGW) + if: contains(matrix.msystem, 'MINGW') run: pip install fypp - run: >- diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index ab2811ef3..4f7aaf960 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -17,9 +17,7 @@ module stdlib_array !> Helper class to allocate t_array as an abstract type. type, public :: t_array_wrapper class(t_array), allocatable :: array - contains - #:for k1, t1 in KINDS_TYPES #:for rank in RANKS generic :: allocate_array => allocate_array_${t1[0]}$${k1}$_${rank}$ @@ -45,7 +43,7 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS !> Allocate an instance of the array within the wrapper. - subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, array, stat, msg) + subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (wrapper, array, stat, msg) class(t_array_wrapper), intent(out) :: wrapper ${t1}$, intent(in) :: array${ranksuffix(rank)}$ integer, intent(out) :: stat From f63e4a3ce0874473ed8306f053375d931bba7820 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 1 Aug 2024 16:02:12 +0530 Subject: [PATCH 17/27] Use pipx --- .github/workflows/ci_windows.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 6725616fa..6dd90ee4e 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -58,7 +58,7 @@ jobs: - name: Install fypp (MSYS) if: contains(matrix.msystem, 'MSYS') - run: pacman -S --noconfirm python-pip && pip install fypp + run: pacman -S --noconfirm python-pipx && pipx install fypp - name: Install fypp (MinGW) if: contains(matrix.msystem, 'MINGW') From 093a1215c2b312cf7a0bac865c6a0bc03c3e04ee Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 1 Aug 2024 16:16:39 +0530 Subject: [PATCH 18/27] Use msys2 package --- .github/workflows/ci_windows.yml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 6dd90ee4e..9c63c3a96 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -52,14 +52,11 @@ jobs: mingw-w64-x86_64-gcc-fortran python python-pip + mingw-w64-python-fypp cmake ninja mingw-w64-x86_64-minizip-ng - - name: Install fypp (MSYS) - if: contains(matrix.msystem, 'MSYS') - run: pacman -S --noconfirm python-pipx && pipx install fypp - - name: Install fypp (MinGW) if: contains(matrix.msystem, 'MINGW') run: pip install fypp From fed6ea6f52e49f9fe71d2f1729b7fb7feb8809f2 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 1 Aug 2024 16:22:14 +0530 Subject: [PATCH 19/27] Try to install binary package directly --- .github/workflows/ci_windows.yml | 2 +- fpm.toml | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 9c63c3a96..a9e056d10 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -52,7 +52,7 @@ jobs: mingw-w64-x86_64-gcc-fortran python python-pip - mingw-w64-python-fypp + mingw-w64-x86_64-python-fypp cmake ninja mingw-w64-x86_64-minizip-ng diff --git a/fpm.toml b/fpm.toml index bf8dfc530..ff11e5258 100644 --- a/fpm.toml +++ b/fpm.toml @@ -9,6 +9,9 @@ copyright = "2019-2021 stdlib contributors" test-drive.git = "https://github.com/fortran-lang/test-drive" test-drive.tag = "v0.4.0" +[build] +link = ["minizip-ng"] + [preprocess] [preprocess.cpp] suffixes = [".F90", ".f90"] From e1aceca2a04862e522c4004d038babb68cf3ba7b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 1 Aug 2024 16:33:20 +0530 Subject: [PATCH 20/27] Only use msys2 packages, remove pip --- .github/workflows/ci_windows.yml | 7 +------ fpm.toml | 3 --- 2 files changed, 1 insertion(+), 9 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index a9e056d10..6a3d8bac0 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -34,7 +34,7 @@ jobs: mingw-w64-${{ matrix.arch }}-gcc mingw-w64-${{ matrix.arch }}-gcc-fortran mingw-w64-${{ matrix.arch }}-python - mingw-w64-${{ matrix.arch }}-python-pip + mingw-w64-${{ matrix.arch }}-python-fypp mingw-w64-${{ matrix.arch }}-python-setuptools mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja @@ -51,16 +51,11 @@ jobs: mingw-w64-x86_64-gcc mingw-w64-x86_64-gcc-fortran python - python-pip mingw-w64-x86_64-python-fypp cmake ninja mingw-w64-x86_64-minizip-ng - - name: Install fypp (MinGW) - if: contains(matrix.msystem, 'MINGW') - run: pip install fypp - - run: >- PATH=$PATH:/mingw64/bin/ cmake -Wdev diff --git a/fpm.toml b/fpm.toml index ff11e5258..bf8dfc530 100644 --- a/fpm.toml +++ b/fpm.toml @@ -9,9 +9,6 @@ copyright = "2019-2021 stdlib contributors" test-drive.git = "https://github.com/fortran-lang/test-drive" test-drive.tag = "v0.4.0" -[build] -link = ["minizip-ng"] - [preprocess] [preprocess.cpp] suffixes = [".F90", ".f90"] From f1e199f620995aa49ed248f318b22ba69263bfcd Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 2 Aug 2024 12:46:42 +0530 Subject: [PATCH 21/27] Unify env setup --- .github/workflows/ci_windows.yml | 20 +------------------- 1 file changed, 1 insertion(+), 19 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 6a3d8bac0..58be7d1fb 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -23,9 +23,8 @@ jobs: steps: - uses: actions/checkout@v2 - - name: Setup MinGW native environment + - name: Setup environment uses: msys2/setup-msys2@v2 - if: contains(matrix.msystem, 'MINGW') with: msystem: ${{ matrix.msystem }} update: false @@ -35,27 +34,10 @@ jobs: mingw-w64-${{ matrix.arch }}-gcc-fortran mingw-w64-${{ matrix.arch }}-python mingw-w64-${{ matrix.arch }}-python-fypp - mingw-w64-${{ matrix.arch }}-python-setuptools mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja mingw-w64-x86_64-minizip-ng - - name: Setup msys POSIX environment - uses: msys2/setup-msys2@v2 - if: contains(matrix.msystem, 'MSYS') - with: - msystem: MSYS - update: false - install: >- - git - mingw-w64-x86_64-gcc - mingw-w64-x86_64-gcc-fortran - python - mingw-w64-x86_64-python-fypp - cmake - ninja - mingw-w64-x86_64-minizip-ng - - run: >- PATH=$PATH:/mingw64/bin/ cmake -Wdev From 44f2627afd777856739ba60a6e6f74060b7a879e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 2 Aug 2024 18:14:05 +0530 Subject: [PATCH 22/27] Not use generic --- src/stdlib_array.fypp | 1 - src/stdlib_io_np_load.fypp | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 4f7aaf960..00e611017 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -20,7 +20,6 @@ module stdlib_array contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - generic :: allocate_array => allocate_array_${t1[0]}$${k1}$_${rank}$ procedure :: allocate_array_${t1[0]}$${k1}$_${rank}$ #:endfor #:endfor diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 046d706d4..e2d999090 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -180,7 +180,7 @@ contains & 'with total size of '//to_string(product(vshape)); return end if - call arrays(i)%allocate_array(array, stat, msg) + call arrays(i)%allocate_array_${t1[0]}$${k1}$_${rank}$(array, stat, msg) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"' "//& & 'with total size of '//to_string(product(vshape)); return From a79741e477230ba21ea2e68c74f1befd771b8399 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 2 Aug 2024 18:23:31 +0530 Subject: [PATCH 23/27] Make array allocatable --- src/stdlib_array.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 00e611017..a84f1898f 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -44,7 +44,7 @@ contains !> Allocate an instance of the array within the wrapper. subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (wrapper, array, stat, msg) class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + ${t1}$, allocatable, intent(in) :: array${ranksuffix(rank)}$ integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg From 2ab6354f8c77a5dae6dc65ef6c0c8ceeb204fe48 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 2 Aug 2024 18:50:04 +0530 Subject: [PATCH 24/27] Rename one of the functions --- src/stdlib_io_np.fypp | 4 ++-- src/stdlib_io_np_load.fypp | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 37ea2858d..399c4ae4b 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -144,10 +144,10 @@ module stdlib_io_np end end interface - interface allocate_array + interface allocate_array_from_shape #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (array, vshape, stat) + module subroutine allocate_array_from_shape_${t1[0]}$${k1}$_${rank}$ (array, vshape, stat) !> Instance of the array to be allocated. ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$ !> Dimensions to allocate for. diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index e2d999090..31e1f392f 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -57,7 +57,7 @@ contains exit catch end if - call allocate_array(array, vshape, stat) + call allocate_array_from_shape(array, vshape, stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//vtype//"' "//& & "with total size of "//to_string(product(vshape)) @@ -85,7 +85,7 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(array, vshape, stat) + module subroutine allocate_array_from_shape_${t1[0]}$${k1}$_${rank}$(array, vshape, stat) ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$ integer, intent(in) :: vshape(:) integer, intent(out) :: stat @@ -169,7 +169,7 @@ contains block ${t1}$, allocatable :: array${ranksuffix(rank)}$ - call allocate_array(array, vshape, stat) + call allocate_array_from_shape(array, vshape, stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"'."; return end if From ceef8b46c4919e59f8664a69d33e0f52c127e442 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 2 Aug 2024 19:02:41 +0530 Subject: [PATCH 25/27] Remove allocatable attribute again --- src/stdlib_array.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index a84f1898f..00e611017 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -44,7 +44,7 @@ contains !> Allocate an instance of the array within the wrapper. subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (wrapper, array, stat, msg) class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, allocatable, intent(in) :: array${ranksuffix(rank)}$ + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg From 97c3f2ce0b2d850335cd125a2e30a3baf4d9c38d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 2 Aug 2024 19:05:00 +0530 Subject: [PATCH 26/27] Use generic again --- src/stdlib_array.fypp | 1 + src/stdlib_io_np_load.fypp | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 00e611017..4f7aaf960 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -20,6 +20,7 @@ module stdlib_array contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS + generic :: allocate_array => allocate_array_${t1[0]}$${k1}$_${rank}$ procedure :: allocate_array_${t1[0]}$${k1}$_${rank}$ #:endfor #:endfor diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 31e1f392f..843837309 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -180,7 +180,7 @@ contains & 'with total size of '//to_string(product(vshape)); return end if - call arrays(i)%allocate_array_${t1[0]}$${k1}$_${rank}$(array, stat, msg) + call arrays(i)%allocate_array(array, stat, msg) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"' "//& & 'with total size of '//to_string(product(vshape)); return From 276c7858250fd177b03f8c4f1d3e7d07af671fba Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 18:19:43 +0530 Subject: [PATCH 27/27] Remove duplication --- src/CMakeLists.txt | 1 - 1 file changed, 1 deletion(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index c174bf2fe..14512185c 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -102,7 +102,6 @@ set(SRC stdlib_ansi.f90 stdlib_ansi_operator.f90 stdlib_ansi_to_string.f90 - stdlib_array.f90 stdlib_codata.f90 stdlib_error.f90 stdlib_hashmap_wrappers.f90