Add minizip and extract .npz files

.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
@@ -34,28 +33,10 @@ 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-setuptools
+          mingw-w64-${{ matrix.arch }}-python-fypp
           mingw-w64-${{ matrix.arch }}-cmake
           mingw-w64-${{ matrix.arch }}-ninja
-
-    - 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
-          python-pip
-          cmake
-          ninja
-
-    - name: Install fypp
-      run: pip install fypp
+          mingw-w64-x86_64-minizip-ng
 
     - run: >-
         PATH=$PATH:/mingw64/bin/ cmake

CMakeLists.txt

@@ -48,6 +48,11 @@ 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
+if (NOT TARGET "minizip::minizip")
+  find_package("minizip" REQUIRED)
+endif()
+
 # Custom preprocessor flags
 if(DEFINED CMAKE_MAXIMUM_RANK)
   set(fyppFlags "-DMAXRANK=${CMAKE_MAXIMUM_RANK}")

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}")

example/CMakeLists.txt

@@ -1,6 +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::minizip")
     add_test(NAME ${name}
              COMMAND $<TARGET_FILE:example_${name}> ${CMAKE_CURRENT_BINARY_DIR}
              WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})

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)

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)

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
@@ -17,9 +18,9 @@ set(fppFiles
     stdlib_hash_64bit_pengy.fypp
     stdlib_hash_64bit_spookyv2.fypp
     stdlib_io.fypp
-    stdlib_io_npy.fypp
-    stdlib_io_npy_load.fypp
-    stdlib_io_npy_save.fypp
+    stdlib_io_np.fypp
+    stdlib_io_np_load.fypp
+    stdlib_io_np_save.fypp
     stdlib_kinds.fypp
     stdlib_linalg.fypp
     stdlib_linalg_diag.fypp
@@ -101,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
@@ -115,6 +115,8 @@ set(SRC
     stdlib_specialfunctions_legendre.f90
     stdlib_quadrature_gauss.f90
     stdlib_stringlist_type.f90
+    stdlib_io_zip.f90
+    stdlib_io_minizip.f90
     ${outFiles}
     ${outPreprocFiles}
 )

src/stdlib_array.fypp

@@ -0,0 +1,120 @@
+! 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
+
+    !> 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
+        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
+
+    #: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)
+                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.
+    !> [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
+
+    !> 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

src/stdlib_io_minizip.f90

@@ -0,0 +1,127 @@
+!> 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
+    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
+    integer, parameter, public :: UNZ_BADPASSWORD = -106
+
+    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

src/stdlib_io_npy.fypp → src/stdlib_io_np.fypp

@@ -1,4 +1,4 @@
-! SPDX-Identifer: MIT
+! SPDX-Identifier: MIT
 
 #:include "common.fypp"
 #:set RANKS = range(1, MAXRANK + 1)
@@ -68,59 +68,94 @@
 !>
 !> 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_wrapper
     implicit none
     private
 
-    public :: save_npy, load_npy
+    public :: load_npy, save_npy, load_npz, save_npz
 
+    character(len=*), parameter :: &
+        type_iint8 = "<i1", type_iint16 = "<i2", type_iint32 = "<i4", type_iint64 = "<i8", &
+        type_rsp = "<f4", type_rdp = "<f8", type_rxdp = "<f10", type_rqp = "<f16", &
+        type_csp = "<c8", type_cdp = "<c16", type_cxdp = "<c20", type_cqp = "<c32", &
+        nl = achar(10), magic_number = char(int(z"93")), magic_string = "NUMPY"
+
+    !> 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_arrays(filename, arrays, iostat, iomsg)
             character(len=*), intent(in) :: filename
-            ${t1}$, intent(in) :: array${ranksuffix(rank)}$
+            type(t_array_wrapper), allocatable, intent(out) :: arrays(:)
             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_arrays(filename, arrays, compressed, iostat, iomsg)
             character(len=*), intent(in) :: filename
-            ${t1}$, allocatable, intent(out) :: array${ranksuffix(rank)}$
+            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
             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 = "<i1", type_iint16 = "<i2", type_iint32 = "<i4", type_iint64 = "<i8", &
-        type_rsp = "<f4", type_rdp = "<f8", type_rxdp = "<f10", type_rqp = "<f16", &
-        type_csp = "<c8", type_cdp = "<c16", type_cxdp = "<c20", type_cqp = "<c32"
-
-    character(len=*), parameter :: &
-        & magic_number = char(int(z"93")), &
-        & magic_string = "NUMPY"
-
+        end
+    end interface
 
-end module stdlib_io_npy
+    interface allocate_array_from_shape
+        #:for k1, t1 in KINDS_TYPES
+            #:for rank in RANKS
+                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.
+                    integer, intent(in) :: vshape(:)
+                    !> Status of allocate.
+                    integer, intent(out) :: stat
+                end
+            #:endfor
+        #:endfor
+    end interface
+end

src/stdlib_io_npy_load.fypp → 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_npy) 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
@@ -54,7 +57,7 @@ contains
                 exit catch
             end if
 
-            call allocator(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))
@@ -69,38 +72,192 @@ 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
         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
