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