+    #:for k1, t1 in KINDS_TYPES
+        #:for rank in RANKS
+            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
+
+                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_arrays(filename, arrays, iostat, iomsg)
+        character(len=*), intent(in) :: filename
+        type(t_array_wrapper), allocatable, intent(out) :: arrays(:)
+        integer, intent(out), optional :: iostat
+        character(len=:), allocatable, intent(out), optional :: iomsg
+
+        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_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg)
+        else
+            call identify_unzip_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
+
+    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
+        character(len=:), allocatable, intent(out) :: msg
+
+        integer :: i, io
+        integer, allocatable :: vshape(:)
+        character(len=:), allocatable :: this_type
+
+        allocate (arrays(size(unzipped_bundle%files)))
+
+        do i = 1, size(unzipped_bundle%files)
+            open (newunit=io, status='scratch', form='unformatted', access='stream', iostat=stat, iomsg=msg)
+            if (stat /= 0) return
+
+            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
 
-        allocate(array( &
-            #:for i in range(rank-1)
-            &    vshape(${i+1}$), &
+            rewind (io)
+            call get_descriptor(io, unzipped_bundle%files(i)%name, this_type, vshape, stat, msg)
+            if (stat /= 0) return
+
+            select case (this_type)
+            #:for k1, t1 in KINDS_TYPES
+            case (type_${t1[0]}$${k1}$)
+                select case (size(vshape))
+                #:for rank in RANKS
+                case (${rank}$)
+                    block
+                        ${t1}$, allocatable :: array${ranksuffix(rank)}$
+
+                        call allocate_array_from_shape(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
-            &    vshape(${rank}$)), &
-            &    stat=stat)
+            case default
+                stat = 1; msg = 'Unsupported array type: '//this_type//'.'; return
+            end select
 
-    end subroutine allocator
+            close (io, status='delete')
+            if (stat /= 0) return
+        end do
+    end
 
-    end subroutine load_npy_${t1[0]}$${k1}$_${rank}$
-  #:endfor
-#:endfor
+    !> Open file and try to identify the cause of the error that occurred during unzip.
+    subroutine identify_unzip_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
+
+    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)
@@ -125,7 +282,7 @@ contains
 
         ! stat should be zero if no error occurred
         stat = 0
-        
+
         read(io, iostat=stat) header
         if (stat /= 0) return
 
@@ -169,7 +326,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
@@ -215,7 +372,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.
@@ -368,7 +525,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)
@@ -428,7 +585,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)
@@ -460,7 +617,7 @@ contains
                 exit
             end if
         end do
-    end subroutine next_token
+    end
 
     !> Tokenize input string
     subroutine get_token(input, pos, token)
@@ -532,8 +689,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

src/stdlib_io_np_save.fypp

@@ -0,0 +1,154 @@
+! 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 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_arrays(filename, arrays, compressed, iostat, iomsg)
+        character(len=*), intent(in) :: filename
+        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
+        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

src/stdlib_io_zip.f90

@@ -0,0 +1,135 @@
+module stdlib_io_zip
+    use stdlib_io_minizip
+    use iso_c_binding, only: c_ptr, c_associated, c_int, c_long, c_char, c_null_char, c_null_ptr
+    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
+        procedure unzip_to_bundle
+    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
+
+    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
+        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 = 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)//'.'
+            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

test/CMakeLists.txt

@@ -4,7 +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::minizip" "test-drive::test-drive")
     add_test(NAME ${name}
              COMMAND $<TARGET_FILE:test_${name}> ${CMAKE_CURRENT_BINARY_DIR}
              WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})

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)

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': '<f8', 'fortran_order': False, 'shape': (0,), }"//repeat(' ', 60)//char(int(z'0a'))//'PK'// &
+            & char(1)//char(2)//'-'//char(3)//'-'//repeat(char(0), 7)//'!'//char(0)//'6H[s'//char(int(z'80'))// &
+            & repeat(char(0), 3)//char(int(z'80'))//repeat(char(0), 3)//char(9)//repeat(char(0), 11)// &
+            & char(int(z'80'))//char(1)//repeat(char(0), 4)//'arr_0.npyPK'//char(5)//char(6)//repeat(char(0), 4)// &
+            & char(1)//char(0)//char(1)//char(0)//'7'//repeat(char(0), 3)//char(int(z'bb'))//repeat(char(0), 5)
+
+        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) == 1, 'Number of files should be 1')
+        call check(error, bundle%files(1)%name == 'arr_0.npy', "Name of file is '"//bundle%files(1)%name//"', not 'arr_0.npy'")
+    end
+
+    subroutine test_single_file(error)
+        type(error_type), allocatable, intent(out) :: error
+
+        character(len=*), parameter :: filename = 'test_single_file.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)//'&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': '<i8', 'fortran_order': False, 'shape': (3,), }"//repeat(' ', 60)//char(int(z'0a'))// &
+            & char(2)//repeat(char(0), 7)//char(4)//repeat(char(0), 7)//char(8)//repeat(char(0), 7)//'PK'//char(1)//char(2)// &
+            & '-'//char(3)//'-'//repeat(char(0), 7)//'!'//char(0)//'&M'//char(int(z'b0'))//char(int(z'd8'))//char(int(z'98'))// &
+            & repeat(char(0), 3)//char(int(z'98'))//repeat(char(0), 3)//char(9)//repeat(char(0), 11)//char(int(z'80'))//char(1)// &
+            & repeat(char(0), 4)//'arr_0.npyPK'//char(5)//char(6)//repeat(char(0), 4)//char(1)//char(0)//char(1)// &
+            & char(0)//'7'//repeat(char(0), 3)//char(int(z'd3'))//repeat(char(0), 5)
+
+        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) == 1, 'Number of files should be 1')
+        call check(error, bundle%files(1)%name == 'arr_0.npy', "Name of file is '"//bundle%files(1)%name//"', not 'arr_0.npy'")
+    end
+
+    subroutine test_two_files(error)
+        type(error_type), allocatable, intent(out) :: error
+
+        character(len=*), parameter :: filename = 'test_two_files.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)//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': '<i8', 'fortran_order': False, 'shape': (2, 2), }"//repeat(' ', 58)//char(int(z'0a'))//char(1)// &
+            & repeat(char(0), 7)//char(2)//repeat(char(0), 7)//char(3)//repeat(char(0), 7)//char(4)//repeat(char(0), 7)//'PK'// &
+            & char(3)//char(4)//'-'//repeat(char(0), 7)//'!'//char(0)//char(int(z'f0'))//'zM?'//repeat(char(int(z'ff')), 8)// &
+            & char(9)//char(0)//char(int(z'14'))//char(0)//'arr_1.npy'//char(1)//char(0)//char(int(z'10'))//char(0)// &
+            & char(int(z'90'))//repeat(char(0), 7)//char(int(z'90'))//repeat(char(0), 7)//char(int(z'93'))//'NUMPY'//char(1)// &
+            & char(0)//'v'//char(0)//"{'descr': '<f8', 'fortran_order': False, 'shape': (2,), }"//repeat(' ', 60)// &
+            & char(int(z'0a'))//'333333'//char(int(z'f3'))//'?333333'//char(int(z'0b'))//'@PK'//char(1)//char(2)//'-'// &
+            & char(3)//'-'//repeat(char(0), 7)//'!'//char(0)//char(int(z'a0'))//'DK['//char(int(z'a0'))//repeat(char(0), 3)// &
+            & char(int(z'a0'))//repeat(char(0), 3)//char(9)//repeat(char(0), 11)//char(int(z'80'))//char(1)//repeat(char(0), 4)// &
+            & 'arr_0.npyPK'//char(1)//char(2)//'-'//char(3)//'-'//repeat(char(0), 7)//'!'//char(0)//char(int(z'f0'))//'zM?'// &
+            & char(int(z'90'))//repeat(char(0), 3)//char(int(z'90'))//repeat(char(0), 3)//char(9)//repeat(char(0), 11)// &
+            & char(int(z'80'))//char(1)//char(int(z'db'))//repeat(char(0), 3)//'arr_1.npyPK'//char(5)//char(6)// &
+            & repeat(char(0), 4)//char(2)//char(0)//char(2)//char(0)//'n'//repeat(char(0), 3)//char(int(z'a6'))//char(1)// &
+            & repeat(char(0), 4)
+
+        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) == 2, 'Number of files should be 2')
+        call check(error, bundle%files(1)%name == 'arr_0.npy', "Name of file is '"//bundle%files(1)%name//"', not 'arr_0.npy'")
+        call check(error, bundle%files(2)%name == 'arr_1.npy', "Name of file is '"//bundle%files(2)%name//"', not 'arr_1.npy'")
+    end
+
+    subroutine delete_file(filename)
+        character(len=*), intent(in) :: filename
+
+        integer :: io
+
+        open (newunit=io, file=filename)
+        close (io, status='delete')
+    end
+end
+
+program tester
+    use, intrinsic :: iso_fortran_env, only: error_unit
+    use testdrive, only: run_testsuite, new_testsuite, testsuite_type
+    use test_zip, only: collect_np
+    implicit none
+
+    integer :: stat, is
+    type(testsuite_type), allocatable :: testsuites(:)
+    character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+    stat = 0
+
+    testsuites = [ &
+                 new_testsuite('zip', collect_np) &
+                 ]
+
+    do is = 1, size(testsuites)
+        write (error_unit, fmt) 'Testing:', testsuites(is)%name
+        call run_testsuite(testsuites(is)%collect, error_unit, stat)
+    end do
+
+    if (stat > 0) then
+        write (error_unit, '(i0, 1x, a)') stat, 'test(s) failed!'
+        error stop
+    end if
+end program

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, &

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

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, &