From c74a30e04a2a0772877cc74cd480c33b1bf01310 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 00:01:40 +0530 Subject: [PATCH 001/146] Format windows ci file --- .github/workflows/ci_windows.yml | 129 ++++++++++++++++--------------- 1 file changed, 65 insertions(+), 64 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 27d49f6c5..85dfea77d 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -3,7 +3,7 @@ name: CI_windows on: [push, pull_request] env: - CTEST_TIME_TIMEOUT: "5" # some failures hang forever + CTEST_TIME_TIMEOUT: "5" # some failures hang forever CMAKE_GENERATOR: Ninja jobs: @@ -12,79 +12,80 @@ jobs: strategy: fail-fast: false matrix: - include: [ - { msystem: MSYS, arch: x86_64 }, - { msystem: MINGW64, arch: x86_64 }, - { msystem: MINGW32, arch: i686 } - ] + include: + [ + { msystem: MSYS, arch: x86_64 }, + { msystem: MINGW64, arch: x86_64 }, + { msystem: MINGW32, arch: i686 }, + ] defaults: run: shell: msys2 {0} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v2 - - name: Setup MinGW native environment - uses: msys2/setup-msys2@v2 - if: contains(matrix.msystem, 'MINGW') - with: - msystem: ${{ matrix.msystem }} - update: false - install: >- - git - 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 }}-cmake - mingw-w64-${{ matrix.arch }}-ninja + - name: Setup MinGW native environment + uses: msys2/setup-msys2@v2 + if: contains(matrix.msystem, 'MINGW') + with: + msystem: ${{ matrix.msystem }} + update: false + install: >- + git + 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 }}-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: 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 + - name: Install fypp + run: pip install fypp - - run: >- - PATH=$PATH:/mingw64/bin/ cmake - -Wdev - -B build - -DCMAKE_BUILD_TYPE=Debug - -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" - -DCMAKE_MAXIMUM_RANK:String=4 - -DCMAKE_INSTALL_PREFIX=$PWD/_dist - env: - FC: gfortran - CC: gcc - CXX: g++ + - run: >- + PATH=$PATH:/mingw64/bin/ cmake + -Wdev + -B build + -DCMAKE_BUILD_TYPE=Debug + -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" + -DCMAKE_MAXIMUM_RANK:String=4 + -DCMAKE_INSTALL_PREFIX=$PWD/_dist + env: + FC: gfortran + CC: gcc + CXX: g++ - - name: CMake build - run: PATH=$PATH:/mingw64/bin/ cmake --build build --parallel + - name: CMake build + run: PATH=$PATH:/mingw64/bin/ cmake --build build --parallel - - name: catch build fail - run: PATH=$PATH:/mingw64/bin/ cmake --build build --verbose --parallel 1 - if: failure() + - name: catch build fail + run: PATH=$PATH:/mingw64/bin/ cmake --build build --verbose --parallel 1 + if: failure() - - name: CTest - run: PATH=$PATH:/mingw64/bin/ ctest --test-dir build --output-on-failure --parallel -V -LE quadruple_precision + - name: CTest + run: PATH=$PATH:/mingw64/bin/ ctest --test-dir build --output-on-failure --parallel -V -LE quadruple_precision - - uses: actions/upload-artifact@v1 - if: failure() - with: - name: WindowsCMakeTestlog - path: build/Testing/Temporary/LastTest.log + - uses: actions/upload-artifact@v1 + if: failure() + with: + name: WindowsCMakeTestlog + path: build/Testing/Temporary/LastTest.log - - name: Install project - run: PATH=$PATH:/mingw64/bin/ cmake --install build + - name: Install project + run: PATH=$PATH:/mingw64/bin/ cmake --install build From 39df36bfd485fd22a76db95e29eeea4a40c91457 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 00:03:12 +0530 Subject: [PATCH 002/146] Install fypp from msys2 package, clean up file --- .github/workflows/ci_windows.yml | 24 ++---------------------- 1 file changed, 2 insertions(+), 22 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 85dfea77d..fee1d0d02 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -24,9 +24,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,29 +34,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 - - run: >- PATH=$PATH:/mingw64/bin/ cmake -Wdev From ca8fc47ee7267c44085a33f9b3fb7200b5b99d9a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 00:03:25 +0530 Subject: [PATCH 003/146] Only run on push --- .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 fee1d0d02..a7496d5b7 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -1,6 +1,6 @@ name: CI_windows -on: [push, pull_request] +on: push env: CTEST_TIME_TIMEOUT: "5" # some failures hang forever From abcd256ae6815c08c456de055487a16fa43c71d9 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 00:12:45 +0530 Subject: [PATCH 004/146] Clean up CI, run all on push only --- .github/PULL_REQUEST_TEMPLATE.md | 4 -- .github/workflows/CI.yml | 100 +++++++++++++-------------- .github/workflows/PR-review.yml | 17 ----- .github/workflows/doc-deployment.yml | 66 ------------------ .github/workflows/fpm-deployment.yml | 13 ++-- 5 files changed, 56 insertions(+), 144 deletions(-) delete mode 100644 .github/PULL_REQUEST_TEMPLATE.md delete mode 100644 .github/workflows/PR-review.yml delete mode 100644 .github/workflows/doc-deployment.yml diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md deleted file mode 100644 index fc7101e17..000000000 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ /dev/null @@ -1,4 +0,0 @@ - diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 6988259d3..55512ffa8 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -1,12 +1,12 @@ name: CI -on: [push, pull_request] +on: push env: CMAKE_BUILD_PARALLEL_LEVEL: "2" # 2 cores on each GHA VM, enable parallel builds CTEST_OUTPUT_ON_FAILURE: "ON" # This way we don't need a flag to ctest CTEST_PARALLEL_LEVEL: "2" - CTEST_TIME_TIMEOUT: "5" # some failures hang forever + CTEST_TIME_TIMEOUT: "5" # some failures hang forever HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker HOMEBREW_NO_AUTO_UPDATE: "ON" HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" @@ -21,71 +21,71 @@ jobs: matrix: os: [ubuntu-latest, macos-12] toolchain: - - {compiler: gcc, version: 10} - - {compiler: gcc, version: 11} - - {compiler: gcc, version: 12} - - {compiler: gcc, version: 13} - - {compiler: intel, version: '2024.1'} - - {compiler: intel-classic, version: '2021.9'} + - { compiler: gcc, version: 10 } + - { compiler: gcc, version: 11 } + - { compiler: gcc, version: 12 } + - { compiler: gcc, version: 13 } + - { compiler: intel, version: "2024.1" } + - { compiler: intel-classic, version: "2021.9" } build: [cmake] include: - os: ubuntu-latest build: cmake-inline toolchain: - - {compiler: gcc, version: 10} + - { compiler: gcc, version: 10 } exclude: - os: macos-12 - toolchain: {compiler: intel, version: '2024.1'} + toolchain: { compiler: intel, version: "2024.1" } - os: macos-12 - toolchain: {compiler: gcc, version: 13} + toolchain: { compiler: gcc, version: 13 } env: BUILD_DIR: ${{ matrix.build == 'cmake' && 'build' || '.' }} steps: - - name: Checkout code - uses: actions/checkout@v4 + - name: Checkout code + uses: actions/checkout@v4 - - name: Set up Python 3.x - uses: actions/setup-python@v5 # Use pip to install latest CMake, & FORD/Jin2For, etc. - with: - python-version: 3.x + - name: Set up Python 3.x + uses: actions/setup-python@v5 # Use pip to install latest CMake, & FORD/Jin2For, etc. + with: + python-version: 3.x - - name: Install fypp - run: pip install --upgrade fypp ninja + - name: Install fypp + run: pip install --upgrade fypp ninja - - name: Setup Fortran compiler - uses: fortran-lang/setup-fortran@v1.6.1 - id: setup-fortran - with: - compiler: ${{ matrix.toolchain.compiler }} - version: ${{ matrix.toolchain.version }} + - name: Setup Fortran compiler + uses: fortran-lang/setup-fortran@v1.6.1 + id: setup-fortran + with: + compiler: ${{ matrix.toolchain.compiler }} + version: ${{ matrix.toolchain.version }} - - name: Configure with CMake - if: ${{ contains(matrix.build, 'cmake') }} - run: >- - cmake -Wdev -G Ninja - -DCMAKE_BUILD_TYPE=Release - -DCMAKE_MAXIMUM_RANK:String=4 - -DCMAKE_INSTALL_PREFIX=$PWD/_dist - -S . -B ${{ env.BUILD_DIR }} + - name: Configure with CMake + if: ${{ contains(matrix.build, 'cmake') }} + run: >- + cmake -Wdev -G Ninja + -DCMAKE_BUILD_TYPE=Release + -DCMAKE_MAXIMUM_RANK:String=4 + -DCMAKE_INSTALL_PREFIX=$PWD/_dist + -S . -B ${{ env.BUILD_DIR }} - - name: Build and compile - if: ${{ contains(matrix.build, 'cmake') }} - run: cmake --build ${{ env.BUILD_DIR }} --parallel + - name: Build and compile + if: ${{ contains(matrix.build, 'cmake') }} + run: cmake --build ${{ env.BUILD_DIR }} --parallel - - name: catch build fail - run: cmake --build ${{ env.BUILD_DIR }} --verbose --parallel 1 - if: ${{ failure() && contains(matrix.build, 'cmake') }} + - name: catch build fail + run: cmake --build ${{ env.BUILD_DIR }} --verbose --parallel 1 + if: ${{ failure() && contains(matrix.build, 'cmake') }} - - name: test - if: ${{ contains(matrix.build, 'cmake') }} - run: >- - ctest - --test-dir ${{ env.BUILD_DIR }} - --parallel - --output-on-failure - --no-tests=error + - name: test + if: ${{ contains(matrix.build, 'cmake') }} + run: >- + ctest + --test-dir ${{ env.BUILD_DIR }} + --parallel + --output-on-failure + --no-tests=error - - name: Install project - if: ${{ contains(matrix.build, 'cmake') }} - run: cmake --install ${{ env.BUILD_DIR }} + - name: Install project + if: ${{ contains(matrix.build, 'cmake') }} + run: cmake --install ${{ env.BUILD_DIR }} diff --git a/.github/workflows/PR-review.yml b/.github/workflows/PR-review.yml deleted file mode 100644 index c16d0ee54..000000000 --- a/.github/workflows/PR-review.yml +++ /dev/null @@ -1,17 +0,0 @@ -name: PR-Review -on: [pull_request] -jobs: - misspell: - name: review-dog / misspell - runs-on: ubuntu-latest - steps: - - name: Check out code. - uses: actions/checkout@v2 - - name: misspell - uses: reviewdog/action-misspell@v1 - with: - github_token: ${{ secrets.GITHUB_TOKEN }} - locale: "US" - reporter: github-pr-review - level: warning - ignore: colour diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml deleted file mode 100644 index d48149407..000000000 --- a/.github/workflows/doc-deployment.yml +++ /dev/null @@ -1,66 +0,0 @@ -name: Build and Deploy Documents - -on: [push, pull_request] - -env: - LANG: "en_US.UTF-8" - LC_ALL: "en_US.UTF-8" - PIP_DISABLE_PIP_VERSION_CHECK: "ON" - PIP_NO_CLEAN: "ON" - PIP_PREFER_BINARY: "ON" - TZ: "UTC" - FORD_FILE: "API-doc-FORD-file.md" - -jobs: - Build-API-Docs: - runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v2 - - uses: actions/setup-python@v1 - with: - python-version: '3.x' - - - name: Install dependencies - run: | - pip install -v ford==7.0.5 - pip install fypp - python --version - ford --version - fypp --version - - - name: Skip graph and search unless deploying - if: github.ref != 'refs/heads/master' && ! startsWith( github.ref, 'refs/tags/' ) - run: | - sed -i 's/^[[:blank:]]*graph: *[Tt]rue/graph: false/' "${FORD_FILE}" - echo "MAYBE_SKIP_SEARCH=--no-search" >> $GITHUB_ENV - - - name: Build Docs - run: | - git fetch --all --tags - ford -r $(git describe --always) --debug ${MAYBE_SKIP_SEARCH} "${FORD_FILE}" - - - name: Upload Documentation - uses: actions/upload-artifact@v2 - with: - name: FORD-API-docs - path: ./API-doc/ - - - name: Broken Link Check - uses: technote-space/broken-link-checker-action@v1 - with: - TARGET: file://${{ github.workspace }}/API-doc/index.html - RECURSIVE: true - ASSIGNEES: ${{ github.actor }} - - - name: Deploy API Docs - uses: peaceiris/actions-gh-pages@v3 - if: github.event_name == 'push' && github.repository == 'fortran-lang/stdlib' && ( startsWith( github.ref, 'refs/tags/' ) || github.ref == 'refs/heads/master' ) - with: - deploy_key: ${{ secrets.ACTIONS_DEPLOY_KEY }} - cname: 'stdlib.fortran-lang.org' - external_repository: fortran-lang/stdlib-docs - publish_dir: ./API-doc - publish_branch: master - allow_empty_commit: true - force_orphan: false - commit_message: "From https://github.com/${{ github.repository }}/commit/${{ github.sha }} ${{ github.ref }}" diff --git a/.github/workflows/fpm-deployment.yml b/.github/workflows/fpm-deployment.yml index 19cf58d8b..b55a37ba2 100644 --- a/.github/workflows/fpm-deployment.yml +++ b/.github/workflows/fpm-deployment.yml @@ -1,6 +1,6 @@ name: fpm-deployment -on: [push, pull_request] +on: push jobs: test: @@ -10,7 +10,7 @@ jobs: matrix: include: - os: ubuntu-latest - toolchain: {compiler: gcc, version: 13} + toolchain: { compiler: gcc, version: 13 } steps: - name: Checkout code @@ -33,19 +33,18 @@ jobs: - name: Setup Fortran Package Manager uses: fortran-lang/setup-fpm@v5 with: - fpm-version: 'v0.10.0' + fpm-version: "v0.10.0" - run: | # Just for deployment: create stdlib-fpm folder python config/fypp_deployment.py --deploy_stdlib_fpm - - run: | # Use fpm gnu ci to check xdp and qp + - run: | # Use fpm gnu ci to check xdp and qp python config/fypp_deployment.py --with_xdp --with_qp fpm test --profile release --flag '-DWITH_XDP -DWITH_QP' - # Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch. + # Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch. - name: Deploy 🚀 uses: JamesIves/github-pages-deploy-action@4.1.5 - if: github.event_name != 'pull_request' with: BRANCH: stdlib-fpm - FOLDER: stdlib-fpm \ No newline at end of file + FOLDER: stdlib-fpm From cf1cfe1fbe73aaf0e19ebc1bf86ec100753b9670 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 00:24:52 +0530 Subject: [PATCH 005/146] Bump to macos and intel-classic version --- .github/workflows/CI.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 55512ffa8..61b7caa98 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -19,14 +19,14 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-latest, macos-12] + os: [ubuntu-latest, macos-13] toolchain: - { compiler: gcc, version: 10 } - { compiler: gcc, version: 11 } - { compiler: gcc, version: 12 } - { compiler: gcc, version: 13 } - { compiler: intel, version: "2024.1" } - - { compiler: intel-classic, version: "2021.9" } + - { compiler: intel-classic, version: "2021.10" } build: [cmake] include: - os: ubuntu-latest @@ -34,9 +34,9 @@ jobs: toolchain: - { compiler: gcc, version: 10 } exclude: - - os: macos-12 + - os: macos-13 toolchain: { compiler: intel, version: "2024.1" } - - os: macos-12 + - os: macos-13 toolchain: { compiler: gcc, version: 13 } env: BUILD_DIR: ${{ matrix.build == 'cmake' && 'build' || '.' }} From 557e65ef67f3b5bbe10663462a16a9e7a6371223 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 00:39:05 +0530 Subject: [PATCH 006/146] Revert to macos-12 --- .github/workflows/CI.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 61b7caa98..95624205f 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -19,7 +19,7 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-latest, macos-13] + os: [ubuntu-latest, macos-12] toolchain: - { compiler: gcc, version: 10 } - { compiler: gcc, version: 11 } @@ -34,9 +34,9 @@ jobs: toolchain: - { compiler: gcc, version: 10 } exclude: - - os: macos-13 + - os: macos-12 toolchain: { compiler: intel, version: "2024.1" } - - os: macos-13 + - os: macos-12 toolchain: { compiler: gcc, version: 13 } env: BUILD_DIR: ${{ matrix.build == 'cmake' && 'build' || '.' }} From cefec394a419284c3a26bd1d184a0d5e04d95863 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 17:07:50 +0530 Subject: [PATCH 007/146] Fix typos --- src/stdlib_io_npy.fypp | 2 +- src/stdlib_io_npy_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_npy.fypp b/src/stdlib_io_npy.fypp index bf69a6a0c..7ae61c81f 100644 --- a/src/stdlib_io_npy.fypp +++ b/src/stdlib_io_npy.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_npy_save.fypp b/src/stdlib_io_npy_save.fypp index 706c3cd90..0bff7309f 100644 --- a/src/stdlib_io_npy_save.fypp +++ b/src/stdlib_io_npy_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 6eb9f3dbdf1293adf14c8a701bf704ec5161b3ed Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 18:51:11 +0530 Subject: [PATCH 008/146] Reorder modules --- example/io/example_loadnpy.f90 | 10 +- example/io/example_savenpy.f90 | 10 +- src/CMakeLists.txt | 9 +- src/stdlib_array.f90 | 68 -- src/stdlib_array.fypp | 120 +++ src/{stdlib_io_npy.fypp => stdlib_io_np.fypp} | 103 ++- src/stdlib_io_np_load.fypp | 693 ++++++++++++++++++ ...o_npy_save.fypp => stdlib_io_np_save.fypp} | 91 ++- src/stdlib_io_npy_load.fypp | 539 -------------- src/stdlib_io_zip.f90 | 38 + test/io/CMakeLists.txt | 2 +- test/io/{test_npy.f90 => test_np.f90} | 18 +- 12 files changed, 998 insertions(+), 703 deletions(-) delete mode 100644 src/stdlib_array.f90 create mode 100644 src/stdlib_array.fypp rename src/{stdlib_io_npy.fypp => stdlib_io_np.fypp} (63%) create mode 100644 src/stdlib_io_np_load.fypp rename src/{stdlib_io_npy_save.fypp => stdlib_io_np_save.fypp} (59%) delete mode 100644 src/stdlib_io_npy_load.fypp create mode 100644 src/stdlib_io_zip.f90 rename test/io/{test_npy.f90 => test_np.f90} (98%) diff --git a/example/io/example_loadnpy.f90 b/example/io/example_loadnpy.f90 index b037312ec..63173a6ea 100644 --- a/example/io/example_loadnpy.f90 +++ b/example/io/example_loadnpy.f90 @@ -1,6 +1,6 @@ program example_loadnpy - use stdlib_io_npy, only: load_npy - implicit none - real, allocatable :: x(:, :) - call load_npy('example.npy', x) -end program example_loadnpy + use stdlib_io_np, only: load_npy + implicit none + real, allocatable :: x(:, :) + call load_npy('example.npy', x) +end diff --git a/example/io/example_savenpy.f90 b/example/io/example_savenpy.f90 index b6929f40f..21bedc108 100644 --- a/example/io/example_savenpy.f90 +++ b/example/io/example_savenpy.f90 @@ -1,6 +1,6 @@ program example_savenpy - use stdlib_io_npy, only: save_npy - implicit none - real :: x(3, 2) = 1 - call save_npy('example.npy', x) -end program example_savenpy + use stdlib_io_np, only: save_npy + implicit none + real :: x(3, 2) = 1 + call save_npy('example.npy', x) +end diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 579b70c72..8c2d61989 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 @@ -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,13 +102,13 @@ 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 stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 + stdlib_io_zip.f90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 stdlib_system.F90 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..0a750c766 --- /dev/null +++ b/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 diff --git a/src/stdlib_io_npy.fypp b/src/stdlib_io_np.fypp similarity index 63% rename from src/stdlib_io_npy.fypp rename to src/stdlib_io_np.fypp index 7ae61c81f..13ec3b8f1 100644 --- a/src/stdlib_io_npy.fypp +++ b/src/stdlib_io_np.fypp @@ -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 = " 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 subroutine save_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor - #:endfor - end interface save_npy + end +#:endfor +#:endfor + 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) + !> 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}$, allocatable, intent(out) :: 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 load_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor - #:endfor - end interface load_npy - - - character(len=*), parameter :: nl = achar(10) - - character(len=*), parameter :: & - type_iint8 = " Version: experimental + !> + !> 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 + 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 + 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 diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp new file mode 100644 index 000000000..ee425e736 --- /dev/null +++ b/src/stdlib_io_np_load.fypp @@ -0,0 +1,693 @@ +! 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 npy files into multidimensional arrays +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 + +#:for k1, t1 in KINDS_TYPES +#:for rank in RANKS + !> Load a ${rank}$-dimensional array from a npy file + module subroutine load_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}$, allocatable, intent(out) :: 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, parameter :: rank = ${rank}$ + + integer :: io, stat + character(len=:), allocatable :: msg + + 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) + 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_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)) + exit catch + end if + + read(io, iostat=stat) array + end block catch + close(io) + + if (present(iostat)) then + iostat = stat + else if (stat /= 0) then + if (allocated(msg)) then + 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) + end +#:endfor +#:endfor + +#: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 + + 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 + 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 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) + !> Unformatted, stream accessed unit + integer, intent(in) :: io + !> Filename for error reporting + character(len=*), intent(in) :: filename + !> Type of data saved in npy file + character(len=:), allocatable, intent(out) :: vtype + !> Shape descriptor of the + integer, allocatable, intent(out) :: vshape(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + integer :: major, header_len, i + character(len=:), allocatable :: dict + character(len=8) :: header + character :: buf(4) + logical :: fortran_order + + ! stat should be zero if no error occurred + stat = 0 + + read(io, iostat=stat) header + if (stat /= 0) return + + call parse_header(header, major, stat, msg) + if (stat /= 0) return + + read(io, iostat=stat) buf(1:merge(4, 2, major > 1)) + if (stat /= 0) return + + if (major > 1) then + header_len = ichar(buf(1)) & + & + ichar(buf(2)) * 256**1 & + & + ichar(buf(3)) * 256**2 & + & + ichar(buf(4)) * 256**3 + else + header_len = ichar(buf(1)) & + & + ichar(buf(2)) * 256**1 + end if + allocate(character(header_len) :: dict, stat=stat) + if (stat /= 0) return + + read(io, iostat=stat) dict + if (stat /= 0) return + + if (dict(header_len:header_len) /= nl) then + stat = 1 + msg = "Descriptor length does not match" + return + end if + + if (scan(dict, achar(0)) > 0) then + stat = 1 + msg = "Nul byte not allowed in descriptor string" + return + end if + + call parse_descriptor(trim(dict(:len(dict)-1)), filename, & + & vtype, fortran_order, vshape, stat, msg) + if (stat /= 0) return + + if (.not.fortran_order) then + vshape = [(vshape(i), i = size(vshape), 1, -1)] + end if + end + + + !> Parse the first eight bytes of the npy header to verify the data + subroutine parse_header(header, major, stat, msg) + !> Header of the binary file + character(len=*), intent(in) :: header + !> Major version of the npy format + integer, intent(out) :: major + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + integer :: minor + + ! stat should be zero if no error occurred + stat = 0 + + if (header(1:1) /= magic_number) then + stat = 1 + msg = "Expected z'93' but got z'"//to_string(ichar(header(1:1)))//"' "//& + & "as first byte" + return + end if + + if (header(2:6) /= magic_string) then + stat = 1 + msg = "Expected identifier '"//magic_string//"'" + return + end if + + major = ichar(header(7:7)) + if (.not.any(major == [1, 2, 3])) then + stat = 1 + msg = "Unsupported format major version number '"//to_string(major)//"'" + return + end if + + minor = ichar(header(8:8)) + if (minor /= 0) then + stat = 1 + msg = "Unsupported format version "// & + & "'"//to_string(major)//"."//to_string(minor)//"'" + return + end if + end + + !> Parse the descriptor in the npy header. This routine implements a minimal + !> non-recursive parser for serialized Python dictionaries. + subroutine parse_descriptor(input, filename, vtype, fortran_order, vshape, stat, msg) + !> Input string to parse as descriptor + character(len=*), intent(in) :: input + !> Filename for error reporting + character(len=*), intent(in) :: filename + !> Type of the data stored, retrieved from field `descr` + character(len=:), allocatable, intent(out) :: vtype + !> Whether the data is in left layout, retrieved from field `fortran_order` + logical, intent(out) :: fortran_order + !> Shape of the stored data, retrieved from field `shape` + integer, allocatable, intent(out) :: vshape(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + enum, bind(c) + enumerator :: invalid, string, lbrace, rbrace, comma, colon, & + lparen, rparen, bool, literal, space + end enum + + type :: token_type + integer :: first, last, kind + end type token_type + + integer :: pos + character(len=:), allocatable :: key + type(token_type) :: token, last + logical :: has_descr, has_shape, has_fortran_order + + has_descr = .false. + has_shape = .false. + has_fortran_order = .false. + pos = 0 + call next_token(input, pos, token, [lbrace], stat, msg) + if (stat /= 0) return + + last = token_type(pos, pos, comma) + do while (pos < len(input)) + call get_token(input, pos, token) + select case(token%kind) + case(space) + continue + case(comma) + if (token%kind == last%kind) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Comma cannot appear at this point") + return + end if + last = token + case(rbrace) + exit + case(string) + if (token%kind == last%kind) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "String cannot appear at this point") + return + end if + last = token + + key = input(token%first+1:token%last-1) + call next_token(input, pos, token, [colon], stat, msg) + if (stat /= 0) return + + if (key == "descr" .and. has_descr & + & .or. key == "fortran_order" .and. has_fortran_order & + & .or. key == "shape" .and. has_shape) then + stat = 1 + msg = make_message(filename, input, last%first, last%last, & + & "Duplicate entry for '"//key//"' found") + return + end if + + select case(key) + case("descr") + call next_token(input, pos, token, [string], stat, msg) + if (stat /= 0) return + + vtype = input(token%first+1:token%last-1) + has_descr = .true. + + case("fortran_order") + call next_token(input, pos, token, [bool], stat, msg) + if (stat /= 0) return + + fortran_order = input(token%first:token%last) == "True" + has_fortran_order = .true. + + case("shape") + call parse_tuple(input, pos, vshape, stat, msg) + + has_shape = .true. + + case default + stat = 1 + msg = make_message(filename, input, last%first, last%last, & + & "Invalid entry '"//key//"' in dictionary encountered") + return + end select + case default + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end select + end do + + if (.not.has_descr) then + stat = 1 + msg = make_message(filename, input, 1, pos, & + & "Dictionary does not contain required entry 'descr'") + end if + + if (.not.has_shape) then + stat = 1 + msg = make_message(filename, input, 1, pos, & + & "Dictionary does not contain required entry 'shape'") + end if + + if (.not.has_fortran_order) then + stat = 1 + msg = make_message(filename, input, 1, pos, & + & "Dictionary does not contain required entry 'fortran_order'") + end if + + contains + + function make_message(filename, input, first, last, message) result(str) + !> Filename for context + character(len=*), intent(in) :: filename + !> Input string to parse + character(len=*), intent(in) :: input + !> Offset in the input + integer, intent(in) :: first, last + !> Error message + character(len=*), intent(in) :: message + !> Final output message + character(len=:), allocatable :: str + + character(len=*), parameter :: nl = new_line('a') + + str = message // nl // & + & " --> " // filename // ":1:" // to_string(first) // "-" // to_string(last) // nl // & + & " |" // nl // & + & "1 | " // input // nl // & + & " |" // repeat(" ", first) // repeat("^", last - first + 1) // nl // & + & " |" + end + + !> Parse a tuple of integers into an array of integers + subroutine parse_tuple(input, pos, tuple, stat, msg) + !> Input string to parse + character(len=*), intent(in) :: input + !> Offset in the input, will be advanced after reading + integer, intent(inout) :: pos + !> Array representing tuple of integers + integer, allocatable, intent(out) :: tuple(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + type(token_type) :: token + integer :: last, itmp + + allocate(tuple(0), stat=stat) + if (stat /= 0) return + + call next_token(input, pos, token, [lparen], stat, msg) + if (stat /= 0) return + + last = comma + do while (pos < len(input)) + call get_token(input, pos, token) + select case(token%kind) + case(space) + continue + case(literal) + if (token%kind == last) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end if + last = token%kind + read(input(token%first:token%last), *, iostat=stat) itmp + if (stat /= 0) then + return + end if + tuple = [tuple, itmp] + case(comma) + if (token%kind == last) then + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end if + last = token%kind + case(rparen) + exit + case default + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + return + end select + end do + end + + !> Get the next allowed token + subroutine next_token(input, pos, token, allowed_token, stat, msg) + !> Input string to parse + character(len=*), intent(in) :: input + !> Current offset in the input string + integer, intent(inout) :: pos + !> Last token parsed + type(token_type), intent(out) :: token + !> Tokens allowed in the current context + integer, intent(in) :: allowed_token(:) + !> Status of operation + integer, intent(out) :: stat + !> Associated error message in case of non-zero status + character(len=:), allocatable, intent(out) :: msg + + stat = pos + do while (pos < len(input)) + call get_token(input, pos, token) + if (token%kind == space) then + continue + else if (any(token%kind == allowed_token)) then + stat = 0 + exit + else + stat = 1 + msg = make_message(filename, input, token%first, token%last, & + & "Invalid token encountered") + exit + end if + end do + end + + !> Tokenize input string + subroutine get_token(input, pos, token) + !> Input strin to tokenize + character(len=*), intent(in) :: input + !> Offset in input string, will be advanced + integer, intent(inout) :: pos + !> Returned token from the next position + type(token_type), intent(out) :: token + + character :: quote + + pos = pos + 1 + select case(input(pos:pos)) + case("""", "'") + quote = input(pos:pos) + token%first = pos + pos = pos + 1 + do while (pos <= len(input)) + if (input(pos:pos) == quote) then + token%last = pos + exit + else + pos = pos + 1 + end if + end do + token%kind = string + case("0", "1", "2", "3", "4", "5", "6", "7", "8", "9") + token%first = pos + do while (pos <= len(input)) + if (.not.any(input(pos:pos) == ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"])) then + pos = pos - 1 + token%last = pos + exit + else + pos = pos + 1 + end if + end do + token%kind = literal + case("T") + if (starts_with(input(pos:), "True")) then + token = token_type(pos, pos+3, bool) + pos = pos + 3 + else + token = token_type(pos, pos, invalid) + end if + case("F") + if (starts_with(input(pos:), "False")) then + token = token_type(pos, pos+4, bool) + pos = pos + 4 + else + token = token_type(pos, pos, invalid) + end if + case("{") + token = token_type(pos, pos, lbrace) + case("}") + token = token_type(pos, pos, rbrace) + case(",") + token = token_type(pos, pos, comma) + case(":") + token = token_type(pos, pos, colon) + case("(") + token = token_type(pos, pos, lparen) + case(")") + token = token_type(pos, pos, rparen) + case(" ", nl) + token = token_type(pos, pos, space) + case default + token = token_type(pos, pos, invalid) + end select + end + end +end diff --git a/src/stdlib_io_npy_save.fypp b/src/stdlib_io_np_save.fypp similarity index 59% rename from src/stdlib_io_npy_save.fypp rename to src/stdlib_io_np_save.fypp index 0bff7309f..9003eb1db 100644 --- a/src/stdlib_io_npy_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -5,14 +5,13 @@ #: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 - use stdlib_error, only : error_stop - use stdlib_strings, only : to_string +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 @@ -22,9 +21,8 @@ contains !> Magic string for npy format character(len=8) :: str - str = magic_number // magic_string // achar(major) // achar(minor) - end function magic_header - + str = magic_number//magic_string//achar(major)//achar(minor) + end !> Generate header for npy format pure function npy_header(vtype, vshape) result(str) @@ -38,20 +36,20 @@ contains integer, parameter :: len_v10 = 8 + 2, len_v20 = 8 + 4, block_size = 64 str = & - "{'descr': '"//vtype//& - "', 'fortran_order': True, 'shape': "//& + "{'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 + 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 + 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 + end !> Write integer as byte string in little endian encoding pure function to_bytes_i4(val) result(str) @@ -60,12 +58,11 @@ contains !> 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 - + 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) @@ -74,10 +71,9 @@ contains !> 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 - + 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) @@ -91,15 +87,14 @@ contains str = "(" do i = 1, size(vshape) str = str//to_string(vshape(i))//", " - enddo + end do str = str//")" - end function shape_str - + end #:for k1, t1 in KINDS_TYPES - #:for rank in RANKS +#:for rank in RANKS !> Save ${rank}$-dimensional array in npy format - module subroutine save_npy_${t1[0]}$${k1}$_${rank}$(filename, array, iostat, iomsg) + 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 @@ -112,14 +107,14 @@ contains character(len=*), parameter :: vtype = type_${t1[0]}$${k1}$ integer :: io, stat - open(newunit=io, file=filename, form="unformatted", access="stream", iostat=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)) + write (io, iostat=stat) npy_header(vtype, shape(array)) end if if (stat == 0) then - write(io, iostat=stat) array + write (io, iostat=stat) array end if - close(io, iostat=stat) + close (io, iostat=stat) if (present(iostat)) then iostat = stat @@ -132,8 +127,28 @@ contains iomsg = "Failed to write array to file '"//filename//"'" end if end if - end subroutine save_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor + end +#:endfor #:endfor -end submodule stdlib_io_npy_save + !> 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 diff --git a/src/stdlib_io_npy_load.fypp b/src/stdlib_io_npy_load.fypp deleted file mode 100644 index 389f24cd2..000000000 --- a/src/stdlib_io_npy_load.fypp +++ /dev/null @@ -1,539 +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 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 - implicit none - -contains - -#:for k1, t1 in KINDS_TYPES - #:for rank in RANKS - !> Load a ${rank}$-dimensional array from a npy file - module subroutine load_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}$, allocatable, intent(out) :: 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, parameter :: rank = ${rank}$ - - integer :: io, stat - character(len=:), allocatable :: msg - - 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) - 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) - if (stat /= 0) then - msg = "Failed to allocate array of type '"//vtype//"' "//& - & "with total size of "//to_string(product(vshape)) - exit catch - end if - - read(io, iostat=stat) array - end block catch - close(io) - - if (present(iostat)) then - iostat = stat - else if (stat /= 0) then - if (allocated(msg)) then - 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 - - !> 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 - integer, intent(out) :: stat - - allocate(array( & - #:for i in range(rank-1) - & vshape(${i+1}$), & - #:endfor - & vshape(${rank}$)), & - & stat=stat) - - end subroutine allocator - - end subroutine load_npy_${t1[0]}$${k1}$_${rank}$ - #:endfor -#:endfor - - - !> Read the npy header from a binary file and retrieve the descriptor string. - subroutine get_descriptor(io, filename, vtype, vshape, stat, msg) - !> Unformatted, stream accessed unit - integer, intent(in) :: io - !> Filename for error reporting - character(len=*), intent(in) :: filename - !> Type of data saved in npy file - character(len=:), allocatable, intent(out) :: vtype - !> Shape descriptor of the - integer, allocatable, intent(out) :: vshape(:) - !> Status of operation - integer, intent(out) :: stat - !> Associated error message in case of non-zero status - character(len=:), allocatable, intent(out) :: msg - - integer :: major, header_len, i - character(len=:), allocatable :: dict - character(len=8) :: header - character :: buf(4) - logical :: fortran_order - - ! stat should be zero if no error occurred - stat = 0 - - read(io, iostat=stat) header - if (stat /= 0) return - - call parse_header(header, major, stat, msg) - if (stat /= 0) return - - read(io, iostat=stat) buf(1:merge(4, 2, major > 1)) - if (stat /= 0) return - - if (major > 1) then - header_len = ichar(buf(1)) & - & + ichar(buf(2)) * 256**1 & - & + ichar(buf(3)) * 256**2 & - & + ichar(buf(4)) * 256**3 - else - header_len = ichar(buf(1)) & - & + ichar(buf(2)) * 256**1 - end if - allocate(character(header_len) :: dict, stat=stat) - if (stat /= 0) return - - read(io, iostat=stat) dict - if (stat /= 0) return - - if (dict(header_len:header_len) /= nl) then - stat = 1 - msg = "Descriptor length does not match" - return - end if - - if (scan(dict, achar(0)) > 0) then - stat = 1 - msg = "Nul byte not allowed in descriptor string" - return - end if - - call parse_descriptor(trim(dict(:len(dict)-1)), filename, & - & vtype, fortran_order, vshape, stat, msg) - if (stat /= 0) return - - if (.not.fortran_order) then - vshape = [(vshape(i), i = size(vshape), 1, -1)] - end if - end subroutine get_descriptor - - - !> Parse the first eight bytes of the npy header to verify the data - subroutine parse_header(header, major, stat, msg) - !> Header of the binary file - character(len=*), intent(in) :: header - !> Major version of the npy format - integer, intent(out) :: major - !> Status of operation - integer, intent(out) :: stat - !> Associated error message in case of non-zero status - character(len=:), allocatable, intent(out) :: msg - - integer :: minor - - ! stat should be zero if no error occurred - stat = 0 - - if (header(1:1) /= magic_number) then - stat = 1 - msg = "Expected z'93' but got z'"//to_string(ichar(header(1:1)))//"' "//& - & "as first byte" - return - end if - - if (header(2:6) /= magic_string) then - stat = 1 - msg = "Expected identifier '"//magic_string//"'" - return - end if - - major = ichar(header(7:7)) - if (.not.any(major == [1, 2, 3])) then - stat = 1 - msg = "Unsupported format major version number '"//to_string(major)//"'" - return - end if - - minor = ichar(header(8:8)) - if (minor /= 0) then - stat = 1 - msg = "Unsupported format version "// & - & "'"//to_string(major)//"."//to_string(minor)//"'" - return - end if - end subroutine parse_header - - !> Parse the descriptor in the npy header. This routine implements a minimal - !> non-recursive parser for serialized Python dictionaries. - subroutine parse_descriptor(input, filename, vtype, fortran_order, vshape, stat, msg) - !> Input string to parse as descriptor - character(len=*), intent(in) :: input - !> Filename for error reporting - character(len=*), intent(in) :: filename - !> Type of the data stored, retrieved from field `descr` - character(len=:), allocatable, intent(out) :: vtype - !> Whether the data is in left layout, retrieved from field `fortran_order` - logical, intent(out) :: fortran_order - !> Shape of the stored data, retrieved from field `shape` - integer, allocatable, intent(out) :: vshape(:) - !> Status of operation - integer, intent(out) :: stat - !> Associated error message in case of non-zero status - character(len=:), allocatable, intent(out) :: msg - - enum, bind(c) - enumerator :: invalid, string, lbrace, rbrace, comma, colon, & - lparen, rparen, bool, literal, space - end enum - - type :: token_type - integer :: first, last, kind - end type token_type - - integer :: pos - character(len=:), allocatable :: key - type(token_type) :: token, last - logical :: has_descr, has_shape, has_fortran_order - - has_descr = .false. - has_shape = .false. - has_fortran_order = .false. - pos = 0 - call next_token(input, pos, token, [lbrace], stat, msg) - if (stat /= 0) return - - last = token_type(pos, pos, comma) - do while (pos < len(input)) - call get_token(input, pos, token) - select case(token%kind) - case(space) - continue - case(comma) - if (token%kind == last%kind) then - stat = 1 - msg = make_message(filename, input, token%first, token%last, & - & "Comma cannot appear at this point") - return - end if - last = token - case(rbrace) - exit - case(string) - if (token%kind == last%kind) then - stat = 1 - msg = make_message(filename, input, token%first, token%last, & - & "String cannot appear at this point") - return - end if - last = token - - key = input(token%first+1:token%last-1) - call next_token(input, pos, token, [colon], stat, msg) - if (stat /= 0) return - - if (key == "descr" .and. has_descr & - & .or. key == "fortran_order" .and. has_fortran_order & - & .or. key == "shape" .and. has_shape) then - stat = 1 - msg = make_message(filename, input, last%first, last%last, & - & "Duplicate entry for '"//key//"' found") - return - end if - - select case(key) - case("descr") - call next_token(input, pos, token, [string], stat, msg) - if (stat /= 0) return - - vtype = input(token%first+1:token%last-1) - has_descr = .true. - - case("fortran_order") - call next_token(input, pos, token, [bool], stat, msg) - if (stat /= 0) return - - fortran_order = input(token%first:token%last) == "True" - has_fortran_order = .true. - - case("shape") - call parse_tuple(input, pos, vshape, stat, msg) - - has_shape = .true. - - case default - stat = 1 - msg = make_message(filename, input, last%first, last%last, & - & "Invalid entry '"//key//"' in dictionary encountered") - return - end select - case default - stat = 1 - msg = make_message(filename, input, token%first, token%last, & - & "Invalid token encountered") - return - end select - end do - - if (.not.has_descr) then - stat = 1 - msg = make_message(filename, input, 1, pos, & - & "Dictionary does not contain required entry 'descr'") - end if - - if (.not.has_shape) then - stat = 1 - msg = make_message(filename, input, 1, pos, & - & "Dictionary does not contain required entry 'shape'") - end if - - if (.not.has_fortran_order) then - stat = 1 - msg = make_message(filename, input, 1, pos, & - & "Dictionary does not contain required entry 'fortran_order'") - end if - - contains - - function make_message(filename, input, first, last, message) result(str) - !> Filename for context - character(len=*), intent(in) :: filename - !> Input string to parse - character(len=*), intent(in) :: input - !> Offset in the input - integer, intent(in) :: first, last - !> Error message - character(len=*), intent(in) :: message - !> Final output message - character(len=:), allocatable :: str - - character(len=*), parameter :: nl = new_line('a') - - str = message // nl // & - & " --> " // filename // ":1:" // to_string(first) // "-" // to_string(last) // nl // & - & " |" // nl // & - & "1 | " // input // nl // & - & " |" // repeat(" ", first) // repeat("^", last - first + 1) // nl // & - & " |" - end function make_message - - !> Parse a tuple of integers into an array of integers - subroutine parse_tuple(input, pos, tuple, stat, msg) - !> Input string to parse - character(len=*), intent(in) :: input - !> Offset in the input, will be advanced after reading - integer, intent(inout) :: pos - !> Array representing tuple of integers - integer, allocatable, intent(out) :: tuple(:) - !> Status of operation - integer, intent(out) :: stat - !> Associated error message in case of non-zero status - character(len=:), allocatable, intent(out) :: msg - - type(token_type) :: token - integer :: last, itmp - - allocate(tuple(0), stat=stat) - if (stat /= 0) return - - call next_token(input, pos, token, [lparen], stat, msg) - if (stat /= 0) return - - last = comma - do while (pos < len(input)) - call get_token(input, pos, token) - select case(token%kind) - case(space) - continue - case(literal) - if (token%kind == last) then - stat = 1 - msg = make_message(filename, input, token%first, token%last, & - & "Invalid token encountered") - return - end if - last = token%kind - read(input(token%first:token%last), *, iostat=stat) itmp - if (stat /= 0) then - return - end if - tuple = [tuple, itmp] - case(comma) - if (token%kind == last) then - stat = 1 - msg = make_message(filename, input, token%first, token%last, & - & "Invalid token encountered") - return - end if - last = token%kind - case(rparen) - exit - case default - stat = 1 - msg = make_message(filename, input, token%first, token%last, & - & "Invalid token encountered") - return - end select - end do - end subroutine parse_tuple - - !> Get the next allowed token - subroutine next_token(input, pos, token, allowed_token, stat, msg) - !> Input string to parse - character(len=*), intent(in) :: input - !> Current offset in the input string - integer, intent(inout) :: pos - !> Last token parsed - type(token_type), intent(out) :: token - !> Tokens allowed in the current context - integer, intent(in) :: allowed_token(:) - !> Status of operation - integer, intent(out) :: stat - !> Associated error message in case of non-zero status - character(len=:), allocatable, intent(out) :: msg - - stat = pos - do while (pos < len(input)) - call get_token(input, pos, token) - if (token%kind == space) then - continue - else if (any(token%kind == allowed_token)) then - stat = 0 - exit - else - stat = 1 - msg = make_message(filename, input, token%first, token%last, & - & "Invalid token encountered") - exit - end if - end do - end subroutine next_token - - !> Tokenize input string - subroutine get_token(input, pos, token) - !> Input strin to tokenize - character(len=*), intent(in) :: input - !> Offset in input string, will be advanced - integer, intent(inout) :: pos - !> Returned token from the next position - type(token_type), intent(out) :: token - - character :: quote - - pos = pos + 1 - select case(input(pos:pos)) - case("""", "'") - quote = input(pos:pos) - token%first = pos - pos = pos + 1 - do while (pos <= len(input)) - if (input(pos:pos) == quote) then - token%last = pos - exit - else - pos = pos + 1 - end if - end do - token%kind = string - case("0", "1", "2", "3", "4", "5", "6", "7", "8", "9") - token%first = pos - do while (pos <= len(input)) - if (.not.any(input(pos:pos) == ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"])) then - pos = pos - 1 - token%last = pos - exit - else - pos = pos + 1 - end if - end do - token%kind = literal - case("T") - if (starts_with(input(pos:), "True")) then - token = token_type(pos, pos+3, bool) - pos = pos + 3 - else - token = token_type(pos, pos, invalid) - end if - case("F") - if (starts_with(input(pos:), "False")) then - token = token_type(pos, pos+4, bool) - pos = pos + 4 - else - token = token_type(pos, pos, invalid) - end if - case("{") - token = token_type(pos, pos, lbrace) - case("}") - token = token_type(pos, pos, rbrace) - case(",") - token = token_type(pos, pos, comma) - case(":") - token = token_type(pos, pos, colon) - case("(") - token = token_type(pos, pos, lparen) - case(")") - token = token_type(pos, pos, rparen) - case(" ", nl) - token = token_type(pos, pos, space) - case default - token = token_type(pos, pos, invalid) - end select - - end subroutine get_token - - end subroutine parse_descriptor - -end submodule stdlib_io_npy_load diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 new file mode 100644 index 000000000..36d7d7bf1 --- /dev/null +++ b/src/stdlib_io_zip.f90 @@ -0,0 +1,38 @@ +module stdlib_io_zip + 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) + + 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 + + if (present(iostat)) iostat = 0 + end +end diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 98794cd88..a96bb2ec4 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -14,6 +14,6 @@ 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(open) ADDTEST(parse_mode) diff --git a/test/io/test_npy.f90 b/test/io/test_np.f90 similarity index 98% rename from test/io/test_npy.f90 rename to test/io/test_np.f90 index c56637030..eb7f85795 100644 --- a/test/io/test_npy.f90 +++ b/test/io/test_np.f90 @@ -1,6 +1,6 @@ module test_npy use stdlib_kinds, only : int8, int16, int32, int64, sp, dp - use stdlib_io_npy, only : save_npy, load_npy + use stdlib_io_np, only : save_npy, load_npy use testdrive, only : new_unittest, unittest_type, error_type, check implicit none private @@ -72,7 +72,7 @@ subroutine test_read_rdp_rank2(error) if (allocated(error)) return call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & - "Precision loss when rereading array") + "Precision loss when rereading array") end subroutine test_read_rdp_rank2 subroutine test_read_rsp_rank2(error) @@ -108,7 +108,7 @@ subroutine test_read_rsp_rank2(error) if (allocated(error)) return call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & - "Precision loss when rereading array") + "Precision loss when rereading array") end subroutine test_read_rsp_rank2 subroutine test_read_rdp_rank3(error) @@ -144,7 +144,7 @@ subroutine test_read_rdp_rank3(error) if (allocated(error)) return call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & - "Precision loss when rereading array") + "Precision loss when rereading array") end subroutine test_read_rdp_rank3 subroutine test_read_rsp_rank1(error) @@ -180,7 +180,7 @@ subroutine test_read_rsp_rank1(error) if (allocated(error)) return call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & - "Precision loss when rereading array") + "Precision loss when rereading array") end subroutine test_read_rsp_rank1 subroutine test_write_rdp_rank2(error) @@ -208,7 +208,7 @@ subroutine test_write_rdp_rank2(error) if (allocated(error)) return call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & - "Precision loss when rereading array") + "Precision loss when rereading array") end subroutine test_write_rdp_rank2 subroutine test_write_rsp_rank2(error) @@ -236,7 +236,7 @@ subroutine test_write_rsp_rank2(error) if (allocated(error)) return call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & - "Precision loss when rereading array") + "Precision loss when rereading array") end subroutine test_write_rsp_rank2 subroutine test_write_int16_rank4(error) @@ -263,7 +263,7 @@ subroutine test_write_int16_rank4(error) if (allocated(error)) return call check(error, all(abs(output - input) == 0), & - "Precision loss when rereading array") + "Precision loss when rereading array") end subroutine test_write_int16_rank4 subroutine test_invalid_magic_number(error) @@ -677,4 +677,4 @@ program tester write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" error stop end if -end program +end From f556f18f346372f325864bdc6b04fb7a445a5bd6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 21:43:14 +0530 Subject: [PATCH 009/146] Rename argument to avoid name clash --- src/stdlib_array.fypp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 0a750c766..d675ec128 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -43,9 +43,9 @@ 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, source_array, stat, msg) class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + ${t1}$, intent(in) :: source_array${ranksuffix(rank)}$ integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg @@ -56,7 +56,7 @@ contains select type (typed_array => wrapper%array) class is (t_array_${t1[0]}$${k1}$_${rank}$) - typed_array%values = array + typed_array%values = source_array class default msg = 'Failed to allocate values.'; stat = 1; return end select From b65f1640196e5f1f5e51779fc89beaffc96ff074 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 3 Aug 2024 23:55:19 +0530 Subject: [PATCH 010/146] Remove whitespace --- src/stdlib_io_np.fypp | 4 ++-- src/stdlib_io_np_save.fypp | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 13ec3b8f1..aef015e93 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -89,7 +89,7 @@ module stdlib_io_np 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) + 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 @@ -106,7 +106,7 @@ module stdlib_io_np 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) + 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 diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 9003eb1db..197325437 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -94,7 +94,7 @@ contains #: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) + 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 From bc3c551a924a85d0a07d4a3092a359542386efd6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 00:44:03 +0530 Subject: [PATCH 011/146] Not use generics but a submodule instead to hopefully make all compilers happy --- src/CMakeLists.txt | 1 + src/stdlib_array.fypp | 42 +++++++++----------------------- src/stdlib_array_allocation.fypp | 41 +++++++++++++++++++++++++++++++ src/stdlib_io_np_load.fypp | 2 +- 4 files changed, 55 insertions(+), 31 deletions(-) create mode 100644 src/stdlib_array_allocation.fypp diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8c2d61989..291092709 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -3,6 +3,7 @@ # Create a list of the files to be preprocessed set(fppFiles stdlib_array.fypp + stdlib_array_allocation.fypp stdlib_ascii.fypp stdlib_bitsets.fypp stdlib_bitsets_64.fypp diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index d675ec128..d07504f42 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -12,18 +12,11 @@ module stdlib_array implicit none private - public :: trueloc, falseloc + public :: allocate_array, trueloc, falseloc - !> Helper class to allocate t_array as an abstract type. + !> Wraps a polymorphic array to help with its allocation. 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 @@ -38,31 +31,20 @@ module stdlib_array #:endfor #:endfor -contains - + interface allocate_array #: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, source_array, stat, msg) - class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: source_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 = source_array - class default - msg = 'Failed to allocate values.'; stat = 1; return - end select - end + module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, source_array, stat, msg) + class(t_array_wrapper), intent(out) :: wrapper + ${t1}$, intent(in) :: source_array${ranksuffix(rank)}$ + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + end #:endfor #:endfor + end interface + +contains !> Version: experimental !> diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp new file mode 100644 index 000000000..fc01ec341 --- /dev/null +++ b/src/stdlib_array_allocation.fypp @@ -0,0 +1,41 @@ +! SPDX-Identifier: MIT + +#:include "common.fypp" +#:set RANKS = range(1, MAXRANK + 1) +#:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES + +submodule(stdlib_array) stdlib_array_allocation + implicit none + +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, source_array, stat, msg) + class(t_array_wrapper), intent(out) :: wrapper + ${t1}$, intent(in) :: source_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 + + 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 = source_array + class default + msg = 'Failed to allocate values.'; stat = 1; return + end select + end + +#:endfor +#:endfor +end diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index ee425e736..32c96d5b0 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 allocate_array(arrays(i), 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 9ae364c9875922562ab0fc9d968acd8396a7e9da Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 00:58:54 +0530 Subject: [PATCH 012/146] Only allocate once --- src/stdlib_array_allocation.fypp | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index fc01ec341..98bd652bc 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -23,11 +23,6 @@ contains msg = "Failed to allocate array"; return end if - 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 = source_array From 21eee028e10ae8b39023f4073a28ea17c6065003 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:10:51 +0530 Subject: [PATCH 013/146] Commenting out a bit, it should build --- src/stdlib_array_allocation.fypp | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index 98bd652bc..4d266f9af 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -23,12 +23,12 @@ contains 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 = source_array - class default - msg = 'Failed to allocate values.'; stat = 1; return - end select + ! select type (typed_array => wrapper%array) + ! class is (t_array_${t1[0]}$${k1}$_${rank}$) + ! typed_array%values = source_array + ! class default + ! msg = 'Failed to allocate values.'; stat = 1; return + ! end select end #:endfor From 9aec6d001630049423dbf3abba1f68270a44504b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:21:50 +0530 Subject: [PATCH 014/146] Comment out even more --- src/stdlib_array_allocation.fypp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index 4d266f9af..6620a26c1 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -18,10 +18,10 @@ contains 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 + ! 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}$) From 30e20bf73e14edaf8e1fff2c5fb502a9bebbf05d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:40:55 +0530 Subject: [PATCH 015/146] Comment out the entire thing --- src/stdlib_array_allocation.fypp | 34 ++++++++++++++++---------------- src/stdlib_io_np_load.fypp | 2 +- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index 6620a26c1..763c7d2d5 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -11,25 +11,25 @@ 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, source_array, stat, msg) - class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: source_array${ranksuffix(rank)}$ - integer, intent(out) :: stat - character(len=:), allocatable, intent(out) :: msg + ! !> Allocate an instance of the array within the wrapper. + ! module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, source_array, stat, msg) + ! class(t_array_wrapper), intent(out) :: wrapper + ! ${t1}$, intent(in) :: source_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 + ! ! 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 = source_array - ! class default - ! msg = 'Failed to allocate values.'; stat = 1; return - ! end select - end + ! ! select type (typed_array => wrapper%array) + ! ! class is (t_array_${t1[0]}$${k1}$_${rank}$) + ! ! typed_array%values = source_array + ! ! class default + ! ! msg = 'Failed to allocate values.'; stat = 1; return + ! ! end select + ! end #:endfor #:endfor diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 32c96d5b0..7b90add64 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 allocate_array(arrays(i), array, stat, msg) + ! call allocate_array(arrays(i), 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 f59956b14de90b55eea0e40ef0f048f2f39203f6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:58:17 +0530 Subject: [PATCH 016/146] Revert "Comment out the entire thing" This reverts commit cedebb67f2beeb8596633c6296d548f079029055. --- src/stdlib_array_allocation.fypp | 34 ++++++++++++++++---------------- src/stdlib_io_np_load.fypp | 2 +- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index 763c7d2d5..6620a26c1 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -11,25 +11,25 @@ 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, source_array, stat, msg) - ! class(t_array_wrapper), intent(out) :: wrapper - ! ${t1}$, intent(in) :: source_array${ranksuffix(rank)}$ - ! integer, intent(out) :: stat - ! character(len=:), allocatable, intent(out) :: msg + !> Allocate an instance of the array within the wrapper. + module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, source_array, stat, msg) + class(t_array_wrapper), intent(out) :: wrapper + ${t1}$, intent(in) :: source_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 + ! 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 = source_array - ! ! class default - ! ! msg = 'Failed to allocate values.'; stat = 1; return - ! ! end select - ! end + ! select type (typed_array => wrapper%array) + ! class is (t_array_${t1[0]}$${k1}$_${rank}$) + ! typed_array%values = source_array + ! class default + ! msg = 'Failed to allocate values.'; stat = 1; return + ! end select + end #:endfor #:endfor diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 7b90add64..32c96d5b0 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 allocate_array(arrays(i), array, stat, msg) + call allocate_array(arrays(i), 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 9dfee6f88eaef4f16a7e5be34e62ed52855c230d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:58:20 +0530 Subject: [PATCH 017/146] Revert "Comment out even more" This reverts commit c41b90cfa0c360544dcb0a92200c42c68cb4991b. --- src/stdlib_array_allocation.fypp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index 6620a26c1..4d266f9af 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -18,10 +18,10 @@ contains 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 + 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}$) From d36ef0550d88eb41c870e14998b8ce7ba6b88177 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:58:22 +0530 Subject: [PATCH 018/146] Revert "Commenting out a bit, it should build" This reverts commit 3b6609224d793d87afd3efdbb3b6831059cb82b1. --- src/stdlib_array_allocation.fypp | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index 4d266f9af..98bd652bc 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -23,12 +23,12 @@ contains 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 = source_array - ! class default - ! msg = 'Failed to allocate values.'; stat = 1; return - ! end select + select type (typed_array => wrapper%array) + class is (t_array_${t1[0]}$${k1}$_${rank}$) + typed_array%values = source_array + class default + msg = 'Failed to allocate values.'; stat = 1; return + end select end #:endfor From 1353893680b53ea50a19726a3d2bf879851bc0b5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:58:23 +0530 Subject: [PATCH 019/146] Revert "Only allocate once" This reverts commit 41211dbc86c4aab6a1ff0097385655fe1b5e9911. --- src/stdlib_array_allocation.fypp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp index 98bd652bc..fc01ec341 100644 --- a/src/stdlib_array_allocation.fypp +++ b/src/stdlib_array_allocation.fypp @@ -23,6 +23,11 @@ contains msg = "Failed to allocate array"; return end if + 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 = source_array From be3603b953a1939cced1c14e65d3f4ac90917de0 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 01:58:23 +0530 Subject: [PATCH 020/146] Revert "Not use generics but a submodule instead to hopefully make all compilers happy" This reverts commit 16ac793261e9ae3d5c70cd6991751ed89f2ebf9a. --- src/CMakeLists.txt | 1 - src/stdlib_array.fypp | 42 +++++++++++++++++++++++--------- src/stdlib_array_allocation.fypp | 41 ------------------------------- src/stdlib_io_np_load.fypp | 2 +- 4 files changed, 31 insertions(+), 55 deletions(-) delete mode 100644 src/stdlib_array_allocation.fypp diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 291092709..8c2d61989 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -3,7 +3,6 @@ # Create a list of the files to be preprocessed set(fppFiles stdlib_array.fypp - stdlib_array_allocation.fypp stdlib_ascii.fypp stdlib_bitsets.fypp stdlib_bitsets_64.fypp diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index d07504f42..d675ec128 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -12,11 +12,18 @@ module stdlib_array implicit none private - public :: allocate_array, trueloc, falseloc + public :: trueloc, falseloc - !> Wraps a polymorphic array to help with its allocation. + !> 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 @@ -31,20 +38,31 @@ module stdlib_array #:endfor #:endfor - interface allocate_array +contains + #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine allocate_array_${t1[0]}$${k1}$_${rank}$(wrapper, source_array, stat, msg) - class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: source_array${ranksuffix(rank)}$ - integer, intent(out) :: stat - character(len=:), allocatable, intent(out) :: msg - end + !> Allocate an instance of the array within the wrapper. + subroutine allocate_array_${t1[0]}$${k1}$_${rank}$ (wrapper, source_array, stat, msg) + class(t_array_wrapper), intent(out) :: wrapper + ${t1}$, intent(in) :: source_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 = source_array + class default + msg = 'Failed to allocate values.'; stat = 1; return + end select + end #:endfor #:endfor - end interface - -contains !> Version: experimental !> diff --git a/src/stdlib_array_allocation.fypp b/src/stdlib_array_allocation.fypp deleted file mode 100644 index fc01ec341..000000000 --- a/src/stdlib_array_allocation.fypp +++ /dev/null @@ -1,41 +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 - -submodule(stdlib_array) stdlib_array_allocation - implicit none - -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, source_array, stat, msg) - class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: source_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 - - 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 = source_array - class default - msg = 'Failed to allocate values.'; stat = 1; return - end select - end - -#:endfor -#:endfor -end diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 32c96d5b0..ee425e736 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 allocate_array(arrays(i), 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 ad534b86c88828b24aa39093790a541726504c2c Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 02:04:30 +0530 Subject: [PATCH 021/146] Just comment out that call --- src/stdlib_io_np_load.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index ee425e736..c28a80cab 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(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 7ad213bc9567712dff88bed6f90e85f0f954f4e7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 02:28:18 +0530 Subject: [PATCH 022/146] Comment out the generics --- src/stdlib_array.fypp | 39 +++------------------------------------ 1 file changed, 3 insertions(+), 36 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index d675ec128..4b30a649b 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -18,51 +18,18 @@ module stdlib_array 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, source_array, stat, msg) - class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: source_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 = source_array - class default - msg = 'Failed to allocate values.'; stat = 1; return - end select - end -#:endfor -#:endfor + !> Version: experimental !> From 5ea9739906fffa2177d561d24b32efd9b21357bf Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 16:02:49 +0530 Subject: [PATCH 023/146] Reenable type-bound method --- src/stdlib_array.fypp | 53 ++++++++++++++++++++++++++++++++++++-- src/stdlib_io_np_load.fypp | 2 +- 2 files changed, 52 insertions(+), 3 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 4b30a649b..0bb3661da 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -18,18 +18,67 @@ module stdlib_array type, public :: t_array_wrapper class(t_array), allocatable :: array contains - + procedure :: allocate_array + +#:if 0 +#: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 +#:endif end type type, abstract, public :: t_array character(:), allocatable :: name end type - +#:if 0 +#: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 +#:endif contains + subroutine allocate_array(wrapper, array, stat, msg) + class(t_array_wrapper), intent(out) :: wrapper + class(t_array), intent(in) :: array + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + print *, 'hi' + end +#:if 0 +#: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, source_array, stat, msg) + class(t_array_wrapper), intent(out) :: wrapper + ${t1}$, intent(in) :: source_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 = source_array + class default + msg = 'Failed to allocate values.'; stat = 1; return + end select + end +#:endfor +#:endfor +#:endif !> Version: experimental !> diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index c28a80cab..727f80960 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(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 1c19820f6a635a01740682afcd8beeb5823782f0 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 17:41:44 +0530 Subject: [PATCH 024/146] Remove msys, re-enable both push and pull_request and comment out method again --- .github/workflows/ci_windows.yml | 10 +++------- src/stdlib_io_np_load.fypp | 2 +- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index a7496d5b7..57dcef43c 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -1,6 +1,6 @@ name: CI_windows -on: push +on: [push, pull_request] env: CTEST_TIME_TIMEOUT: "5" # some failures hang forever @@ -13,18 +13,14 @@ jobs: fail-fast: false matrix: include: - [ - { msystem: MSYS, arch: x86_64 }, - { msystem: MINGW64, arch: x86_64 }, - { msystem: MINGW32, arch: i686 }, - ] + [{ msystem: MINGW64, arch: x86_64 }, { msystem: MINGW32, arch: i686 }] defaults: run: shell: msys2 {0} steps: - uses: actions/checkout@v2 - - name: Setup environment + - name: Setup MinGW native environment uses: msys2/setup-msys2@v2 with: msystem: ${{ matrix.msystem }} diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 727f80960..7397b5368 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(stat, msg) + ! call arrays(i)%allocate_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 070fc19c091781a3d821bf48214e69c15f65af19 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 17:46:34 +0530 Subject: [PATCH 025/146] Remove on pull_request otherwise it runs twice --- .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 57dcef43c..e9ef71f96 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -1,6 +1,6 @@ name: CI_windows -on: [push, pull_request] +on: push env: CTEST_TIME_TIMEOUT: "5" # some failures hang forever From 9deca6ce48a8b7df0de81f82f44471cc2c2607de Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 21:16:03 +0530 Subject: [PATCH 026/146] Just inline the process --- src/stdlib_array.fypp | 47 -------------------------------------- src/stdlib_io_np_load.fypp | 9 +++++++- 2 files changed, 8 insertions(+), 48 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 0bb3661da..37fe35ab9 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -17,24 +17,12 @@ module stdlib_array !> Helper class to allocate t_array as an abstract type. type, public :: t_array_wrapper class(t_array), allocatable :: array - contains - procedure :: allocate_array - -#:if 0 -#: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 -#:endif end type type, abstract, public :: t_array character(:), allocatable :: name end type -#:if 0 #:for k1, t1 in KINDS_TYPES #:for rank in RANKS type, extends(t_array), public :: t_array_${t1[0]}$${k1}$_${rank}$ @@ -42,43 +30,8 @@ module stdlib_array end type #:endfor #:endfor -#:endif contains - subroutine allocate_array(wrapper, array, stat, msg) - class(t_array_wrapper), intent(out) :: wrapper - class(t_array), intent(in) :: array - integer, intent(out) :: stat - character(len=:), allocatable, intent(out) :: msg - - print *, 'hi' - end - -#:if 0 -#: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, source_array, stat, msg) - class(t_array_wrapper), intent(out) :: wrapper - ${t1}$, intent(in) :: source_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 = source_array - class default - msg = 'Failed to allocate values.'; stat = 1; return - end select - end -#:endfor -#:endfor -#:endif !> Version: experimental !> diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 7397b5368..00fd96f6e 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -180,12 +180,19 @@ contains & 'with total size of '//to_string(product(vshape)); return end if - ! call arrays(i)%allocate_array(stat, msg) + allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"' "//& & 'with total size of '//to_string(product(vshape)); return end if + select type (typed_array => arrays(i)%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 + arrays(i)%array%name = unzipped_bundle%files(i)%name end block #:endfor From 4195544809bdc7f340670db468467321d85134f6 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 4 Aug 2024 22:00:33 +0530 Subject: [PATCH 027/146] Revert some changes --- example/io/example_loadnpy.f90 | 10 +++++----- example/io/example_savenpy.f90 | 10 +++++----- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/example/io/example_loadnpy.f90 b/example/io/example_loadnpy.f90 index 63173a6ea..bd0decd37 100644 --- a/example/io/example_loadnpy.f90 +++ b/example/io/example_loadnpy.f90 @@ -1,6 +1,6 @@ program example_loadnpy - use stdlib_io_np, only: load_npy - implicit none - real, allocatable :: x(:, :) - call load_npy('example.npy', x) -end + use stdlib_io_np, only: load_npy + implicit none + real, allocatable :: x(:, :) + call load_npy('example.npy', x) + end program example_loadnpy \ No newline at end of file diff --git a/example/io/example_savenpy.f90 b/example/io/example_savenpy.f90 index 21bedc108..da4c5767f 100644 --- a/example/io/example_savenpy.f90 +++ b/example/io/example_savenpy.f90 @@ -1,6 +1,6 @@ program example_savenpy - use stdlib_io_np, only: save_npy - implicit none - real :: x(3, 2) = 1 - call save_npy('example.npy', x) -end + use stdlib_io_np, only: save_npy + implicit none + real :: x(3, 2) = 1 + call save_npy('example.npy', x) + end program example_savenpy \ No newline at end of file From 597721c0bc3fb740de2968f1adb2fed4bb9cac21 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 6 Aug 2024 15:02:12 +0530 Subject: [PATCH 028/146] Add unzip command --- src/stdlib_io_np_load.fypp | 2 +- src/stdlib_io_zip.f90 | 32 ++++++++++++---- test/io/CMakeLists.txt | 1 + test/io/test_zip.f90 | 78 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 105 insertions(+), 8 deletions(-) create mode 100644 test/io/test_zip.f90 diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 00fd96f6e..9646f21e9 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -114,7 +114,7 @@ contains integer :: stat character(len=:), allocatable :: msg - call unzip(filename, unzipped_bundle, stat, msg) + ! call unzip(filename, unzipped_bundle, stat, msg) if (stat == 0) then call load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) else diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 36d7d7bf1..b010167cd 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -7,10 +7,6 @@ module stdlib_io_zip character(*), parameter :: zip_prefix = 'PK'//achar(3)//achar(4) character(*), parameter :: zip_suffix = 'PK'//achar(5)//achar(6) - 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. @@ -27,12 +23,34 @@ module stdlib_io_zip contains - subroutine unzip_to_bundle(filename, bundle, iostat, iomsg) + subroutine unzip(filename, output_dir, iostat, iomsg) character(len=*), intent(in) :: filename - type(t_unzipped_bundle), intent(out) :: bundle + character(len=*), intent(in), optional :: output_dir integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg - if (present(iostat)) iostat = 0 + integer :: exitstat, cmdstat + character(:), allocatable :: cmdmsg + + exitstat = 0; cmdstat = 0 + + ! call execute_command_line('unzip '//filename//' -d '//output_dir, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) + call execute_command_line('unzip '//filename, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) + if (exitstat /= 0 .or. cmdstat /= 0) then + if (present(iostat)) then + if (exitstat /= 0) then + iostat = exitstat + else + iostat = cmdstat + end if + end if + if (present(iomsg)) then + if (allocated(cmdmsg)) then + iomsg = "Error unzipping '"//filename//"'"//": '"//cmdmsg//"'" + else + iomsg = "Error unzipping '"//filename//"'." + end if + end if + end if end end diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index a96bb2ec4..c2de125b1 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -15,5 +15,6 @@ set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) ADDTEST(getline) ADDTEST(np) +ADDTEST(zip) ADDTEST(open) ADDTEST(parse_mode) diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 new file mode 100644 index 000000000..8b6cedbd1 --- /dev/null +++ b/test/io/test_zip.f90 @@ -0,0 +1,78 @@ +module test_zip + use stdlib_io_zip, only : unzip + use testdrive, only : new_unittest, unittest_type, error_type, check + implicit none + private + + public :: collect_zip + +contains + + !> Collect all exported unit tests + subroutine collect_zip(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("npz_file_not_exists", npz_file_not_exists, should_fail=.true.), & + new_unittest("npz_points_to_directory", npz_points_to_directory, should_fail=.true.) & + ] + end + + subroutine npz_file_not_exists(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call unzip("nonexistent.npz", iostat=stat) + call check(error, stat, "Reading of a non-existent npz file should fail.") + end + + subroutine npz_points_to_directory(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(:), allocatable :: msg + + call unzip(".", iostat=stat, iomsg=msg) + print *, msg + call check(error, stat, "An npz file that points towards a directory should fail.") + 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_zip + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("zip", collect_zip) & + ] + + 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 From 60b116edc112f3fa9f8de55a666bd13d85f73cba Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 6 Aug 2024 15:24:51 +0530 Subject: [PATCH 029/146] Allocate cmdmsg --- src/stdlib_io_zip.f90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index b010167cd..9abc779c3 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -30,7 +30,7 @@ subroutine unzip(filename, output_dir, iostat, iomsg) character(len=:), allocatable, intent(out), optional :: iomsg integer :: exitstat, cmdstat - character(:), allocatable :: cmdmsg + character(len=256) :: cmdmsg exitstat = 0; cmdstat = 0 @@ -45,10 +45,10 @@ subroutine unzip(filename, output_dir, iostat, iomsg) end if end if if (present(iomsg)) then - if (allocated(cmdmsg)) then - iomsg = "Error unzipping '"//filename//"'"//": '"//cmdmsg//"'" - else + if (trim(adjustl(cmdmsg)) == '') then iomsg = "Error unzipping '"//filename//"'." + else + iomsg = "Error unzipping '"//filename//"'"//": '"//cmdmsg//"'" end if end if end if From d4e6618de4507fc0514e41a269be4f147caa151a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 6 Aug 2024 16:36:23 +0530 Subject: [PATCH 030/146] Add tests for non-zip and empty zip files --- src/stdlib_io_zip.f90 | 9 ++------- test/io/test_zip.f90 | 37 +++++++++++++++++++++++++++++++++---- 2 files changed, 35 insertions(+), 11 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 9abc779c3..f2fa45e56 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -2,10 +2,7 @@ module stdlib_io_zip 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) + public :: unzip !> Contains extracted raw data from a zip file. type, public :: t_unzipped_bundle @@ -23,9 +20,8 @@ module stdlib_io_zip contains - subroutine unzip(filename, output_dir, iostat, iomsg) + subroutine unzip(filename, iostat, iomsg) character(len=*), intent(in) :: filename - character(len=*), intent(in), optional :: output_dir integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg @@ -34,7 +30,6 @@ subroutine unzip(filename, output_dir, iostat, iomsg) exitstat = 0; cmdstat = 0 - ! call execute_command_line('unzip '//filename//' -d '//output_dir, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) call execute_command_line('unzip '//filename, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) if (exitstat /= 0 .or. cmdstat /= 0) then if (present(iostat)) then diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 8b6cedbd1..97cb4f64e 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -15,7 +15,9 @@ subroutine collect_zip(testsuite) testsuite = [ & new_unittest("npz_file_not_exists", npz_file_not_exists, should_fail=.true.), & - new_unittest("npz_points_to_directory", npz_points_to_directory, should_fail=.true.) & + new_unittest("npz_points_to_directory", npz_points_to_directory, should_fail=.true.), & + new_unittest("npz_is_not_zip", npz_is_not_zip, should_fail=.true.), & + new_unittest("npz_empty_zip", npz_empty_zip, should_fail=.true.) & ] end @@ -32,13 +34,40 @@ subroutine npz_points_to_directory(error) type(error_type), allocatable, intent(out) :: error integer :: stat - character(:), allocatable :: msg - call unzip(".", iostat=stat, iomsg=msg) - print *, msg + call unzip(".", iostat=stat) call check(error, stat, "An npz file that points towards a directory should fail.") end + subroutine npz_is_not_zip(error) + type(error_type), allocatable, intent(out) :: error + + integer :: io, stat + character(*), parameter :: filename = "non_zip_file" + + open(newunit=io, file=filename) + call unzip(filename, iostat=stat) + call check(error, stat, "An npz file that is not a zip file should fail.") + close(io, status="delete") + end + + subroutine npz_empty_zip(error) + type(error_type), allocatable, intent(out) :: error + + integer :: io, stat + character(*), parameter :: filename = "empty.zip" + 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, iostat=stat) + call check(error, stat, "An empty zip file should fail.") + + call delete_file(filename) + end + subroutine delete_file(filename) character(len=*), intent(in) :: filename From 5f6ccb870ab1eab7395980474ba3fd918c8660bc Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 6 Aug 2024 16:48:44 +0530 Subject: [PATCH 031/146] Remove unnecessary code --- src/stdlib_io_np_load.fypp | 64 ++------------------------------------ 1 file changed, 2 insertions(+), 62 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 9646f21e9..74cb928ae 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -9,7 +9,7 @@ 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_io_zip, only: unzip, t_unzipped_bundle, t_unzipped_file use stdlib_array implicit none @@ -115,11 +115,7 @@ contains 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 (stat == 0) call load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) if (present(iostat)) then iostat = stat @@ -210,62 +206,6 @@ contains end do end - !> 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) !> Unformatted, stream accessed unit From 22f5f372a052b5b5ea62752b51851ccc1f83ca5a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 02:32:22 +0530 Subject: [PATCH 032/146] Add list files in zip and add tests --- src/stdlib_io_zip.f90 | 97 +++++++++++++++++++++++++++++++++++++------ test/io/test_zip.f90 | 56 ++++++++++++++++++++++++- 2 files changed, 139 insertions(+), 14 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index f2fa45e56..2d89ce98b 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -2,7 +2,10 @@ module stdlib_io_zip implicit none private - public :: unzip + public :: list_files_in_zip, unzip + + character(*), parameter :: temp_folder = 'temp' + character(*), parameter :: zip_contents_file = temp_folder//'/'//'zip_contents.txt' !> Contains extracted raw data from a zip file. type, public :: t_unzipped_bundle @@ -20,30 +23,100 @@ module stdlib_io_zip contains - subroutine unzip(filename, iostat, iomsg) - character(len=*), intent(in) :: filename - integer, intent(out), optional :: iostat - character(len=:), allocatable, intent(out), optional :: iomsg + subroutine run(command, stat, msg) + character(len=*), intent(in) :: command + integer, intent(out), optional :: stat + character(len=:), allocatable, intent(out), optional :: msg integer :: exitstat, cmdstat character(len=256) :: cmdmsg + if (present(stat)) stat = 0 exitstat = 0; cmdstat = 0 - call execute_command_line('unzip '//filename, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) + call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) if (exitstat /= 0 .or. cmdstat /= 0) then - if (present(iostat)) then + if (present(stat)) then if (exitstat /= 0) then - iostat = exitstat + stat = exitstat else - iostat = cmdstat + stat = cmdstat end if end if + if (present(msg) .and. trim(adjustl(cmdmsg)) /= '') msg = cmdmsg + end if + end + + subroutine list_files_in_zip(filename, stat, msg) + character(len=*), intent(in) :: filename + integer, intent(out), optional :: stat + character(len=:), allocatable, intent(out), optional :: msg + + integer :: run_stat + character(:), allocatable :: err_msg + + if (present(stat)) stat = 0 + run_stat = 0 + + call run('rm -f '//zip_contents_file, run_stat, err_msg) + if (run_stat /= 0) then + if (present(stat)) stat = run_stat + if (present(msg)) then + if (allocated(err_msg)) then + msg = "Error removing file '"//zip_contents_file//"': '"//err_msg//"'" + else + msg = "Error removing file '"//zip_contents_file//"'." + end if + end if + return + end if + + call run('mkdir -p '//temp_folder, run_stat, err_msg) + if (run_stat /= 0) then + if (present(stat)) stat = run_stat + if (present(msg)) then + if (allocated(err_msg)) then + msg = "Error creating folder '"//temp_folder//"': '"//err_msg//"'" + else + msg = "Error creating folder '"//temp_folder//"'." + end if + end if + return + end if + + call run('unzip -l '//trim(filename)//' | sed ''1,3d;$d;$d'' | awk ''{print $4}'' > zip_contents.txt' & + //zip_contents_file, run_stat, err_msg) + if (run_stat /= 0) then + if (present(stat)) stat = run_stat + if (present(msg)) then + if (allocated(err_msg)) then + msg = "Error listing contents of '"//filename//"': '"//err_msg//"'" + else + msg = "Error listing contents of '"//filename//"'." + end if + end if + end if + end + + subroutine unzip(filename, iostat, iomsg) + character(len=*), intent(in) :: filename + integer, intent(out), optional :: iostat + character(len=:), allocatable, intent(out), optional :: iomsg + + integer :: stat + character(:), allocatable :: msg + + if (present(iostat)) iostat = 0 + stat = 0 + + call run('unzip '//filename, stat, msg) + if (stat /= 0) then + if (present(iostat)) iostat = stat if (present(iomsg)) then - if (trim(adjustl(cmdmsg)) == '') then - iomsg = "Error unzipping '"//filename//"'." + if (allocated(msg)) then + iomsg = "Error unzipping '"//filename//"': '"//msg//"'" else - iomsg = "Error unzipping '"//filename//"'"//": '"//cmdmsg//"'" + iomsg = "Error unzipping '"//filename//"'." end if end if end if diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 97cb4f64e..66c83f609 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -1,5 +1,5 @@ module test_zip - use stdlib_io_zip, only : unzip + use stdlib_io_zip use testdrive, only : new_unittest, unittest_type, error_type, check implicit none private @@ -17,7 +17,11 @@ subroutine collect_zip(testsuite) new_unittest("npz_file_not_exists", npz_file_not_exists, should_fail=.true.), & new_unittest("npz_points_to_directory", npz_points_to_directory, should_fail=.true.), & new_unittest("npz_is_not_zip", npz_is_not_zip, should_fail=.true.), & - new_unittest("npz_empty_zip", npz_empty_zip, should_fail=.true.) & + new_unittest("npz_empty_zip", npz_empty_zip, should_fail=.true.), & + new_unittest("npz_list_file_not_exists", npz_list_file_not_exists, should_fail=.true.), & + new_unittest("npz_list_file_is_directory", npz_list_file_is_directory, should_fail=.true.), & + new_unittest("npz_list_file_not_zip", npz_list_file_not_zip, should_fail=.true.), & + new_unittest("npz_list_empty_zip", npz_list_empty_zip, should_fail=.true.) & ] end @@ -68,6 +72,54 @@ subroutine npz_empty_zip(error) call delete_file(filename) end + subroutine npz_list_file_not_exists(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call list_files_in_zip("nonexistent.npz", stat) + call check(error, stat, "Trying to list the contents of a non-existent npz file should fail.") + end + + subroutine npz_list_file_is_directory(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call list_files_in_zip(".", stat) + call check(error, stat, "Listing of contents of a zip file that actually points towards a directory should fail.") + end + + subroutine npz_list_file_not_zip(error) + type(error_type), allocatable, intent(out) :: error + + integer :: io, stat + character(*), parameter :: filename = "non_zip_file" + + open(newunit=io, file=filename) + call list_files_in_zip(filename, stat) + call check(error, stat, "Listing the contents of a non-zip file should fail.") + close(io, status="delete") + end + + subroutine npz_list_empty_zip(error) + type(error_type), allocatable, intent(out) :: error + + integer :: io, stat + character(*), parameter :: filename = "empty.zip" + 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 list_files_in_zip(filename, stat) + call check(error, stat, "Listint the contents of an empty zip file should fail.") + + call delete_file(filename) + end + + subroutine delete_file(filename) character(len=*), intent(in) :: filename From 8d3fee24013f7e2531e1b98ce3db6a662b829364 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 18:31:24 +0530 Subject: [PATCH 033/146] Fix list_files_in_zip and add test for zip file containing an empty file --- src/stdlib_io_zip.f90 | 7 +++--- test/io/test_zip.f90 | 44 +++++++++++++++++++++++++++++++++--- test/io/zip_files/empty.zip | Bin 0 -> 160 bytes 3 files changed, 44 insertions(+), 7 deletions(-) create mode 100644 test/io/zip_files/empty.zip diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 2d89ce98b..dd0db4aed 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -4,8 +4,8 @@ module stdlib_io_zip public :: list_files_in_zip, unzip - character(*), parameter :: temp_folder = 'temp' - character(*), parameter :: zip_contents_file = temp_folder//'/'//'zip_contents.txt' + character(*), parameter :: temp_folder = 'temp/' + character(*), parameter :: zip_contents_file = temp_folder//'zip_contents.txt' !> Contains extracted raw data from a zip file. type, public :: t_unzipped_bundle @@ -84,8 +84,7 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call run('unzip -l '//trim(filename)//' | sed ''1,3d;$d;$d'' | awk ''{print $4}'' > zip_contents.txt' & - //zip_contents_file, run_stat, err_msg) + call run('unzip -l '//filename//' > '//zip_contents_file, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 66c83f609..52c13846f 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -1,11 +1,14 @@ module test_zip use stdlib_io_zip - 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 public :: collect_zip + character(*), parameter :: zip_files_ctest = 'zip_files/' + character(*), parameter :: zip_files_fpm = 'test/io/'//zip_files_ctest + contains !> Collect all exported unit tests @@ -21,7 +24,8 @@ subroutine collect_zip(testsuite) new_unittest("npz_list_file_not_exists", npz_list_file_not_exists, should_fail=.true.), & new_unittest("npz_list_file_is_directory", npz_list_file_is_directory, should_fail=.true.), & new_unittest("npz_list_file_not_zip", npz_list_file_not_zip, should_fail=.true.), & - new_unittest("npz_list_empty_zip", npz_list_empty_zip, should_fail=.true.) & + new_unittest("npz_list_empty_zip", npz_list_empty_zip, should_fail=.true.), & + new_unittest("npz_list_empty_file", npz_list_empty_file, should_fail=.false.) & ] end @@ -114,11 +118,45 @@ subroutine npz_list_empty_zip(error) close (io) call list_files_in_zip(filename, stat) - call check(error, stat, "Listint the contents of an empty zip file should fail.") + call check(error, stat, "Listing the contents of an empty zip file should fail.") call delete_file(filename) end + subroutine npz_list_empty_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(*), parameter :: filename = "empty.zip" + character(:), allocatable :: path + + path = get_path(filename) + if (.not. allocated(path)) then + call test_failed(error, "The file '"//filename//"' could not be found."); return + end if + + call list_files_in_zip(path, stat) + call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") + end + + !> Makes sure that we find the file when running both `ctest` and `fpm test`. + function get_path(file) result(path) + character(*), intent(in) :: file + character(:), allocatable :: path + + character(:), allocatable :: path_to_check + logical :: exists + + path_to_check = zip_files_ctest//file + inquire(file=path_to_check, exist=exists) + if (exists) then + path = path_to_check + else + path_to_check = zip_files_fpm//file + inquire(file=path_to_check, exist=exists) + if (exists) path = path_to_check + end if + end subroutine delete_file(filename) character(len=*), intent(in) :: filename diff --git a/test/io/zip_files/empty.zip b/test/io/zip_files/empty.zip new file mode 100644 index 0000000000000000000000000000000000000000..2227dc4f6c3c71d4356c61bcef3817db31eec774 GIT binary patch literal 160 zcmWIWW@h1H0D+g4?2%vwlwf6$VMxs_D5(q$;bdUebK0B+!lf1542&#a85tN@M1Tqd nycwC~m~j~(0XJ_+BZvt#jum1YhEc3+AVrKo=nbUpK^z7Ecz+fI literal 0 HcmV?d00001 From 0682b8290a2f221b2a31e4d3bf188421f5d2fbc4 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 18:36:17 +0530 Subject: [PATCH 034/146] Add test for zip file containing file empty.txt --- test/io/test_zip.f90 | 19 ++++++++++++++++++- test/io/zip_files/empty_txt.zip | Bin 0 -> 168 bytes 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 test/io/zip_files/empty_txt.zip diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 52c13846f..f565a44bd 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -25,7 +25,8 @@ subroutine collect_zip(testsuite) new_unittest("npz_list_file_is_directory", npz_list_file_is_directory, should_fail=.true.), & new_unittest("npz_list_file_not_zip", npz_list_file_not_zip, should_fail=.true.), & new_unittest("npz_list_empty_zip", npz_list_empty_zip, should_fail=.true.), & - new_unittest("npz_list_empty_file", npz_list_empty_file, should_fail=.false.) & + new_unittest("npz_list_empty_file", npz_list_empty_file), & + new_unittest("npz_list_empty_txt_file", npz_list_empty_txt_file) & ] end @@ -139,6 +140,22 @@ subroutine npz_list_empty_file(error) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end + subroutine npz_list_empty_txt_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(*), parameter :: filename = "empty_txt.zip" + character(:), allocatable :: path + + path = get_path(filename) + if (.not. allocated(path)) then + call test_failed(error, "The file '"//filename//"' could not be found."); return + end if + + call list_files_in_zip(path, stat) + call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file diff --git a/test/io/zip_files/empty_txt.zip b/test/io/zip_files/empty_txt.zip new file mode 100644 index 0000000000000000000000000000000000000000..036186431a12aa1728f84d77778f297cf2892b37 GIT binary patch literal 168 zcmWIWW@h1H0D;s>_DC=TN^mmBFr?-dlvL`KRFs5 Date: Wed, 7 Aug 2024 18:42:01 +0530 Subject: [PATCH 035/146] Use textfile with sth in it --- test/io/test_zip.f90 | 6 +++--- test/io/zip_files/empty_txt.zip | Bin 168 -> 0 bytes test/io/zip_files/textfile.zip | Bin 0 -> 170 bytes 3 files changed, 3 insertions(+), 3 deletions(-) delete mode 100644 test/io/zip_files/empty_txt.zip create mode 100644 test/io/zip_files/textfile.zip diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index f565a44bd..b38c144a3 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -26,7 +26,7 @@ subroutine collect_zip(testsuite) new_unittest("npz_list_file_not_zip", npz_list_file_not_zip, should_fail=.true.), & new_unittest("npz_list_empty_zip", npz_list_empty_zip, should_fail=.true.), & new_unittest("npz_list_empty_file", npz_list_empty_file), & - new_unittest("npz_list_empty_txt_file", npz_list_empty_txt_file) & + new_unittest("npz_list_txt_file", npz_list_txt_file) & ] end @@ -140,11 +140,11 @@ subroutine npz_list_empty_file(error) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end - subroutine npz_list_empty_txt_file(error) + subroutine npz_list_txt_file(error) type(error_type), allocatable, intent(out) :: error integer :: stat - character(*), parameter :: filename = "empty_txt.zip" + character(*), parameter :: filename = "textfile.zip" character(:), allocatable :: path path = get_path(filename) diff --git a/test/io/zip_files/empty_txt.zip b/test/io/zip_files/empty_txt.zip deleted file mode 100644 index 036186431a12aa1728f84d77778f297cf2892b37..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 168 zcmWIWW@h1H0D;s>_DC=TN^mmBFr?-dlvL`KRFs5pPx I8;HXI07R=EhX4Qo literal 0 HcmV?d00001 From 540e8d51330b6d09b9f2a105d41b14fdbedddfe2 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 18:44:56 +0530 Subject: [PATCH 036/146] Add simple npz file --- test/io/test_zip.f90 | 19 ++++++++++++++++++- test/io/zip_files/empty_0.npz | Bin 0 -> 264 bytes 2 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 test/io/zip_files/empty_0.npz diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index b38c144a3..f28187519 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -26,7 +26,8 @@ subroutine collect_zip(testsuite) new_unittest("npz_list_file_not_zip", npz_list_file_not_zip, should_fail=.true.), & new_unittest("npz_list_empty_zip", npz_list_empty_zip, should_fail=.true.), & new_unittest("npz_list_empty_file", npz_list_empty_file), & - new_unittest("npz_list_txt_file", npz_list_txt_file) & + new_unittest("npz_list_txt_file", npz_list_txt_file), & + new_unittest("npz_list_array_empty_0_file", npz_list_array_empty_0_file) & ] end @@ -156,6 +157,22 @@ subroutine npz_list_txt_file(error) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end + subroutine npz_list_array_empty_0_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(*), parameter :: filename = "empty_0.npz" + character(:), allocatable :: path + + path = get_path(filename) + if (.not. allocated(path)) then + call test_failed(error, "The file '"//filename//"' could not be found."); return + end if + + call list_files_in_zip(path, stat) + call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file diff --git a/test/io/zip_files/empty_0.npz b/test/io/zip_files/empty_0.npz new file mode 100644 index 0000000000000000000000000000000000000000..4f02137deaac9d7e91236a4632ee15b61d67561b GIT binary patch literal 264 zcmWIWW@gc4fB;1XGmq%v|4_imAi|JXR1|NZmse29$RNPb096K~C;Nr^21GJ4lrdDR zr=%7q7pYq*sN1AjsOu=Gr{x!w6eZ@x=NF}8(>1*t&3hJlWzjzX;h s1%NBSn~_PE8P)M1w}CJx5W_$NBZvj}N`N;j8%Tf=2+e`?ZV-n70I#Pq`v3p{ literal 0 HcmV?d00001 From 00d3d75be36e00db927c9907aae179faa5d481ab Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 19:01:45 +0530 Subject: [PATCH 037/146] Add unzip msys dependency --- .github/workflows/ci_windows.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index e9ef71f96..4c46eecc1 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -33,6 +33,7 @@ jobs: mingw-w64-${{ matrix.arch }}-python-fypp mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja + unzip - run: >- PATH=$PATH:/mingw64/bin/ cmake From b9d19fc6ff5fd9a883f8838b5e188b5bbd610fbd Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 22:39:39 +0530 Subject: [PATCH 038/146] Try identify error --- src/stdlib_io_zip.f90 | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index dd0db4aed..1ba5d7386 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -58,7 +58,8 @@ subroutine list_files_in_zip(filename, stat, msg) if (present(stat)) stat = 0 run_stat = 0 - call run('rm -f '//zip_contents_file, run_stat, err_msg) + call execute_command_line('echo "Remove old contents file..."') + call run('rm -f '//zip_contents_file//' || echo "Failed to remove old contents file"', run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then @@ -71,7 +72,8 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call run('mkdir -p '//temp_folder, run_stat, err_msg) + call execute_command_line('echo "Creating temp directory..."') + call run('mkdir -p '//temp_folder//' || echo "Failed to create temp directory"', run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then @@ -84,7 +86,8 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call run('unzip -l '//filename//' > '//zip_contents_file, run_stat, err_msg) + call execute_command_line('echo "Listing contents of ZIP file..."') + call run('unzip -l '//filename//' > '//zip_contents_file//' || echo "Failed to list ZIP contents"', run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then From fd33fbfa4bf4089ea32f9aefdad89ee1f455b240 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 22:56:10 +0530 Subject: [PATCH 039/146] Remove / --- 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 1ba5d7386..6619390e1 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -4,8 +4,8 @@ module stdlib_io_zip public :: list_files_in_zip, unzip - character(*), parameter :: temp_folder = 'temp/' - character(*), parameter :: zip_contents_file = temp_folder//'zip_contents.txt' + character(*), parameter :: temp_folder = 'temp' + character(*), parameter :: zip_contents_file = temp_folder//'/zip_contents.txt' !> Contains extracted raw data from a zip file. type, public :: t_unzipped_bundle From 58ab58e2eb1ec5df287b4f2841e89d0fc37428ca Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 7 Aug 2024 23:12:07 +0530 Subject: [PATCH 040/146] Remove prints --- src/stdlib_io_zip.f90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 6619390e1..6eeb4b7e8 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -58,8 +58,7 @@ subroutine list_files_in_zip(filename, stat, msg) if (present(stat)) stat = 0 run_stat = 0 - call execute_command_line('echo "Remove old contents file..."') - call run('rm -f '//zip_contents_file//' || echo "Failed to remove old contents file"', run_stat, err_msg) + call run('rm -f '//zip_contents_file, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then @@ -72,8 +71,7 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call execute_command_line('echo "Creating temp directory..."') - call run('mkdir -p '//temp_folder//' || echo "Failed to create temp directory"', run_stat, err_msg) + call run('mkdir -p '//temp_folder, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then @@ -86,8 +84,7 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call execute_command_line('echo "Listing contents of ZIP file..."') - call run('unzip -l '//filename//' > '//zip_contents_file//' || echo "Failed to list ZIP contents"', run_stat, err_msg) + call run('unzip -l '//filename//' > '//zip_contents_file, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then From 66d959db0cf4f090efb44852de76c4243f52443f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 00:02:23 +0530 Subject: [PATCH 041/146] Try adding shell --- .github/workflows/ci_windows.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 4c46eecc1..44a9afeea 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -57,6 +57,7 @@ jobs: - name: CTest run: PATH=$PATH:/mingw64/bin/ ctest --test-dir build --output-on-failure --parallel -V -LE quadruple_precision + shell: msys2 {0} - uses: actions/upload-artifact@v1 if: failure() From 08abff8bc89f61750cf942bb1bc3cb1ff4be4e17 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 00:08:04 +0530 Subject: [PATCH 042/146] Remove again because it default exists --- .github/workflows/ci_windows.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 44a9afeea..4c46eecc1 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -57,7 +57,6 @@ jobs: - name: CTest run: PATH=$PATH:/mingw64/bin/ ctest --test-dir build --output-on-failure --parallel -V -LE quadruple_precision - shell: msys2 {0} - uses: actions/upload-artifact@v1 if: failure() From aee5712088113da9050e6f1b05aeefe5475c9bde Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 00:51:34 +0530 Subject: [PATCH 043/146] Try adding some script --- src/stdlib_io_zip.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 6eeb4b7e8..b12229667 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -71,7 +71,7 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call run('mkdir -p '//temp_folder, run_stat, err_msg) + call run('if [ ! -d '//temp_folder//' ]; then mkdir '//temp_folder//'; fi', run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then From acab595037cd3abbb571040cf97980b0feb61fb0 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 01:05:30 +0530 Subject: [PATCH 044/146] Use shell script --- src/stdlib_io_zip.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index b12229667..1ecc83e07 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -71,7 +71,7 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call run('if [ ! -d '//temp_folder//' ]; then mkdir '//temp_folder//'; fi', run_stat, err_msg) + call run('sh -c "if [ ! -d '//temp_folder//' ]; then mkdir '//temp_folder//'; fi"', run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then From b0e42cb92ed1f0280d54a456e903b482862e6dfc Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 01:19:48 +0530 Subject: [PATCH 045/146] Try cpp variant --- src/stdlib_io_zip.f90 | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 1ecc83e07..51a7dfc43 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -23,6 +23,15 @@ module stdlib_io_zip contains + logical function exists(filename) + character(len=*), intent(in) :: filename + inquire (file=filename, exist=exists) + +#if defined(__INTEL_COMPILER) + if (.not.exists) inquire (directory=filename, exist=exists) +#endif + end + subroutine run(command, stat, msg) character(len=*), intent(in) :: command integer, intent(out), optional :: stat @@ -71,7 +80,7 @@ subroutine list_files_in_zip(filename, stat, msg) return end if - call run('sh -c "if [ ! -d '//temp_folder//' ]; then mkdir '//temp_folder//'; fi"', run_stat, err_msg) + if (.not. exists(temp_folder)) call run('mkdir '//temp_folder, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then From 95e979d5aea35e7b339f894fd139899cdb209a10 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 19:45:47 +0530 Subject: [PATCH 046/146] Remove list_files --- src/stdlib_io_zip.f90 | 75 ++++++++++++++------------------- test/io/test_zip.f90 | 97 ++++++++++--------------------------------- 2 files changed, 54 insertions(+), 118 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 51a7dfc43..b4c18c078 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -2,10 +2,10 @@ module stdlib_io_zip implicit none private - public :: list_files_in_zip, unzip + public :: unzip character(*), parameter :: temp_folder = 'temp' - character(*), parameter :: zip_contents_file = temp_folder//'/zip_contents.txt' + character(*), parameter :: zip_contents = temp_folder//'/zip_contents' !> Contains extracted raw data from a zip file. type, public :: t_unzipped_bundle @@ -25,10 +25,11 @@ module stdlib_io_zip logical function exists(filename) character(len=*), intent(in) :: filename - inquire (file=filename, exist=exists) + + inquire(file=filename, exist=exists) #if defined(__INTEL_COMPILER) - if (.not.exists) inquire (directory=filename, exist=exists) + if (.not. exists) inquire(directory=filename, exist=exists) #endif end @@ -56,75 +57,61 @@ subroutine run(command, stat, msg) end if end - subroutine list_files_in_zip(filename, stat, msg) + subroutine unzip(filename, outputdir, stat, msg) character(len=*), intent(in) :: filename + character(len=*), intent(in), optional :: outputdir integer, intent(out), optional :: stat character(len=:), allocatable, intent(out), optional :: msg integer :: run_stat character(:), allocatable :: err_msg + character(:), allocatable :: output_dir + + if (present(outputdir)) then + output_dir = outputdir + else + output_dir = zip_contents + end if if (present(stat)) stat = 0 run_stat = 0 - call run('rm -f '//zip_contents_file, run_stat, err_msg) + call run('rm -rf '//zip_contents, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then if (allocated(err_msg)) then - msg = "Error removing file '"//zip_contents_file//"': '"//err_msg//"'" + msg = "Error removing folder '"//zip_contents//"': '"//err_msg//"'" else - msg = "Error removing file '"//zip_contents_file//"'." + msg = "Error removing folder '"//zip_contents//"'." end if end if return end if - if (.not. exists(temp_folder)) call run('mkdir '//temp_folder, run_stat, err_msg) - if (run_stat /= 0) then - if (present(stat)) stat = run_stat - if (present(msg)) then - if (allocated(err_msg)) then - msg = "Error creating folder '"//temp_folder//"': '"//err_msg//"'" - else - msg = "Error creating folder '"//temp_folder//"'." + if (.not. exists(temp_folder)) then + call run('mkdir '//temp_folder, run_stat, err_msg) + if (run_stat /= 0) then + if (present(stat)) stat = run_stat + if (present(msg)) then + if (allocated(err_msg)) then + msg = "Error creating folder '"//temp_folder//"': '"//err_msg//"'" + else + msg = "Error creating folder '"//temp_folder//"'." + end if end if + return end if - return end if - call run('unzip -l '//filename//' > '//zip_contents_file, run_stat, err_msg) + call run('unzip '//filename//' -d '//zip_contents, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then if (allocated(err_msg)) then - msg = "Error listing contents of '"//filename//"': '"//err_msg//"'" - else - msg = "Error listing contents of '"//filename//"'." - end if - end if - end if - end - - subroutine unzip(filename, iostat, iomsg) - character(len=*), intent(in) :: filename - integer, intent(out), optional :: iostat - character(len=:), allocatable, intent(out), optional :: iomsg - - integer :: stat - character(:), allocatable :: msg - - if (present(iostat)) iostat = 0 - stat = 0 - - call run('unzip '//filename, stat, msg) - if (stat /= 0) then - if (present(iostat)) iostat = stat - if (present(iomsg)) then - if (allocated(msg)) then - iomsg = "Error unzipping '"//filename//"': '"//msg//"'" + msg = "Error unzipping '"//filename//"': '"//err_msg//"'" else - iomsg = "Error unzipping '"//filename//"'." + msg = "Error unzipping '"//filename//"'." end if end if end if diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index f28187519..dc8d32450 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -17,98 +17,48 @@ subroutine collect_zip(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("npz_file_not_exists", npz_file_not_exists, should_fail=.true.), & - new_unittest("npz_points_to_directory", npz_points_to_directory, should_fail=.true.), & - new_unittest("npz_is_not_zip", npz_is_not_zip, should_fail=.true.), & - new_unittest("npz_empty_zip", npz_empty_zip, should_fail=.true.), & - new_unittest("npz_list_file_not_exists", npz_list_file_not_exists, should_fail=.true.), & - new_unittest("npz_list_file_is_directory", npz_list_file_is_directory, should_fail=.true.), & - new_unittest("npz_list_file_not_zip", npz_list_file_not_zip, should_fail=.true.), & - new_unittest("npz_list_empty_zip", npz_list_empty_zip, should_fail=.true.), & - new_unittest("npz_list_empty_file", npz_list_empty_file), & - new_unittest("npz_list_txt_file", npz_list_txt_file), & - new_unittest("npz_list_array_empty_0_file", npz_list_array_empty_0_file) & + new_unittest("unzip_file_not_exists", unzip_file_not_exists, should_fail=.true.), & + new_unittest("unzip_points_to_directory", unzip_points_to_directory, should_fail=.true.), & + new_unittest("unzip_is_not_zip", unzip_is_not_zip, should_fail=.true.), & + new_unittest("unzip_empty_zip", unzip_empty_zip, should_fail=.true.), & + new_unittest("unzip_zip_has_empty_file", unzip_zip_has_empty_file), & + new_unittest("unzip_zip_has_txt_file", unzip_zip_has_txt_file), & + new_unittest("unzip_list_array_empty_0_file", unzip_list_array_empty_0_file) & ] end - subroutine npz_file_not_exists(error) + subroutine unzip_file_not_exists(error) type(error_type), allocatable, intent(out) :: error integer :: stat - call unzip("nonexistent.npz", iostat=stat) + call unzip("nonexistent.npz", stat=stat) call check(error, stat, "Reading of a non-existent npz file should fail.") end - subroutine npz_points_to_directory(error) + subroutine unzip_points_to_directory(error) type(error_type), allocatable, intent(out) :: error integer :: stat - call unzip(".", iostat=stat) + call unzip(".", stat=stat) call check(error, stat, "An npz file that points towards a directory should fail.") end - subroutine npz_is_not_zip(error) + subroutine unzip_is_not_zip(error) type(error_type), allocatable, intent(out) :: error integer :: io, stat character(*), parameter :: filename = "non_zip_file" open(newunit=io, file=filename) - call unzip(filename, iostat=stat) + close(io) + call unzip(filename, stat=stat) call check(error, stat, "An npz file that is not a zip file should fail.") - close(io, status="delete") - end - - subroutine npz_empty_zip(error) - type(error_type), allocatable, intent(out) :: error - - integer :: io, stat - character(*), parameter :: filename = "empty.zip" - 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, iostat=stat) - call check(error, stat, "An empty zip file should fail.") - call delete_file(filename) end - subroutine npz_list_file_not_exists(error) - type(error_type), allocatable, intent(out) :: error - - integer :: stat - - call list_files_in_zip("nonexistent.npz", stat) - call check(error, stat, "Trying to list the contents of a non-existent npz file should fail.") - end - - subroutine npz_list_file_is_directory(error) - type(error_type), allocatable, intent(out) :: error - - integer :: stat - - call list_files_in_zip(".", stat) - call check(error, stat, "Listing of contents of a zip file that actually points towards a directory should fail.") - end - - subroutine npz_list_file_not_zip(error) - type(error_type), allocatable, intent(out) :: error - - integer :: io, stat - character(*), parameter :: filename = "non_zip_file" - - open(newunit=io, file=filename) - call list_files_in_zip(filename, stat) - call check(error, stat, "Listing the contents of a non-zip file should fail.") - close(io, status="delete") - end - - subroutine npz_list_empty_zip(error) + subroutine unzip_empty_zip(error) type(error_type), allocatable, intent(out) :: error integer :: io, stat @@ -119,13 +69,13 @@ subroutine npz_list_empty_zip(error) write (io) binary_data close (io) - call list_files_in_zip(filename, stat) - call check(error, stat, "Listing the contents of an empty zip file should fail.") + call unzip(filename, stat=stat) + call check(error, stat, "An empty zip file should fail.") call delete_file(filename) end - subroutine npz_list_empty_file(error) + subroutine unzip_zip_has_empty_file(error) type(error_type), allocatable, intent(out) :: error integer :: stat @@ -137,11 +87,11 @@ subroutine npz_list_empty_file(error) call test_failed(error, "The file '"//filename//"' could not be found."); return end if - call list_files_in_zip(path, stat) + call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end - subroutine npz_list_txt_file(error) + subroutine unzip_zip_has_txt_file(error) type(error_type), allocatable, intent(out) :: error integer :: stat @@ -153,11 +103,11 @@ subroutine npz_list_txt_file(error) call test_failed(error, "The file '"//filename//"' could not be found."); return end if - call list_files_in_zip(path, stat) + call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end - subroutine npz_list_array_empty_0_file(error) + subroutine unzip_list_array_empty_0_file(error) type(error_type), allocatable, intent(out) :: error integer :: stat @@ -169,7 +119,7 @@ subroutine npz_list_array_empty_0_file(error) call test_failed(error, "The file '"//filename//"' could not be found."); return end if - call list_files_in_zip(path, stat) + call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end @@ -203,7 +153,6 @@ subroutine delete_file(filename) end - program tester use, intrinsic :: iso_fortran_env, only : error_unit use testdrive, only : run_testsuite, new_testsuite, testsuite_type From c70317596489c408c527c550294c78ba38497bbe Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 20:07:28 +0530 Subject: [PATCH 047/146] Use fypp --- src/CMakeLists.txt | 2 +- src/{stdlib_io_zip.f90 => stdlib_io_zip.fypp} | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) rename src/{stdlib_io_zip.f90 => stdlib_io_zip.fypp} (98%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8c2d61989..a1d073bb5 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -21,6 +21,7 @@ set(fppFiles stdlib_io_np.fypp stdlib_io_np_load.fypp stdlib_io_np_save.fypp + stdlib_io_zip.fypp stdlib_kinds.fypp stdlib_linalg.fypp stdlib_linalg_diag.fypp @@ -108,7 +109,6 @@ set(SRC stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 - stdlib_io_zip.f90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 stdlib_system.F90 diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.fypp similarity index 98% rename from src/stdlib_io_zip.f90 rename to src/stdlib_io_zip.fypp index b4c18c078..7bf383b05 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.fypp @@ -28,9 +28,9 @@ logical function exists(filename) inquire(file=filename, exist=exists) -#if defined(__INTEL_COMPILER) +#:if defined('__INTEL_COMPILER') if (.not. exists) inquire(directory=filename, exist=exists) -#endif +#:endif end subroutine run(command, stat, msg) From b2f2b95bb1e7620a84dc21b503c4afcc3d4a89b0 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 22:13:50 +0530 Subject: [PATCH 048/146] Revert "Use fypp" This reverts commit 3fcc03bb1edd460f6c641cea3d4e6f1cd394150b. --- src/CMakeLists.txt | 2 +- src/{stdlib_io_zip.fypp => stdlib_io_zip.f90} | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) rename src/{stdlib_io_zip.fypp => stdlib_io_zip.f90} (98%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index a1d073bb5..8c2d61989 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -21,7 +21,6 @@ set(fppFiles stdlib_io_np.fypp stdlib_io_np_load.fypp stdlib_io_np_save.fypp - stdlib_io_zip.fypp stdlib_kinds.fypp stdlib_linalg.fypp stdlib_linalg_diag.fypp @@ -109,6 +108,7 @@ set(SRC stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 + stdlib_io_zip.f90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 stdlib_system.F90 diff --git a/src/stdlib_io_zip.fypp b/src/stdlib_io_zip.f90 similarity index 98% rename from src/stdlib_io_zip.fypp rename to src/stdlib_io_zip.f90 index 7bf383b05..b4c18c078 100644 --- a/src/stdlib_io_zip.fypp +++ b/src/stdlib_io_zip.f90 @@ -28,9 +28,9 @@ logical function exists(filename) inquire(file=filename, exist=exists) -#:if defined('__INTEL_COMPILER') +#if defined(__INTEL_COMPILER) if (.not. exists) inquire(directory=filename, exist=exists) -#:endif +#endif end subroutine run(command, stat, msg) From 37be446549cf9558a0d46d7bd80b1a7fb058df0a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 8 Aug 2024 23:17:28 +0530 Subject: [PATCH 049/146] Add compiler options --- src/CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 8c2d61989..7d766bd11 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -120,6 +120,12 @@ set(SRC ${outPreprocFiles} ) +if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + add_compile_options(-cpp) +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + add_compile_options(-fpp) +endif() + add_library(${PROJECT_NAME} ${SRC}) set_target_properties( From b2489ac496c71cefcb62f54c8305fee95845cae7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 9 Aug 2024 00:30:41 +0530 Subject: [PATCH 050/146] Add test for zip file that contains two files --- test/io/test_zip.f90 | 21 +++++++++++++++++++-- test/io/zip_files/two_files.zip | Bin 0 -> 290 bytes 2 files changed, 19 insertions(+), 2 deletions(-) create mode 100644 test/io/zip_files/two_files.zip diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index dc8d32450..45b8b3976 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -23,7 +23,8 @@ subroutine collect_zip(testsuite) new_unittest("unzip_empty_zip", unzip_empty_zip, should_fail=.true.), & new_unittest("unzip_zip_has_empty_file", unzip_zip_has_empty_file), & new_unittest("unzip_zip_has_txt_file", unzip_zip_has_txt_file), & - new_unittest("unzip_list_array_empty_0_file", unzip_list_array_empty_0_file) & + new_unittest("unzip_npy_array_empty_0_file", unzip_npy_array_empty_0_file), & + new_unittest("unzip_two_files", unzip_two_files) & ] end @@ -107,7 +108,7 @@ subroutine unzip_zip_has_txt_file(error) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end - subroutine unzip_list_array_empty_0_file(error) + subroutine unzip_npy_array_empty_0_file(error) type(error_type), allocatable, intent(out) :: error integer :: stat @@ -123,6 +124,22 @@ subroutine unzip_list_array_empty_0_file(error) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end + subroutine unzip_two_files(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(*), parameter :: filename = "two_files.zip" + character(:), allocatable :: path + + path = get_path(filename) + if (.not. allocated(path)) then + call test_failed(error, "The file '"//filename//"' could not be found."); return + end if + + call unzip(path, stat=stat) + call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file diff --git a/test/io/zip_files/two_files.zip b/test/io/zip_files/two_files.zip new file mode 100644 index 0000000000000000000000000000000000000000..ec03fe049b9027f31d62f5c7979c4096372d63a5 GIT binary patch literal 290 zcmWIWW@h1H0D%JxoRMG#lwf9%VaU%*4GrOBU=|SAng+t972FJrEMFNJ7+6Gr$^!6e zE-BB)ubGiajv1HT5^$$1X#_FBE@6eZ1j7}?8e|JJ2<$3c2C=e%>|z4KNkF;^#9;sc D Date: Fri, 9 Aug 2024 06:15:34 +0530 Subject: [PATCH 051/146] Apply compiler properties to indiviual files only to hopefully reduce build times --- src/CMakeLists.txt | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 7d766bd11..461dc9a2f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -120,10 +120,15 @@ set(SRC ${outPreprocFiles} ) +# Files that have cpp directives need to be compiled with the preprocessor. +set(hasCPP + stdlib_filesystem.f90 +) + if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") - add_compile_options(-cpp) + set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-cpp") elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") - add_compile_options(-fpp) + set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-fpp") endif() add_library(${PROJECT_NAME} ${SRC}) From 2a301f4fe41db67da204751ccbc3d671744df382 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 9 Aug 2024 06:16:20 +0530 Subject: [PATCH 052/146] Extract methods to stdlib_filesystem.f90 --- src/CMakeLists.txt | 1 + src/stdlib_filesystem.f90 | 44 +++++++++ src/stdlib_io_np_load.fypp | 185 +++++++++++++++++++++---------------- src/stdlib_io_zip.f90 | 64 ++----------- 4 files changed, 158 insertions(+), 136 deletions(-) create mode 100644 src/stdlib_filesystem.f90 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 461dc9a2f..421dd301e 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -104,6 +104,7 @@ set(SRC stdlib_ansi_to_string.f90 stdlib_codata.f90 stdlib_error.f90 + stdlib_filesystem.f90 stdlib_hashmap_wrappers.f90 stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_filesystem.f90 new file mode 100644 index 000000000..7ba51e700 --- /dev/null +++ b/src/stdlib_filesystem.f90 @@ -0,0 +1,44 @@ +module stdlib_filesystem + implicit none + private + + public :: exists, run, temp_folder + + character(*), parameter :: temp_folder = 'temp' + +contains + + logical function exists(filename) + character(len=*), intent(in) :: filename + + inquire(file=filename, exist=exists) + +#if defined(__INTEL_COMPILER) + if (.not. exists) inquire(directory=filename, exist=exists) +#endif + end + + subroutine run(command, stat, msg) + character(len=*), intent(in) :: command + integer, intent(out), optional :: stat + character(len=:), allocatable, intent(out), optional :: msg + + integer :: exitstat, cmdstat + character(len=256) :: cmdmsg + + if (present(stat)) stat = 0 + exitstat = 0; cmdstat = 0 + + call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) + if (exitstat /= 0 .or. cmdstat /= 0) then + if (present(stat)) then + if (exitstat /= 0) then + stat = exitstat + else + stat = cmdstat + end if + end if + if (present(msg) .and. trim(adjustl(cmdmsg)) /= '') msg = cmdmsg + end if + end +end diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 74cb928ae..6b0c3e5e2 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -6,11 +6,12 @@ !> Implementation of loading npy files into multidimensional arrays submodule(stdlib_io_np) stdlib_io_np_load + use stdlib_array use stdlib_error, only: error_stop + use stdlib_filesystem, only: exists + use stdlib_io_zip, only: unzip, unzipped_folder use stdlib_strings, only: to_string, starts_with use stdlib_string_type, only: string_type - use stdlib_io_zip, only: unzip, t_unzipped_bundle, t_unzipped_file - use stdlib_array implicit none contains @@ -110,28 +111,52 @@ contains integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg - type(t_unzipped_bundle) :: unzipped_bundle integer :: stat character(len=:), allocatable :: msg + type(string_type), allocatable :: files(:) + + call unzip(filename, unzipped_folder, stat, msg) + if (stat /= 0) then + 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) + return + end if - ! call unzip(filename, unzipped_bundle, stat, msg) - if (stat == 0) call load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) + call list_files(unzipped_folder, files, stat, msg) - 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 + ! call load_unzipped_files_to_arrays(unzipped_bundle, arrays, stat, msg) + end + + subroutine list_files(dir, files, stat, msg) + character(len=*), intent(in) :: dir + type(string_type), allocatable, intent(out) :: files(:) + integer, intent(out) :: stat + character(len=:), allocatable, intent(out) :: msg + + stat = 0 + + if (.not. exists(dir)) then + stat = 1 + msg = "Directory '"//dir//"' does not exist." + return end if - if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) + ! call execute_command_line('ls temp > file_list.txt', status) + ! if (status /= 0) then + ! print *, "Failed to list files in the directory" + ! stop + ! end if end - subroutine load_unzipped_bundle_to_arrays(unzipped_bundle, arrays, stat, msg) - type(t_unzipped_bundle), intent(in) :: unzipped_bundle + subroutine load_unzipped_files_to_arrays(arrays, stat, msg) type(t_array_wrapper), allocatable, intent(out) :: arrays(:) integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg @@ -140,70 +165,70 @@ contains 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 - - 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 - - allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) - if (stat /= 0) then - msg = "Failed to allocate array of type '"//this_type//"' "//& - & 'with total size of '//to_string(product(vshape)); return - end if - - select type (typed_array => arrays(i)%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 - - 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 - case default - stat = 1; msg = 'Unsupported array type: '//this_type//'.'; return - end select - - close (io, status='delete') - if (stat /= 0) return - end do +! 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 + +! 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 + +! allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) +! if (stat /= 0) then +! msg = "Failed to allocate array of type '"//this_type//"' "//& +! & 'with total size of '//to_string(product(vshape)); return +! end if + +! select type (typed_array => arrays(i)%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 + +! 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 +! case default +! stat = 1; msg = 'Unsupported array type: '//this_type//'.'; return +! end select + +! close (io, status='delete') +! if (stat /= 0) return +! end do end !> Read the npy header from a binary file and retrieve the descriptor string. diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index b4c18c078..da1ccddec 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -1,62 +1,14 @@ module stdlib_io_zip + use stdlib_filesystem, only: exists, run, temp_folder implicit none private - public :: unzip + public :: unzip, unzipped_folder - character(*), parameter :: temp_folder = 'temp' - character(*), parameter :: zip_contents = temp_folder//'/zip_contents' - - !> 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 + character(*), parameter :: unzipped_folder = temp_folder//'/unzipped_files' contains - logical function exists(filename) - character(len=*), intent(in) :: filename - - inquire(file=filename, exist=exists) - -#if defined(__INTEL_COMPILER) - if (.not. exists) inquire(directory=filename, exist=exists) -#endif - end - - subroutine run(command, stat, msg) - character(len=*), intent(in) :: command - integer, intent(out), optional :: stat - character(len=:), allocatable, intent(out), optional :: msg - - integer :: exitstat, cmdstat - character(len=256) :: cmdmsg - - if (present(stat)) stat = 0 - exitstat = 0; cmdstat = 0 - - call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) - if (exitstat /= 0 .or. cmdstat /= 0) then - if (present(stat)) then - if (exitstat /= 0) then - stat = exitstat - else - stat = cmdstat - end if - end if - if (present(msg) .and. trim(adjustl(cmdmsg)) /= '') msg = cmdmsg - end if - end - subroutine unzip(filename, outputdir, stat, msg) character(len=*), intent(in) :: filename character(len=*), intent(in), optional :: outputdir @@ -70,20 +22,20 @@ subroutine unzip(filename, outputdir, stat, msg) if (present(outputdir)) then output_dir = outputdir else - output_dir = zip_contents + output_dir = unzipped_folder end if if (present(stat)) stat = 0 run_stat = 0 - call run('rm -rf '//zip_contents, run_stat, err_msg) + call run('rm -rf '//unzipped_folder, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then if (allocated(err_msg)) then - msg = "Error removing folder '"//zip_contents//"': '"//err_msg//"'" + msg = "Error removing folder '"//unzipped_folder//"': '"//err_msg//"'" else - msg = "Error removing folder '"//zip_contents//"'." + msg = "Error removing folder '"//unzipped_folder//"'." end if end if return @@ -104,7 +56,7 @@ subroutine unzip(filename, outputdir, stat, msg) end if end if - call run('unzip '//filename//' -d '//zip_contents, run_stat, err_msg) + call run('unzip '//filename//' -d '//unzipped_folder, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then From 292e1af9c4b946d6c161f53e90dbe847f32420c5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 9 Aug 2024 18:11:47 +0530 Subject: [PATCH 053/146] Extract list_files into stdlib_filesystem --- src/stdlib_filesystem.f90 | 44 ++++++++++++++++++++++++++++++++++++-- src/stdlib_io_np_load.fypp | 25 ++-------------------- src/stdlib_io_zip.f90 | 15 +++++++------ 3 files changed, 52 insertions(+), 32 deletions(-) diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_filesystem.f90 index 7ba51e700..22694961a 100644 --- a/src/stdlib_filesystem.f90 +++ b/src/stdlib_filesystem.f90 @@ -1,10 +1,12 @@ module stdlib_filesystem + use stdlib_string_type, only: string_type implicit none private - public :: exists, run, temp_folder + public :: exists, list_files, run, temp_dir - character(*), parameter :: temp_folder = 'temp' + character(*), parameter :: temp_dir = 'temp' + character(*), parameter :: listed_files = 'temp'//'/listed_files.txt' contains @@ -18,6 +20,44 @@ logical function exists(filename) #endif end + subroutine list_files(dir, files, stat, msg) + character(len=*), intent(in) :: dir + type(string_type), allocatable, intent(out) :: files(:) + integer, intent(out) :: stat + character(len=:), allocatable, optional, intent(out) :: msg + + integer :: unit, iostat + character(:), allocatable :: err_msg + character(len=256) :: line + + stat = 0 + + call run('ls '//dir//' > '//listed_files, stat, err_msg) + if (stat /= 0) then + if (present(msg)) then + if (allocated(err_msg)) then + msg = "Failed to list files in directory '"//dir//"': '"//err_msg//"'" + else + msg = "Failed to list files in directory '"//dir//"'." + end if + return + end if + end if + + open(newunit=unit, file=listed_files, status='old', action='read', iostat=stat) + if (stat /= 0) then + if (present(msg)) msg = "Failed to open file '"//listed_files//"'."; return + end if + + allocate(files(0)) + do + read(unit, '(A)', iostat=iostat) line + if (iostat /= 0) exit + files = [files, string_type(line)] + end do + close(unit, status="delete") + end + subroutine run(command, stat, msg) character(len=*), intent(in) :: command integer, intent(out), optional :: stat diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 6b0c3e5e2..982dcf1a4 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -8,8 +8,8 @@ submodule(stdlib_io_np) stdlib_io_np_load use stdlib_array use stdlib_error, only: error_stop - use stdlib_filesystem, only: exists - use stdlib_io_zip, only: unzip, unzipped_folder + use stdlib_filesystem, only: exists, list_files, temp_dir + use stdlib_io_zip, only: unzip, unzipped_folder, zip_contents use stdlib_strings, only: to_string, starts_with use stdlib_string_type, only: string_type implicit none @@ -135,27 +135,6 @@ contains ! call load_unzipped_files_to_arrays(unzipped_bundle, arrays, stat, msg) end - subroutine list_files(dir, files, stat, msg) - character(len=*), intent(in) :: dir - type(string_type), allocatable, intent(out) :: files(:) - integer, intent(out) :: stat - character(len=:), allocatable, intent(out) :: msg - - stat = 0 - - if (.not. exists(dir)) then - stat = 1 - msg = "Directory '"//dir//"' does not exist." - return - end if - - ! call execute_command_line('ls temp > file_list.txt', status) - ! if (status /= 0) then - ! print *, "Failed to list files in the directory" - ! stop - ! end if - end - subroutine load_unzipped_files_to_arrays(arrays, stat, msg) type(t_array_wrapper), allocatable, intent(out) :: arrays(:) integer, intent(out) :: stat diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index da1ccddec..33d097372 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -1,11 +1,12 @@ module stdlib_io_zip - use stdlib_filesystem, only: exists, run, temp_folder + use stdlib_filesystem, only: exists, run, temp_dir implicit none private - public :: unzip, unzipped_folder + public :: unzip, unzipped_folder, zip_contents - character(*), parameter :: unzipped_folder = temp_folder//'/unzipped_files' + character(*), parameter :: unzipped_folder = temp_dir//'/unzipped_files' + character(*), parameter :: zip_contents = unzipped_folder//'/zip_contents.txt' contains @@ -41,15 +42,15 @@ subroutine unzip(filename, outputdir, stat, msg) return end if - if (.not. exists(temp_folder)) then - call run('mkdir '//temp_folder, run_stat, err_msg) + if (.not. exists(temp_dir)) then + call run('mkdir '//temp_dir, run_stat, err_msg) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) then if (allocated(err_msg)) then - msg = "Error creating folder '"//temp_folder//"': '"//err_msg//"'" + msg = "Error creating folder '"//temp_dir//"': '"//err_msg//"'" else - msg = "Error creating folder '"//temp_folder//"'." + msg = "Error creating folder '"//temp_dir//"'." end if end if return From 1dbb325f0b89a0eca809b0a6f402f6d96384475b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 9 Aug 2024 23:39:37 +0530 Subject: [PATCH 054/146] Start adding tests for stdlib_filesystem --- test/io/CMakeLists.txt | 3 +- test/io/test_filesystem.f90 | 94 +++++++++++++++++++++++++++++++++++++ 2 files changed, 96 insertions(+), 1 deletion(-) create mode 100644 test/io/test_filesystem.f90 diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index c2de125b1..f3185a2cf 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -13,8 +13,9 @@ ADDTEST(savetxt_qp) set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision) set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) +ADDTEST(filesystem) ADDTEST(getline) ADDTEST(np) -ADDTEST(zip) ADDTEST(open) ADDTEST(parse_mode) +ADDTEST(zip) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 new file mode 100644 index 000000000..4b4db9527 --- /dev/null +++ b/test/io/test_filesystem.f90 @@ -0,0 +1,94 @@ +module test_filesystem + use stdlib_filesystem + use testdrive, only : new_unittest, unittest_type, error_type, check + implicit none + private + + public :: collect_filesystem + +contains + + !> Collect all exported unit tests + subroutine collect_filesystem(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & + new_unittest("fs_file_exists", fs_file_exists), & + new_unittest("fs_current_dir_exists", fs_current_dir_exists) & + ] + end + + subroutine fs_file_not_exists(error) + type(error_type), allocatable, intent(out) :: error + + logical :: is_existing + + is_existing = exists("nonexistent") + call check(error, is_existing, "Non-existent file should fail.") + end + + subroutine fs_file_exists(error) + type(error_type), allocatable, intent(out) :: error + + logical :: is_existing + integer :: unit + character(*), parameter :: filename = "file.tmp" + + open(newunit=unit, file=filename) + close(unit) + + is_existing = exists(filename) + call check(error, is_existing, "An existing file should not fail.") + call delete_file(filename) + end + + + subroutine fs_current_dir_exists(error) + type(error_type), allocatable, intent(out) :: error + + logical :: is_existing + + is_existing = exists(".") + call check(error, is_existing, "Current directory should not fail.") + 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_filesystem, only : collect_filesystem + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("filesystem", collect_filesystem) & + ] + + 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 From 762cbc4912a483233f0787e2f636b490cc3bf75d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 9 Aug 2024 23:46:20 +0530 Subject: [PATCH 055/146] Add tests for run --- test/io/test_filesystem.f90 | 33 ++++++++++++++++++++++++++++++--- 1 file changed, 30 insertions(+), 3 deletions(-) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 4b4db9527..5aaa32422 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -16,7 +16,10 @@ subroutine collect_filesystem(testsuite) testsuite = [ & new_unittest("fs_file_not_exists", fs_file_not_exists, should_fail=.true.), & new_unittest("fs_file_exists", fs_file_exists), & - new_unittest("fs_current_dir_exists", fs_current_dir_exists) & + new_unittest("fs_current_dir_exists", fs_current_dir_exists), & + new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), & + new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), & + new_unittest("fs_run_valid_command", fs_run_valid_command) & ] end @@ -44,7 +47,6 @@ subroutine fs_file_exists(error) call delete_file(filename) end - subroutine fs_current_dir_exists(error) type(error_type), allocatable, intent(out) :: error @@ -54,6 +56,32 @@ subroutine fs_current_dir_exists(error) call check(error, is_existing, "Current directory should not fail.") end + subroutine fs_run_invalid_command(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call run("invalid_command", stat=stat) + call check(error, stat, "Running an invalid command should fail.") + end + + subroutine fs_run_with_invalid_option(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call run("whoami -X", stat=stat) + call check(error, stat, "Running a valid command with an invalid option should fail.") + end + + subroutine fs_run_valid_command(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + call run("whoami", stat=stat) + call check(error, stat, "Running a valid command should not fail.") + end subroutine delete_file(filename) character(len=*), intent(in) :: filename @@ -66,7 +94,6 @@ subroutine delete_file(filename) end - program tester use, intrinsic :: iso_fortran_env, only : error_unit use testdrive, only : run_testsuite, new_testsuite, testsuite_type From 8a08ec25d83ac6c2e9a49d1f889d11c9363541c7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 10 Aug 2024 03:16:20 +0530 Subject: [PATCH 056/146] Rename to list_dir_contents and add tests --- src/stdlib_filesystem.f90 | 13 ++--- src/stdlib_io_np_load.fypp | 4 +- test/io/test_filesystem.f90 | 97 ++++++++++++++++++++++++++++++++++++- 3 files changed, 105 insertions(+), 9 deletions(-) diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_filesystem.f90 index 22694961a..ad745700f 100644 --- a/src/stdlib_filesystem.f90 +++ b/src/stdlib_filesystem.f90 @@ -3,10 +3,10 @@ module stdlib_filesystem implicit none private - public :: exists, list_files, run, temp_dir + public :: exists, list_dir_content, run, temp_dir character(*), parameter :: temp_dir = 'temp' - character(*), parameter :: listed_files = 'temp'//'/listed_files.txt' + character(*), parameter :: listed_contents = 'temp'//'/listed_contents.txt' contains @@ -20,7 +20,8 @@ logical function exists(filename) #endif end - subroutine list_files(dir, files, stat, msg) + !> List files and directories of a directory. Does not list hidden files. + subroutine list_dir_content(dir, files, stat, msg) character(len=*), intent(in) :: dir type(string_type), allocatable, intent(out) :: files(:) integer, intent(out) :: stat @@ -32,7 +33,7 @@ subroutine list_files(dir, files, stat, msg) stat = 0 - call run('ls '//dir//' > '//listed_files, stat, err_msg) + call run('ls '//dir//' > '//listed_contents, stat, err_msg) if (stat /= 0) then if (present(msg)) then if (allocated(err_msg)) then @@ -44,9 +45,9 @@ subroutine list_files(dir, files, stat, msg) end if end if - open(newunit=unit, file=listed_files, status='old', action='read', iostat=stat) + open(newunit=unit, file=listed_contents, status='old', action='read', iostat=stat) if (stat /= 0) then - if (present(msg)) msg = "Failed to open file '"//listed_files//"'."; return + if (present(msg)) msg = "Failed to open file '"//listed_contents//"'."; return end if allocate(files(0)) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 982dcf1a4..3f9f6e004 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -8,7 +8,7 @@ submodule(stdlib_io_np) stdlib_io_np_load use stdlib_array use stdlib_error, only: error_stop - use stdlib_filesystem, only: exists, list_files, temp_dir + use stdlib_filesystem, only: exists, list_dir_content, temp_dir use stdlib_io_zip, only: unzip, unzipped_folder, zip_contents use stdlib_strings, only: to_string, starts_with use stdlib_string_type, only: string_type @@ -130,7 +130,7 @@ contains return end if - call list_files(unzipped_folder, files, stat, msg) + call list_dir_content(unzipped_folder, files, stat, msg) ! call load_unzipped_files_to_arrays(unzipped_bundle, arrays, stat, msg) end diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 5aaa32422..657dca7cd 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -1,11 +1,14 @@ module test_filesystem use stdlib_filesystem use testdrive, only : new_unittest, unittest_type, error_type, check + use stdlib_string_type, only : char, string_type implicit none private public :: collect_filesystem + character(*), parameter :: temp_listed_contents = temp_dir//'/listed_contents' + contains !> Collect all exported unit tests @@ -19,7 +22,10 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_current_dir_exists", fs_current_dir_exists), & new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), & new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), & - new_unittest("fs_run_valid_command", fs_run_valid_command) & + new_unittest("fs_run_valid_command", fs_run_valid_command), & + new_unittest("fs_list_dir_contents_empty_dir", fs_list_dir_contents_empty_dir), & + new_unittest("fs_list_dir_contents_one_file", fs_list_dir_contents_one_file), & + new_unittest("fs_list_dir_contents_two_files", fs_list_dir_contents_two_files) & ] end @@ -83,6 +89,95 @@ subroutine fs_run_valid_command(error) call check(error, stat, "Running a valid command should not fail.") end + subroutine fs_list_dir_contents_empty_dir(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + type(string_type), allocatable :: files(:) + + if (.not. exists(temp_dir)) then + call run('mkdir '//temp_dir, stat=stat) + call check(error, stat, "Creating the '"//temp_dir//"' directory shouldn't fail.") + end if + + call run ('rm -rf '//temp_listed_contents, stat=stat) + call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + call run('mkdir '//temp_listed_contents, stat=stat) + call check(error, stat, "Creating the directory '"//temp_listed_contents//"' shouldn't fail.") + + call list_dir_content(temp_listed_contents, files, stat) + call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") + call check(error, size(files) == 0, "The directory should be empty.") + + call run('rm -rf '//temp_listed_contents, stat=stat) + call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + end + + subroutine fs_list_dir_contents_one_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + type(string_type), allocatable :: files(:) + character(*), parameter :: filename = 'abc.txt' + + if (.not. exists(temp_dir)) then + call run('mkdir '//temp_dir, stat=stat) + call check(error, stat, "Creating the '"//temp_dir//"' directory shouldn't fail.") + end if + + call run ('rm -rf '//temp_listed_contents, stat=stat) + call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + call run('mkdir '//temp_listed_contents, stat=stat) + call check(error, stat, "Creating the directory '"//temp_listed_contents//"' shouldn't fail.") + + call run('touch '//temp_listed_contents//'/'//filename, stat=stat) + call check(error, stat, "Creating a file in the directory '"//temp_listed_contents//"' shouldn't fail.") + + call list_dir_content(temp_listed_contents, files, stat) + call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") + call check(error, size(files) == 1, "The directory should contain one file.") + call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") + + call run('rm -rf '//temp_listed_contents, stat=stat) + call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + end + + subroutine fs_list_dir_contents_two_files(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + + type(string_type), allocatable :: files(:) + character(*), parameter :: filename1 = 'abc.txt' + character(*), parameter :: filename2 = 'xyz' + + if (.not. exists(temp_dir)) then + call run('mkdir '//temp_dir, stat=stat) + call check(error, stat, "Creating the '"//temp_dir//"' directory shouldn't fail.") + end if + + call run ('rm -rf '//temp_listed_contents, stat=stat) + call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + call run('mkdir '//temp_listed_contents, stat=stat) + call check(error, stat, "Creating the directory '"//temp_listed_contents//"' shouldn't fail.") + + call run('touch '//temp_listed_contents//'/'//filename1, stat=stat) + call check(error, stat, "Creating a file in the directory '"//temp_listed_contents//"' shouldn't fail.") + + call run('touch '//temp_listed_contents//'/'//filename2, stat=stat) + call check(error, stat, "Creating a file in the directory '"//temp_listed_contents//"' shouldn't fail.") + + call list_dir_content(temp_listed_contents, files, stat) + call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") + call check(error, size(files) == 2, "The directory should contain two files.") + call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.") + call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.") + + call run('rm -rf '//temp_listed_contents, stat=stat) + call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + end + subroutine delete_file(filename) character(len=*), intent(in) :: filename From acd89f7b34960b1136d9d429b35e580232b420fe Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 10 Aug 2024 18:01:28 +0530 Subject: [PATCH 057/146] Use test_failed --- test/io/test_filesystem.f90 | 45 +++++++++++++++++++++++++++++-------- 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 657dca7cd..d8d2a46de 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -1,6 +1,6 @@ module test_filesystem use stdlib_filesystem - use testdrive, only : new_unittest, unittest_type, error_type, check + use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed use stdlib_string_type, only : char, string_type implicit none private @@ -101,9 +101,16 @@ subroutine fs_list_dir_contents_empty_dir(error) end if call run ('rm -rf '//temp_listed_contents, stat=stat) - call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if + call run('mkdir '//temp_listed_contents, stat=stat) - call check(error, stat, "Creating the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Creating directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if call list_dir_content(temp_listed_contents, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") @@ -127,9 +134,16 @@ subroutine fs_list_dir_contents_one_file(error) end if call run ('rm -rf '//temp_listed_contents, stat=stat) - call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if + call run('mkdir '//temp_listed_contents, stat=stat) - call check(error, stat, "Creating the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Creating directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if call run('touch '//temp_listed_contents//'/'//filename, stat=stat) call check(error, stat, "Creating a file in the directory '"//temp_listed_contents//"' shouldn't fail.") @@ -158,15 +172,28 @@ subroutine fs_list_dir_contents_two_files(error) end if call run ('rm -rf '//temp_listed_contents, stat=stat) - call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if + call run('mkdir '//temp_listed_contents, stat=stat) - call check(error, stat, "Creating the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Creating directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if call run('touch '//temp_listed_contents//'/'//filename1, stat=stat) - call check(error, stat, "Creating a file in the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Creating file 1 in directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if call run('touch '//temp_listed_contents//'/'//filename2, stat=stat) - call check(error, stat, "Creating a file in the directory '"//temp_listed_contents//"' shouldn't fail.") + if (stat /= 0) then + call test_failed(error, "Creating file 2 in directory '"//temp_listed_contents//"' shouldn't fail.") + return + end if call list_dir_content(temp_listed_contents, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") From e822047dfe7d74af92afa6fce0b5de62cb992ca1 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 10 Aug 2024 18:38:17 +0530 Subject: [PATCH 058/146] Improve naming --- test/io/test_filesystem.f90 | 31 ++++++++++++++++++++----------- 1 file changed, 20 insertions(+), 11 deletions(-) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index d8d2a46de..8aa578f2b 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -97,18 +97,21 @@ subroutine fs_list_dir_contents_empty_dir(error) if (.not. exists(temp_dir)) then call run('mkdir '//temp_dir, stat=stat) - call check(error, stat, "Creating the '"//temp_dir//"' directory shouldn't fail.") + if (stat/= 0) then + call test_failed(error, "Creating the '"//temp_dir//"' directory failed.") + return + end if end if call run ('rm -rf '//temp_listed_contents, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Removing directory '"//temp_listed_contents//"' failed.") return end if call run('mkdir '//temp_listed_contents, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Creating directory '"//temp_listed_contents//"' failed.") return end if @@ -130,18 +133,21 @@ subroutine fs_list_dir_contents_one_file(error) if (.not. exists(temp_dir)) then call run('mkdir '//temp_dir, stat=stat) - call check(error, stat, "Creating the '"//temp_dir//"' directory shouldn't fail.") + if (stat/= 0) then + call test_failed(error, "Creating the '"//temp_dir//"' directory failed.") + return + end if end if call run ('rm -rf '//temp_listed_contents, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Removing directory '"//temp_listed_contents//"' failed.") return end if call run('mkdir '//temp_listed_contents, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Creating directory '"//temp_listed_contents//"' failed.") return end if @@ -168,30 +174,33 @@ subroutine fs_list_dir_contents_two_files(error) if (.not. exists(temp_dir)) then call run('mkdir '//temp_dir, stat=stat) - call check(error, stat, "Creating the '"//temp_dir//"' directory shouldn't fail.") + if (stat/= 0) then + call test_failed(error, "Creating the '"//temp_dir//"' directory failed.") + return + end if end if call run ('rm -rf '//temp_listed_contents, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Removing directory '"//temp_listed_contents//"' failed.") return end if call run('mkdir '//temp_listed_contents, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Creating directory '"//temp_listed_contents//"' failed.") return end if call run('touch '//temp_listed_contents//'/'//filename1, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating file 1 in directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Creating file 1 in directory '"//temp_listed_contents//"' failed.") return end if call run('touch '//temp_listed_contents//'/'//filename2, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating file 2 in directory '"//temp_listed_contents//"' shouldn't fail.") + call test_failed(error, "Creating file 2 in directory '"//temp_listed_contents//"' failed.") return end if From 0d9b7c1c4624f7f3b14f13409f8525cab2fff1d3 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 10 Aug 2024 22:54:04 +0530 Subject: [PATCH 059/146] Only have single level of directories --- src/stdlib_filesystem.f90 | 6 +-- src/stdlib_io_np_load.fypp | 4 +- test/io/test_filesystem.f90 | 90 ++++++++++++++----------------------- 3 files changed, 38 insertions(+), 62 deletions(-) diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_filesystem.f90 index ad745700f..e65b139fd 100644 --- a/src/stdlib_filesystem.f90 +++ b/src/stdlib_filesystem.f90 @@ -3,10 +3,10 @@ module stdlib_filesystem implicit none private - public :: exists, list_dir_content, run, temp_dir + public :: exists, list_dir, run, temp_dir character(*), parameter :: temp_dir = 'temp' - character(*), parameter :: listed_contents = 'temp'//'/listed_contents.txt' + character(*), parameter :: listed_contents = temp_dir//'/listed_contents.txt' contains @@ -21,7 +21,7 @@ logical function exists(filename) end !> List files and directories of a directory. Does not list hidden files. - subroutine list_dir_content(dir, files, stat, msg) + subroutine list_dir(dir, files, stat, msg) character(len=*), intent(in) :: dir type(string_type), allocatable, intent(out) :: files(:) integer, intent(out) :: stat diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 3f9f6e004..e8e9f04d9 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -8,7 +8,7 @@ submodule(stdlib_io_np) stdlib_io_np_load use stdlib_array use stdlib_error, only: error_stop - use stdlib_filesystem, only: exists, list_dir_content, temp_dir + use stdlib_filesystem, only: exists, list_dir, temp_dir use stdlib_io_zip, only: unzip, unzipped_folder, zip_contents use stdlib_strings, only: to_string, starts_with use stdlib_string_type, only: string_type @@ -130,7 +130,7 @@ contains return end if - call list_dir_content(unzipped_folder, files, stat, msg) + call list_dir(unzipped_folder, files, stat, msg) ! call load_unzipped_files_to_arrays(unzipped_bundle, arrays, stat, msg) end diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 8aa578f2b..1ed3f73cf 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -7,7 +7,7 @@ module test_filesystem public :: collect_filesystem - character(*), parameter :: temp_listed_contents = temp_dir//'/listed_contents' + character(*), parameter :: temp_list_dir = 'temp_list_dir' contains @@ -23,9 +23,9 @@ subroutine collect_filesystem(testsuite) new_unittest("fs_run_invalid_command", fs_run_invalid_command, should_fail=.true.), & new_unittest("fs_run_with_invalid_option", fs_run_with_invalid_option, should_fail=.true.), & new_unittest("fs_run_valid_command", fs_run_valid_command), & - new_unittest("fs_list_dir_contents_empty_dir", fs_list_dir_contents_empty_dir), & - new_unittest("fs_list_dir_contents_one_file", fs_list_dir_contents_one_file), & - new_unittest("fs_list_dir_contents_two_files", fs_list_dir_contents_two_files) & + new_unittest("fs_list_dir_empty", fs_list_dir_empty), & + new_unittest("fs_list_dir_one_file", fs_list_dir_one_file), & + new_unittest("fs_list_dir_two_files", fs_list_dir_two_files) & ] end @@ -89,41 +89,32 @@ subroutine fs_run_valid_command(error) call check(error, stat, "Running a valid command should not fail.") end - subroutine fs_list_dir_contents_empty_dir(error) + subroutine fs_list_dir_empty(error) type(error_type), allocatable, intent(out) :: error integer :: stat type(string_type), allocatable :: files(:) - if (.not. exists(temp_dir)) then - call run('mkdir '//temp_dir, stat=stat) - if (stat/= 0) then - call test_failed(error, "Creating the '"//temp_dir//"' directory failed.") - return - end if - end if - - call run ('rm -rf '//temp_listed_contents, stat=stat) + call run('rm -rf '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed.") return end if - call run('mkdir '//temp_listed_contents, stat=stat) + call run('mkdir '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed.") return end if - call list_dir_content(temp_listed_contents, files, stat) + call list_dir_content(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 0, "The directory should be empty.") - call run('rm -rf '//temp_listed_contents, stat=stat) - call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + call run('rm -rf '//temp_list_dir, stat=stat) end - subroutine fs_list_dir_contents_one_file(error) + subroutine fs_list_dir_one_file(error) type(error_type), allocatable, intent(out) :: error integer :: stat @@ -131,39 +122,33 @@ subroutine fs_list_dir_contents_one_file(error) type(string_type), allocatable :: files(:) character(*), parameter :: filename = 'abc.txt' - if (.not. exists(temp_dir)) then - call run('mkdir '//temp_dir, stat=stat) - if (stat/= 0) then - call test_failed(error, "Creating the '"//temp_dir//"' directory failed.") - return - end if + call run('rm -rf '//temp_list_dir, stat=stat) + if (stat /= 0) then + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed.") + return end if - call run ('rm -rf '//temp_listed_contents, stat=stat) + call run('mkdir '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed.") return end if - call run('mkdir '//temp_listed_contents, stat=stat) + call run('touch '//temp_list_dir//'/'//filename, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Creating file'"//filename//"' in directory '"//temp_list_dir//"' failed.") return end if - call run('touch '//temp_listed_contents//'/'//filename, stat=stat) - call check(error, stat, "Creating a file in the directory '"//temp_listed_contents//"' shouldn't fail.") - - call list_dir_content(temp_listed_contents, files, stat) + call list_dir_content(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 1, "The directory should contain one file.") call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") - call run('rm -rf '//temp_listed_contents, stat=stat) - call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + call run('rm -rf '//temp_list_dir, stat=stat) end - subroutine fs_list_dir_contents_two_files(error) + subroutine fs_list_dir_two_files(error) type(error_type), allocatable, intent(out) :: error integer :: stat @@ -172,46 +157,37 @@ subroutine fs_list_dir_contents_two_files(error) character(*), parameter :: filename1 = 'abc.txt' character(*), parameter :: filename2 = 'xyz' - if (.not. exists(temp_dir)) then - call run('mkdir '//temp_dir, stat=stat) - if (stat/= 0) then - call test_failed(error, "Creating the '"//temp_dir//"' directory failed.") - return - end if - end if - - call run ('rm -rf '//temp_listed_contents, stat=stat) + call run('rm -rf '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed.") return end if - call run('mkdir '//temp_listed_contents, stat=stat) + call run('mkdir '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed.") return end if - call run('touch '//temp_listed_contents//'/'//filename1, stat=stat) + call run('touch '//temp_list_dir//'/'//filename1, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating file 1 in directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed.") return end if - call run('touch '//temp_listed_contents//'/'//filename2, stat=stat) + call run('touch '//temp_list_dir//'/'//filename2, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating file 2 in directory '"//temp_listed_contents//"' failed.") + call test_failed(error, "Creating file 2 in directory '"//temp_list_dir//"' failed.") return end if - call list_dir_content(temp_listed_contents, files, stat) + call list_dir_content(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 2, "The directory should contain two files.") call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.") call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.") - call run('rm -rf '//temp_listed_contents, stat=stat) - call check(error, stat, "Removing the directory '"//temp_listed_contents//"' shouldn't fail.") + call run('rm -rf '//temp_list_dir, stat=stat) end subroutine delete_file(filename) From 4777c750adf692f09e65d0752d67890e0898203f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 10 Aug 2024 22:57:38 +0530 Subject: [PATCH 060/146] Fix procedure name --- test/io/test_filesystem.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 1ed3f73cf..fdb0d9fb1 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -107,7 +107,7 @@ subroutine fs_list_dir_empty(error) return end if - call list_dir_content(temp_list_dir, files, stat) + call list_dir(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 0, "The directory should be empty.") @@ -140,7 +140,7 @@ subroutine fs_list_dir_one_file(error) return end if - call list_dir_content(temp_list_dir, files, stat) + call list_dir(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 1, "The directory should contain one file.") call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") @@ -181,7 +181,7 @@ subroutine fs_list_dir_two_files(error) return end if - call list_dir_content(temp_list_dir, files, stat) + call list_dir(temp_list_dir, files, stat) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 2, "The directory should contain two files.") call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.") From 34a3ae6e62cb485f6d6d7ec2b6bc82943213f55f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 10 Aug 2024 23:22:00 +0530 Subject: [PATCH 061/146] Create temp file if it not exists --- src/stdlib_filesystem.f90 | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_filesystem.f90 index e65b139fd..57890176c 100644 --- a/src/stdlib_filesystem.f90 +++ b/src/stdlib_filesystem.f90 @@ -33,6 +33,20 @@ subroutine list_dir(dir, files, stat, msg) stat = 0 + if (.not. exists(temp_dir)) then + call run('mkdir '//temp_dir, stat, err_msg) + if (stat /= 0) then + if (present(msg)) then + if (allocated(err_msg)) then + msg = "Failed to create temporary directory '"//temp_dir//"': '"//err_msg//"'" + else + msg = "Failed to create temporary directory '"//temp_dir//"'." + end if + return + end if + end if + end if + call run('ls '//dir//' > '//listed_contents, stat, err_msg) if (stat /= 0) then if (present(msg)) then From 94061fde58b3b6a8d200a65054298a364ea9f920 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 11 Aug 2024 00:13:55 +0530 Subject: [PATCH 062/146] Fix error handling and define api for array loading --- src/stdlib_io_np_load.fypp | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index e8e9f04d9..9c4f0c350 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -119,23 +119,45 @@ contains if (stat /= 0) then 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) + call error_stop("Failed to unzip file '"//filename//"'"//nl//msg) else - call error_stop("Failed to read arrays from file '"//filename//"'") + call error_stop("Failed to unzip file '"//filename//"'") end if end if - if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) return end if call list_dir(unzipped_folder, files, stat, msg) + if (stat /= 0) then + if (present(iostat)) then + iostat = stat + if (allocated(msg)) then + call error_stop("Failed to list contents of directory '"//unzipped_folder//"'"//nl//msg) + else + call error_stop("Failed to list contents of directory '"//unzipped_folder//"'") + end if + end if + return + end if - ! call load_unzipped_files_to_arrays(unzipped_bundle, arrays, stat, msg) + call load_unzipped_files_to_arrays(files, unzipped_folder, arrays, stat, msg) + if (stat /= 0) then + if (present(iostat)) then + iostat = stat + if (allocated(msg)) then + call error_stop("Failed to load arrays from file '"//filename//"'"//nl//msg) + else + call error_stop("Failed to load arrays from file '"//filename//"'") + end if + end if + return + end if end - subroutine load_unzipped_files_to_arrays(arrays, stat, msg) + subroutine load_unzipped_files_to_arrays(files, dir, arrays, stat, msg) + type(string_type), intent(in) :: files(:) + character(len=*), intent(in) :: dir type(t_array_wrapper), allocatable, intent(out) :: arrays(:) integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg From bb6108f3862822fb9b209cd867b42edf2335e489 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 11 Aug 2024 02:08:25 +0530 Subject: [PATCH 063/146] Rename npy tests to np --- test/io/test_np.f90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index eb7f85795..288f1963f 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,16 +1,16 @@ -module test_npy +module test_np use stdlib_kinds, only : int8, int16, int32, int64, sp, dp use stdlib_io_np, only : save_npy, load_npy 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(:) @@ -37,7 +37,7 @@ subroutine collect_npy(testsuite) new_unittest("missing-shape", test_missing_shape, should_fail=.true.), & new_unittest("iomsg-deallocated", test_iomsg_deallocated) & ] - end subroutine collect_npy + end subroutine collect_np subroutine test_read_rdp_rank2(error) !> Error handling @@ -650,13 +650,13 @@ subroutine delete_file(filename) close(io, status="delete") end subroutine delete_file -end module test_npy +end program tester use, intrinsic :: iso_fortran_env, only : error_unit use testdrive, only : run_testsuite, new_testsuite, testsuite_type - use test_npy, only : collect_npy + use test_np, only : collect_np implicit none integer :: stat, is type(testsuite_type), allocatable :: testsuites(:) @@ -665,7 +665,7 @@ program tester stat = 0 testsuites = [ & - new_testsuite("npy", collect_npy) & + new_testsuite("np", collect_np) & ] do is = 1, size(testsuites) From 2c95d855db2ab1c38f9e2350f95c4038efc230a8 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sun, 11 Aug 2024 18:54:40 +0530 Subject: [PATCH 064/146] Only use custom error bc it's currently gibberish, not use error_stop bc it can't be tested, add first test --- src/stdlib_filesystem.f90 | 21 +++------------ src/stdlib_io_np_load.fypp | 55 +++++++++++--------------------------- src/stdlib_io_zip.f90 | 32 +++++----------------- test/io/test_np.f90 | 36 +++++++++++++++++++++++-- 4 files changed, 61 insertions(+), 83 deletions(-) diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_filesystem.f90 index 57890176c..6d5f0ef1e 100644 --- a/src/stdlib_filesystem.f90 +++ b/src/stdlib_filesystem.f90 @@ -28,34 +28,21 @@ subroutine list_dir(dir, files, stat, msg) character(len=:), allocatable, optional, intent(out) :: msg integer :: unit, iostat - character(:), allocatable :: err_msg character(len=256) :: line stat = 0 if (.not. exists(temp_dir)) then - call run('mkdir '//temp_dir, stat, err_msg) + call run('mkdir '//temp_dir, stat) if (stat /= 0) then - if (present(msg)) then - if (allocated(err_msg)) then - msg = "Failed to create temporary directory '"//temp_dir//"': '"//err_msg//"'" - else - msg = "Failed to create temporary directory '"//temp_dir//"'." - end if - return - end if + if (present(msg)) msg = "Failed to create temporary directory '"//temp_dir//"'."; return end if end if - call run('ls '//dir//' > '//listed_contents, stat, err_msg) + call run('ls '//dir//' > '//listed_contents, stat) if (stat /= 0) then if (present(msg)) then - if (allocated(err_msg)) then - msg = "Failed to list files in directory '"//dir//"': '"//err_msg//"'" - else - msg = "Failed to list files in directory '"//dir//"'." - end if - return + msg = "Failed to list files in directory '"//dir//"'."; return end if end if diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 9c4f0c350..0dccf149b 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -11,7 +11,7 @@ submodule(stdlib_io_np) stdlib_io_np_load use stdlib_filesystem, only: exists, list_dir, temp_dir use stdlib_io_zip, only: unzip, unzipped_folder, zip_contents use stdlib_strings, only: to_string, starts_with - use stdlib_string_type, only: string_type + use stdlib_string_type, only: string_type, char implicit none contains @@ -117,40 +117,22 @@ contains call unzip(filename, unzipped_folder, stat, msg) if (stat /= 0) then - if (present(iostat)) then - iostat = stat - if (allocated(msg)) then - call error_stop("Failed to unzip file '"//filename//"'"//nl//msg) - else - call error_stop("Failed to unzip file '"//filename//"'") - end if - end if + if (present(iostat)) iostat = stat + if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) return end if call list_dir(unzipped_folder, files, stat, msg) if (stat /= 0) then - if (present(iostat)) then - iostat = stat - if (allocated(msg)) then - call error_stop("Failed to list contents of directory '"//unzipped_folder//"'"//nl//msg) - else - call error_stop("Failed to list contents of directory '"//unzipped_folder//"'") - end if - end if + if (present(iostat)) iostat = stat + if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) return end if call load_unzipped_files_to_arrays(files, unzipped_folder, arrays, stat, msg) if (stat /= 0) then - if (present(iostat)) then - iostat = stat - if (allocated(msg)) then - call error_stop("Failed to load arrays from file '"//filename//"'"//nl//msg) - else - call error_stop("Failed to load arrays from file '"//filename//"'") - end if - end if + if (present(iostat)) iostat = stat + if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) return end if end @@ -166,21 +148,16 @@ contains 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 + allocate(arrays(size(files))) -! 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 + do i = 1, size(files) + open(newunit=io, file=dir//char(files(i)), form='unformatted', access='stream', iostat=stat, iomsg=msg) + if (stat /= 0) return -! rewind (io) -! call get_descriptor(io, unzipped_bundle%files(i)%name, this_type, vshape, stat, msg) -! if (stat /= 0) return + call get_descriptor(io, char(files(i)), this_type, vshape, stat, msg) + if (stat /= 0) then + close(io, status='delete'); return + end if ! select case (this_type) ! #:for k1, t1 in KINDS_TYPES @@ -229,7 +206,7 @@ contains ! close (io, status='delete') ! if (stat /= 0) return -! end do + end do end !> Read the npy header from a binary file and retrieve the descriptor string. diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 33d097372..5f6194145 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -17,7 +17,6 @@ subroutine unzip(filename, outputdir, stat, msg) character(len=:), allocatable, intent(out), optional :: msg integer :: run_stat - character(:), allocatable :: err_msg character(:), allocatable :: output_dir if (present(outputdir)) then @@ -29,44 +28,27 @@ subroutine unzip(filename, outputdir, stat, msg) if (present(stat)) stat = 0 run_stat = 0 - call run('rm -rf '//unzipped_folder, run_stat, err_msg) + call run('rm -rf '//unzipped_folder, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat - if (present(msg)) then - if (allocated(err_msg)) then - msg = "Error removing folder '"//unzipped_folder//"': '"//err_msg//"'" - else - msg = "Error removing folder '"//unzipped_folder//"'." - end if - end if + if (present(msg)) msg = "Error removing folder '"//unzipped_folder//"'." return end if if (.not. exists(temp_dir)) then - call run('mkdir '//temp_dir, run_stat, err_msg) + call run('mkdir '//temp_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat - if (present(msg)) then - if (allocated(err_msg)) then - msg = "Error creating folder '"//temp_dir//"': '"//err_msg//"'" - else - msg = "Error creating folder '"//temp_dir//"'." - end if - end if + if (present(msg)) msg = "Error creating folder '"//temp_dir//"'." return end if end if - call run('unzip '//filename//' -d '//unzipped_folder, run_stat, err_msg) + call run('unzip '//filename//' -d '//unzipped_folder, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat - if (present(msg)) then - if (allocated(err_msg)) then - msg = "Error unzipping '"//filename//"': '"//err_msg//"'" - else - msg = "Error unzipping '"//filename//"'." - end if - end if + if (present(msg)) msg = "Error unzipping '"//filename//"'." + return end if end end diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 288f1963f..f6ac23736 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,6 +1,7 @@ module test_np + use stdlib_array, only : t_array_wrapper use stdlib_kinds, only : int8, int16, int32, int64, sp, dp - use stdlib_io_np, only : save_npy, load_npy + use stdlib_io_np, only : save_npy, load_npy, load_npz use testdrive, only : new_unittest, unittest_type, error_type, check implicit none private @@ -35,7 +36,8 @@ subroutine collect_np(testsuite) 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("iomsg-deallocated", test_iomsg_deallocated), & + new_unittest("npz_load_nonexistent_file", npz_load_nonexistent_file, should_fail=.true.) & ] end subroutine collect_np @@ -641,6 +643,36 @@ subroutine test_iomsg_deallocated(error) end subroutine + subroutine npz_load_nonexistent_file(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + + integer :: stat + character(len=*), parameter :: filename = "nonexistent.npz" + + call load_npz(filename, arrays, stat) + call check(error, stat, "Loading a non-existent npz file should fail.") + end subroutine + + ! subroutine test_npz_load_empty_zip(error) + ! !> Error handling + ! type(error_type), allocatable, intent(out) :: error + + ! integer :: stat + ! character(len=*), parameter :: filename = "empty.zip" + ! character(:), allocatable :: path + + ! path = get_path(filename) + ! if (.not. allocated(path)) then + ! call test_failed(error, "The file '"//filename//"' could not be found."); return + ! end if + + ! call load_npz(path, stat=stat) + ! call check(error, stat, "An empty zip file should fail.") + ! end subroutine + subroutine delete_file(filename) character(len=*), intent(in) :: filename From 9c2e691aefd2e9eeaa6aa0448421094faaf4456b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 12 Aug 2024 00:08:38 +0530 Subject: [PATCH 065/146] Add more tests --- test/io/test_np.f90 | 67 ++++++++++++++++++++++++++++++++++---------- test/io/test_zip.f90 | 33 ++++++++++++++++------ 2 files changed, 77 insertions(+), 23 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index f6ac23736..9e13d7c99 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -37,7 +37,10 @@ subroutine collect_np(testsuite) 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_load_nonexistent_file", npz_load_nonexistent_file, should_fail=.true.) & + new_unittest("npz_load_nonexistent_file", npz_load_nonexistent_file, should_fail=.true.), & + new_unittest("npz_load_invalid_dir", npz_load_invalid_dir, should_fail=.true.), & + new_unittest("npz_load_empty_file", npz_load_empty_file, should_fail=.true.), & + new_unittest("npz_load_empty_zip", npz_load_empty_zip, should_fail=.true.) & ] end subroutine collect_np @@ -654,24 +657,58 @@ subroutine npz_load_nonexistent_file(error) call load_npz(filename, arrays, stat) call check(error, stat, "Loading a non-existent npz file should fail.") - end subroutine + end + + subroutine npz_load_invalid_dir(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + + integer :: stat + character(len=*), parameter :: filename = "." + + call load_npz(filename, arrays, stat) + call check(error, stat, "A file name that points towards a directory should fail.") + end + + subroutine npz_load_empty_file(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + + integer :: io, stat + character(*), parameter :: filename = "empty_file" + + open(newunit=io, file=filename) + close(io) + + call load_npz(filename, arrays, stat) + call check(error, stat, "Try loading an empty file as an npz file should fail.") + + call delete_file(filename) + end - ! subroutine test_npz_load_empty_zip(error) - ! !> Error handling - ! type(error_type), allocatable, intent(out) :: error + subroutine npz_load_empty_zip(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: io, stat + + character(*), parameter :: filename = "empty.zip" + character(*), parameter:: binary_data = 'PK'//char(5)//char(6)//repeat(char(0), 18) - ! integer :: stat - ! character(len=*), parameter :: filename = "empty.zip" - ! character(:), allocatable :: path + open (newunit=io, file=filename, form='unformatted', access='stream') + write (io) binary_data + close (io) - ! path = get_path(filename) - ! if (.not. allocated(path)) then - ! call test_failed(error, "The file '"//filename//"' could not be found."); return - ! end if + call load_npz(filename, arrays, stat) + call check(error, stat, "Trying to load an npz file that is an empty zip file should fail.") - ! call load_npz(path, stat=stat) - ! call check(error, stat, "An empty zip file should fail.") - ! end subroutine + call delete_file(filename) + end subroutine delete_file(filename) character(len=*), intent(in) :: filename diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 45b8b3976..d18d1244e 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -23,8 +23,9 @@ subroutine collect_zip(testsuite) new_unittest("unzip_empty_zip", unzip_empty_zip, should_fail=.true.), & new_unittest("unzip_zip_has_empty_file", unzip_zip_has_empty_file), & new_unittest("unzip_zip_has_txt_file", unzip_zip_has_txt_file), & - new_unittest("unzip_npy_array_empty_0_file", unzip_npy_array_empty_0_file), & - new_unittest("unzip_two_files", unzip_two_files) & + new_unittest("unzip_npz_array_empty_0_file", unzip_npz_array_empty_0_file), & + new_unittest("unzip_two_files", unzip_two_files), & + new_unittest("unzip_compressed_npz", unzip_compressed_npz) & ] end @@ -108,7 +109,7 @@ subroutine unzip_zip_has_txt_file(error) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end - subroutine unzip_npy_array_empty_0_file(error) + subroutine unzip_npz_array_empty_0_file(error) type(error_type), allocatable, intent(out) :: error integer :: stat @@ -140,22 +141,38 @@ subroutine unzip_two_files(error) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") end + subroutine unzip_compressed_npz(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(*), parameter :: filename = "two_files_compressed.npz" + character(:), allocatable :: path + + path = get_path(filename) + if (.not. allocated(path)) then + call test_failed(error, "The file '"//filename//"' could not be found."); return + end if + + call unzip(path, stat=stat) + call check(error, stat, "Listing the contents of a compressed npz file should not fail.") + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file character(:), allocatable :: path character(:), allocatable :: path_to_check - logical :: exists + logical :: is_existing path_to_check = zip_files_ctest//file - inquire(file=path_to_check, exist=exists) - if (exists) then + inquire(file=path_to_check, exist=is_existing) + if (is_existing) then path = path_to_check else path_to_check = zip_files_fpm//file - inquire(file=path_to_check, exist=exists) - if (exists) path = path_to_check + inquire(file=path_to_check, exist=is_existing) + if (is_existing) path = path_to_check end if end From 625f59b7a81a38e18146b0db8c14e49d9bd8e62d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 12 Aug 2024 01:02:37 +0530 Subject: [PATCH 066/146] Add forgotten file --- test/io/zip_files/two_files_compressed.npz | Bin 0 -> 415 bytes 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 test/io/zip_files/two_files_compressed.npz diff --git a/test/io/zip_files/two_files_compressed.npz b/test/io/zip_files/two_files_compressed.npz new file mode 100644 index 0000000000000000000000000000000000000000..ddd8cb2a915a199f9944331e45903f6e106cbe75 GIT binary patch literal 415 zcmWIWW@gc4U|`??Vnv2M6GQv{Ljfm)2t#5~QM`d(UO^=zg8;(}pb`-9g-{H$--y4G z7C3n#;8?)gd6S~%#4O2Mx*%_I=E8N07tEU$9}+ZWhWPyWDU-N_%DvBM`muJ2r>lr9 zVfra`%xabu*H$hO20b@6j)bO5X9A=c0#MwMrZDj`x;qSE?$`jeKLWoy(g?c4&5G+7 z*d-~<>mrRE6PDYy*k$JPuuU)gkbjFA=p;raU1rq40r?#i4xCWCK~w`Hh=d0fx;Bts fKu!fY8&z8eR2$f50p6@^Kt2N#5at1CX|SmPaLaYT literal 0 HcmV?d00001 From 2cd01443275744a4dfe62dc480979b8154f653e5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 12 Aug 2024 01:03:21 +0530 Subject: [PATCH 067/146] Try redirected import to satisfy compiler --- src/stdlib_io_np_load.fypp | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 0dccf149b..37165980d 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -6,12 +6,12 @@ !> Implementation of loading npy files into multidimensional arrays submodule(stdlib_io_np) stdlib_io_np_load - use stdlib_array + use stdlib_array, only: t_array_wrapper, t_array use stdlib_error, only: error_stop use stdlib_filesystem, only: exists, list_dir, temp_dir use stdlib_io_zip, only: unzip, unzipped_folder, zip_contents use stdlib_strings, only: to_string, starts_with - use stdlib_string_type, only: string_type, char + use stdlib_string_type, only: string_type, as_string => char implicit none contains @@ -147,14 +147,15 @@ contains integer :: i, io integer, allocatable :: vshape(:) character(len=:), allocatable :: this_type + character(len=:), allocatable :: path allocate(arrays(size(files))) do i = 1, size(files) - open(newunit=io, file=dir//char(files(i)), form='unformatted', access='stream', iostat=stat, iomsg=msg) + open(newunit=io, file=dir//as_string(files(i)), form='unformatted', access='stream', iostat=stat, iomsg=msg) if (stat /= 0) return - call get_descriptor(io, char(files(i)), this_type, vshape, stat, msg) + call get_descriptor(io, as_string(files(i)), this_type, vshape, stat, msg) if (stat /= 0) then close(io, status='delete'); return end if From 98bd3d4716994c04a069fced6c8649682d702983 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 12 Aug 2024 02:47:30 +0530 Subject: [PATCH 068/146] Use preprocessor to set the correct path to the test files --- test/CMakeLists.txt | 4 +++- test/io/CMakeLists.txt | 10 ++++++++++ test/io/test_zip.f90 | 20 +++++--------------- 3 files changed, 18 insertions(+), 16 deletions(-) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 4d83548db..490568967 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -30,4 +30,6 @@ add_subdirectory(system) add_subdirectory(quadrature) add_subdirectory(math) add_subdirectory(stringlist) -add_subdirectory(terminal) \ No newline at end of file +add_subdirectory(terminal) + +target_compile_definitions(test_zip PRIVATE TEST_ROOT_DIR="${CMAKE_CURRENT_SOURCE_DIR}") diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index f3185a2cf..7d29add51 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -5,6 +5,16 @@ set( ) fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) +set(hasCPP + test_zip.f90 +) + +if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") + set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-cpp") +elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") + set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-fpp") +endif() + ADDTEST(loadtxt) ADDTEST(savetxt) diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index d18d1244e..78d2f6d49 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -6,9 +6,6 @@ module test_zip public :: collect_zip - character(*), parameter :: zip_files_ctest = 'zip_files/' - character(*), parameter :: zip_files_fpm = 'test/io/'//zip_files_ctest - contains !> Collect all exported unit tests @@ -162,18 +159,11 @@ function get_path(file) result(path) character(*), intent(in) :: file character(:), allocatable :: path - character(:), allocatable :: path_to_check - logical :: is_existing - - path_to_check = zip_files_ctest//file - inquire(file=path_to_check, exist=is_existing) - if (is_existing) then - path = path_to_check - else - path_to_check = zip_files_fpm//file - inquire(file=path_to_check, exist=is_existing) - if (is_existing) path = path_to_check - end if +#ifdef TEST_ROOT_DIR + path = TEST_ROOT_DIR//'/io/zip_files/'//file +#else + path = 'test/io/zip_files/'//file +#endif end subroutine delete_file(filename) From 7533cb2770928ec95bfdf415dc94fa2e4be7bd54 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 12 Aug 2024 17:16:16 +0530 Subject: [PATCH 069/146] Add first test, configure cpp and fix some errors --- src/stdlib_io_np_load.fypp | 5 ++++- test/CMakeLists.txt | 9 ++++++++- test/io/CMakeLists.txt | 7 ++++--- test/io/test_np.f90 | 29 +++++++++++++++++++++++++++-- test/io/test_zip.f90 | 4 ---- test/io/zip_files/rand_2_3.npz | Bin 0 -> 312 bytes 6 files changed, 43 insertions(+), 11 deletions(-) create mode 100644 test/io/zip_files/rand_2_3.npz diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 37165980d..d0b781ef0 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -115,6 +115,8 @@ contains character(len=:), allocatable :: msg type(string_type), allocatable :: files(:) + if (present(iostat)) iostat = 0 + call unzip(filename, unzipped_folder, stat, msg) if (stat /= 0) then if (present(iostat)) iostat = stat @@ -152,7 +154,8 @@ contains allocate(arrays(size(files))) do i = 1, size(files) - open(newunit=io, file=dir//as_string(files(i)), form='unformatted', access='stream', iostat=stat, iomsg=msg) + path = dir//'/'//as_string(files(i)) + open(newunit=io, file=path, form='unformatted', access='stream', iostat=stat, iomsg=msg) if (stat /= 0) return call get_descriptor(io, as_string(files(i)), this_type, vshape, stat, msg) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 490568967..3c3377813 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -32,4 +32,11 @@ add_subdirectory(math) add_subdirectory(stringlist) add_subdirectory(terminal) -target_compile_definitions(test_zip PRIVATE TEST_ROOT_DIR="${CMAKE_CURRENT_SOURCE_DIR}") +set(setRootDir + test_np + test_zip +) + +foreach(target ${setRootDir}) + target_compile_definitions(${target} PRIVATE TEST_ROOT_DIR="${CMAKE_CURRENT_SOURCE_DIR}") +endforeach() diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 7d29add51..25148b3db 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -5,14 +5,15 @@ set( ) fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) -set(hasCPP +set(needsCPP + test_np.f90 test_zip.f90 ) if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") - set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-cpp") + set_source_files_properties(${needsCPP} PROPERTIES COMPILE_FLAGS "-cpp") elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") - set_source_files_properties(${hasCPP} PROPERTIES COMPILE_FLAGS "-fpp") + set_source_files_properties(${needsCPP} PROPERTIES COMPILE_FLAGS "-fpp") endif() ADDTEST(loadtxt) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 9e13d7c99..0c1b226aa 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -40,7 +40,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_nonexistent_file", npz_load_nonexistent_file, should_fail=.true.), & new_unittest("npz_load_invalid_dir", npz_load_invalid_dir, should_fail=.true.), & new_unittest("npz_load_empty_file", npz_load_empty_file, should_fail=.true.), & - new_unittest("npz_load_empty_zip", npz_load_empty_zip, should_fail=.true.) & + new_unittest("npz_load_empty_zip", npz_load_empty_zip, should_fail=.true.), & + new_unittest("npz_load_arr_empty_0", npz_load_arr_empty_0) & ] end subroutine collect_np @@ -710,6 +711,31 @@ subroutine npz_load_empty_zip(error) call delete_file(filename) end + subroutine npz_load_arr_empty_0(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + character(*), parameter :: filename = "empty_0.npz" + character(:), allocatable :: path + + path = get_path(filename) + call load_npz(path, arrays, stat) + call check(error, stat, "Loading an npz that contains a single empty array shouldn't fail.") + end + + !> Makes sure that we find the file when running both `ctest` and `fpm test`. + function get_path(file) result(path) + character(*), intent(in) :: file + character(:), allocatable :: path + +#ifdef TEST_ROOT_DIR + path = TEST_ROOT_DIR//'/io/zip_files/'//file +#else + path = 'test/io/zip_files/'//file +#endif + end + subroutine delete_file(filename) character(len=*), intent(in) :: filename @@ -718,7 +744,6 @@ subroutine delete_file(filename) open(newunit=io, file=filename) close(io, status="delete") end subroutine delete_file - end diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 78d2f6d49..9d27ea748 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -146,10 +146,6 @@ subroutine unzip_compressed_npz(error) character(:), allocatable :: path path = get_path(filename) - if (.not. allocated(path)) then - call test_failed(error, "The file '"//filename//"' could not be found."); return - end if - call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a compressed npz file should not fail.") end diff --git a/test/io/zip_files/rand_2_3.npz b/test/io/zip_files/rand_2_3.npz new file mode 100644 index 0000000000000000000000000000000000000000..f96ac9c7c53fd817c764ebcd6855b4ac51e618f8 GIT binary patch literal 312 zcmWIWW@gc4fB;2?hIJ?2{D%Tg1`&qDqM~>My}W`-Mg{?f4Nzq;da_@rZ$Km?Lm5N0 zdP-_>a*?`~g1Swbg}RP{dRl%_Nl{{6e11_%DoETdF{d~cC|;bASda?jYZ&P$7;EY% z)GCk-xN^${CV4bGvVY*kxXs98j{RQ#n(~|P-rH+5P4w+Naot|RJ8|OLl&AKKta2w# ut-Wp^;LXUS%Z%z-kY7NU6Y4h*)xZcM;a(5$W@Q5jFan`DkbVu~FaQ8dbWQ*O literal 0 HcmV?d00001 From cb1fa2f7bb64b0546d573484472521ae6903ef5b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Mon, 12 Aug 2024 23:21:39 +0530 Subject: [PATCH 070/146] Uncomment code and actually test it --- src/stdlib_io_np_load.fypp | 105 +++++++++++++++++++------------------ test/io/test_np.f90 | 15 +++++- 2 files changed, 66 insertions(+), 54 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index d0b781ef0..1abb66ad2 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -6,7 +6,7 @@ !> Implementation of loading npy files into multidimensional arrays submodule(stdlib_io_np) stdlib_io_np_load - use stdlib_array, only: t_array_wrapper, t_array + use stdlib_array use stdlib_error, only: error_stop use stdlib_filesystem, only: exists, list_dir, temp_dir use stdlib_io_zip, only: unzip, unzipped_folder, zip_contents @@ -148,68 +148,69 @@ contains integer :: i, io integer, allocatable :: vshape(:) - character(len=:), allocatable :: this_type - character(len=:), allocatable :: path + character(len=:), allocatable :: this_type, array_name, path allocate(arrays(size(files))) do i = 1, size(files) - path = dir//'/'//as_string(files(i)) + array_name = as_string(files(i)) + path = dir//'/'//array_name + open(newunit=io, file=path, form='unformatted', access='stream', iostat=stat, iomsg=msg) if (stat /= 0) return - call get_descriptor(io, as_string(files(i)), this_type, vshape, stat, msg) + call get_descriptor(io, array_name, this_type, vshape, stat, msg) if (stat /= 0) then close(io, status='delete'); return end if -! 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 - -! allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) -! if (stat /= 0) then -! msg = "Failed to allocate array of type '"//this_type//"' "//& -! & 'with total size of '//to_string(product(vshape)); return -! end if - -! select type (typed_array => arrays(i)%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 - -! 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 -! case default -! stat = 1; msg = 'Unsupported array type: '//this_type//'.'; return -! end select - -! close (io, status='delete') -! 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 + + allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) + if (stat /= 0) then + msg = "Failed to allocate array of type '"//this_type//"' "//& + & 'with total size of '//to_string(product(vshape)); return + end if + + select type (typed_array => arrays(i)%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 + + arrays(i)%array%name = array_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 + case default + stat = 1; msg = 'Unsupported array type: '//this_type//'.'; return + end select + + close (io, status='delete') + if (stat /= 0) return end do end diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 0c1b226aa..3fd8d6a06 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,8 +1,8 @@ module test_np - use stdlib_array, only : t_array_wrapper + use stdlib_array use stdlib_kinds, only : int8, int16, int32, int64, sp, dp use stdlib_io_np, only : save_npy, load_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 @@ -722,6 +722,17 @@ subroutine npz_load_arr_empty_0(error) path = get_path(filename) call load_npz(path, arrays, stat) call check(error, stat, "Loading an npz that contains a single empty array shouldn't fail.") + if (stat /= 0) return + call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") + if (size(arrays) /= 1) return + call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") + if (arrays(1)%array%name /= "arr_0.npy") return + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_1) + call check(error, size(typed_array%values) == 0, "Array in '"//filename//"' is supposed to be empty.") + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select end !> Makes sure that we find the file when running both `ctest` and `fpm test`. From 9acd33eb72321e9d429f4909e8760bf5d2f83b6f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 01:16:24 +0530 Subject: [PATCH 071/146] Add test that contains values --- src/stdlib_io_np_load.fypp | 19 +++++++++++++------ test/io/test_np.f90 | 27 ++++++++++++++++++++++++++- 2 files changed, 39 insertions(+), 7 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 1abb66ad2..2e3a279d8 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -150,6 +150,7 @@ contains integer, allocatable :: vshape(:) character(len=:), allocatable :: this_type, array_name, path + stat = 0 allocate(arrays(size(files))) do i = 1, size(files) @@ -175,26 +176,30 @@ contains call allocate_array_from_shape(array, vshape, stat) if (stat /= 0) then - msg = "Failed to allocate array of type '"//this_type//"'."; return + msg = "Failed to allocate array of type '"//this_type//"'."; + close(io, status='delete'); 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 + & 'with total size of '//to_string(product(vshape)) + close(io, status='delete'); return end if allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"' "//& - & 'with total size of '//to_string(product(vshape)); return + & 'with total size of '//to_string(product(vshape)) + close(io, status='delete'); return end if select type (typed_array => arrays(i)%array) class is (t_array_${t1[0]}$${k1}$_${rank}$) typed_array%values = array class default - msg = 'Failed to allocate values.'; stat = 1; return + msg = 'Failed to allocate values.'; stat = 1 + close(io, status='delete'); return end select arrays(i)%array%name = array_name @@ -202,11 +207,13 @@ contains #:endfor case default stat = 1; msg = 'Unsupported rank for array of type '//this_type//': '// & - & to_string(size(vshape))//'.'; return + & to_string(size(vshape))//'.' + close(io, status='delete'); return end select #:endfor case default - stat = 1; msg = 'Unsupported array type: '//this_type//'.'; return + stat = 1; msg = 'Unsupported array type: '//this_type//'.' + close(io, status='delete'); return end select close (io, status='delete') diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 3fd8d6a06..843bcc993 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -41,7 +41,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_invalid_dir", npz_load_invalid_dir, should_fail=.true.), & new_unittest("npz_load_empty_file", npz_load_empty_file, should_fail=.true.), & new_unittest("npz_load_empty_zip", npz_load_empty_zip, should_fail=.true.), & - new_unittest("npz_load_arr_empty_0", npz_load_arr_empty_0) & + new_unittest("npz_load_arr_empty_0", npz_load_arr_empty_0), & + new_unittest("npz_load_arr_rand_2_3", npz_load_arr_rand_2_3) & ] end subroutine collect_np @@ -735,6 +736,30 @@ subroutine npz_load_arr_empty_0(error) end select end + subroutine npz_load_arr_rand_2_3(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + character(*), parameter :: filename = "rand_2_3.npz" + character(:), allocatable :: path + + path = get_path(filename) + call load_npz(path, arrays, stat) + call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") + if (stat /= 0) return + call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") + if (size(arrays) /= 1) return + call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") + if (arrays(1)%array%name /= "arr_0.npy") return + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + call check(error, size(typed_array%values) == 6, "Array in '"//filename//"' is supposed to have 6 entries.") + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file From b446715edeb187d490126393c754ea1f1e0629bd Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 01:45:23 +0530 Subject: [PATCH 072/146] Add int example --- test/io/test_np.f90 | 34 ++++++++++++++++++++++++++++- test/io/zip_files/arange_10_20.npz | Bin 0 -> 344 bytes 2 files changed, 33 insertions(+), 1 deletion(-) create mode 100644 test/io/zip_files/arange_10_20.npz diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 843bcc993..1c61eb4f2 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -42,7 +42,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_empty_file", npz_load_empty_file, should_fail=.true.), & new_unittest("npz_load_empty_zip", npz_load_empty_zip, should_fail=.true.), & new_unittest("npz_load_arr_empty_0", npz_load_arr_empty_0), & - new_unittest("npz_load_arr_rand_2_3", npz_load_arr_rand_2_3) & + new_unittest("npz_load_arr_rand_2_3", npz_load_arr_rand_2_3), & + new_unittest("npz_load_arr_arange_10_20", npz_load_arr_arange_10_20) & ] end subroutine collect_np @@ -760,6 +761,37 @@ subroutine npz_load_arr_rand_2_3(error) end select end + subroutine npz_load_arr_arange_10_20(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat, i + character(*), parameter :: filename = "arange_10_20.npz" + character(:), allocatable :: path + + path = get_path(filename) + call load_npz(path, arrays, stat) + call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") + if (stat /= 0) return + call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") + if (size(arrays) /= 1) return + call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") + if (arrays(1)%array%name /= "arr_0.npy") return + select type (typed_array => arrays(1)%array) + class is (t_array_iint64_1) + call check(error, size(typed_array%values) == 10, "Array in '"//filename//"' is supposed to have 10 entries.") + if (size(typed_array%values) /= 10) return + call check(error, typed_array%values(1) == 10, "First entry is supposed to be 10.") + if (typed_array%values(1) /= 10) return + do i = 2, 10 + call check(error, typed_array%values(i) == typed_array%values(i-1) + 1, "Array is supposed to be an arange.") + if (typed_array%values(i) /= typed_array%values(i-1) + 1) return + end do + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file diff --git a/test/io/zip_files/arange_10_20.npz b/test/io/zip_files/arange_10_20.npz new file mode 100644 index 0000000000000000000000000000000000000000..da0e2960ad7823bcdad22b6e7f9eb9e555fe240b GIT binary patch literal 344 zcmWIWW@gc4fB;2?*YQ1x|Dk}BL4+Z(s3_h*FR!4IkwJjr0#q4{p6nOu8xYCJP{vTL zo|0OeT%>NLpl*|Cp{}E#o|a!!Qk0k%pI?-c3KDlq%qdOC@ln~g`sqSHzSiSGiqRf{0hRHP&FW`fe}Q) UgC@Y6l?^1o2!!T9nj0()0BIjK2LJ#7 literal 0 HcmV?d00001 From cb63bab6182790532d33f949f4232a94ee3a2aac Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 02:12:57 +0530 Subject: [PATCH 073/146] Add example including complex numbers --- test/io/test_np.f90 | 34 +++++++++++++++++++++++++++++++- test/io/zip_files/cmplx_arr.npz | Bin 0 -> 312 bytes 2 files changed, 33 insertions(+), 1 deletion(-) create mode 100644 test/io/zip_files/cmplx_arr.npz diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 1c61eb4f2..f15aab817 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -43,7 +43,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_empty_zip", npz_load_empty_zip, should_fail=.true.), & new_unittest("npz_load_arr_empty_0", npz_load_arr_empty_0), & new_unittest("npz_load_arr_rand_2_3", npz_load_arr_rand_2_3), & - new_unittest("npz_load_arr_arange_10_20", npz_load_arr_arange_10_20) & + new_unittest("npz_load_arr_arange_10_20", npz_load_arr_arange_10_20), & + new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx) & ] end subroutine collect_np @@ -792,6 +793,37 @@ subroutine npz_load_arr_arange_10_20(error) end select end + subroutine npz_load_arr_cmplx(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat, i + character(*), parameter :: filename = "cmplx_arr.npz" + character(:), allocatable :: path + + path = get_path(filename) + call load_npz(path, arrays, stat) + call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") + if (stat /= 0) return + call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") + if (size(arrays) /= 1) return + call check(error, arrays(1)%array%name == "cmplx.npy", "Wrong array name.") + if (arrays(1)%array%name /= "cmplx.npy") return + select type (typed_array => arrays(1)%array) + class is (t_array_cdp_1) + call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") + if (size(typed_array%values) /= 3) return + call check(error, typed_array%values(1) == cmplx(1_dp, 2_dp), "First complex number does not match.") + if (typed_array%values(1) /= cmplx(1_dp, 2_dp)) return + call check(error, typed_array%values(2) == cmplx(3_dp, 4_dp), "Second complex number does not match.") + if (typed_array%values(2) /= cmplx(3_dp, 4_dp)) return + call check(error, typed_array%values(3) == cmplx(5_dp, 6_dp), "Third complex number does not match.") + if (typed_array%values(3) /= cmplx(5_dp, 6_dp)) return + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file diff --git a/test/io/zip_files/cmplx_arr.npz b/test/io/zip_files/cmplx_arr.npz new file mode 100644 index 0000000000000000000000000000000000000000..36afc083d1010ecc0c22600b4163cc0a36714a7a GIT binary patch literal 312 zcmWIWW@gc4fB;2?v?E*O{zCyLg9t-%Zb43kUS2^ZBZC0L2BWgG<6he z703r%5a)cbhdRpvLUTZA0Vpj3r6n8!ycwBvnNd9p@(T!a0x=9UFoIZcuLpRuvVjB` MfzTXCzXov_0D>GitpET3 literal 0 HcmV?d00001 From 53d20363ab332501a6f368a8531b5a9a2a99c958 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 13:45:18 +0530 Subject: [PATCH 074/146] Use complex64 to satisfy MinGW32 --- test/io/test_np.f90 | 2 +- test/io/zip_files/cmplx_arr.npz | Bin 312 -> 288 bytes 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index f15aab817..ac3827d87 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -810,7 +810,7 @@ subroutine npz_load_arr_cmplx(error) call check(error, arrays(1)%array%name == "cmplx.npy", "Wrong array name.") if (arrays(1)%array%name /= "cmplx.npy") return select type (typed_array => arrays(1)%array) - class is (t_array_cdp_1) + class is (t_array_csp_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") if (size(typed_array%values) /= 3) return call check(error, typed_array%values(1) == cmplx(1_dp, 2_dp), "First complex number does not match.") diff --git a/test/io/zip_files/cmplx_arr.npz b/test/io/zip_files/cmplx_arr.npz index 36afc083d1010ecc0c22600b4163cc0a36714a7a..2492d368d7203d38444ea74673819d92813ee154 100644 GIT binary patch literal 288 zcmWIWW@gc4fB;1Xw!1zz|3d*Mg9t-%Zb43kUS2^ZBZC0L45%^~J=rhRHz1Ocp^Twg zJteg`xk%kgLER?VLS08eJuSbeq$n{jKEEg>6(sJKm{Xhz6fe$5EJy|NHH>vMbrfn9 zC;(gx3=Q@`CpiES5H|qv0w6x%5a7+oq|1!zDUh2%m=lO$pn(y@f_pK*o0SbDzzBrq KK>9L>!vFw^zd5P^ literal 312 zcmWIWW@gc4fB;2?v?E*O{zCyLg9t-%Zb43kUS2^ZBZC0L2BWgG<6he z703r%5a)cbhdRpvLUTZA0Vpj3r6n8!ycwBvnNd9p@(T!a0x=9UFoIZcuLpRuvVjB` MfzTXCzXov_0D>GitpET3 From 31d54b8103934ea06f3491f32920c653218e0f87 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 14:06:29 +0530 Subject: [PATCH 075/146] Use test for npz file containing two arrays --- test/io/test_np.f90 | 49 ++++++++++++++++++++++- test/io/zip_files/two_arr_iint64_rdp.npz | Bin 0 -> 554 bytes 2 files changed, 48 insertions(+), 1 deletion(-) create mode 100644 test/io/zip_files/two_arr_iint64_rdp.npz diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index ac3827d87..cd9d1bdc6 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -44,7 +44,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_arr_empty_0", npz_load_arr_empty_0), & new_unittest("npz_load_arr_rand_2_3", npz_load_arr_rand_2_3), & new_unittest("npz_load_arr_arange_10_20", npz_load_arr_arange_10_20), & - new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx) & + new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx), & + new_unittest("npz_load_two_arr_iint64_rdp", npz_load_two_arr_iint64_rdp) & ] end subroutine collect_np @@ -824,6 +825,52 @@ subroutine npz_load_arr_cmplx(error) end select end + subroutine npz_load_two_arr_iint64_rdp(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat, i + character(*), parameter :: filename = "two_arr_iint64_rdp.npz" + character(:), allocatable :: path + + path = get_path(filename) + call load_npz(path, arrays, stat) + call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") + if (stat /= 0) return + call check(error, size(arrays) == 2, "'"//filename//"' is supposed to contain two arrays.") + if (size(arrays) /= 2) return + call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") + if (arrays(1)%array%name /= "arr_0.npy") return + call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") + if (arrays(2)%array%name /= "arr_1.npy") return + select type (typed_array => arrays(1)%array) + class is (t_array_iint64_1) + call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") + if (size(typed_array%values) /= 3) return + call check(error, typed_array%values(1) == 1, "First integer does not match.") + if (typed_array%values(1) /= 1) return + call check(error, typed_array%values(2) == 2, "Second integer does not match.") + if (typed_array%values(2) /= 2) return + call check(error, typed_array%values(3) == 3, "Third integer does not match.") + if (typed_array%values(3) /= 3) return + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + select type (typed_array => arrays(2)%array) + class is (t_array_rdp_1) + call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") + if (size(typed_array%values) /= 3) return + call check(error, typed_array%values(1) == 1., "First number does not match.") + if (typed_array%values(1) /= 1.) return + call check(error, typed_array%values(2) == 1., "Second number does not match.") + if (typed_array%values(2) /= 1.) return + call check(error, typed_array%values(3) == 1., "Third number does not match.") + if (typed_array%values(3) /= 1.) return + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file diff --git a/test/io/zip_files/two_arr_iint64_rdp.npz b/test/io/zip_files/two_arr_iint64_rdp.npz new file mode 100644 index 0000000000000000000000000000000000000000..6b026b1ffbbdd29d1e4b9e19483bcd59a2ff24e8 GIT binary patch literal 554 zcmWIWW@gc4fB;2?JrhIw{zCyLg9t-nQBk~sUS2^ZBZC0L45%^~J=rhRHz1Ocp^Twg zJteg`xk%kgLER?PLS08eJuSbeq$n{jKEEg>6(sJKm{Xhz6fe$5EJy|NHH>vMbrfn9 zC;(iHQ1>uFX=W%Lfa0a~Zd20Hy<|w5m(u9wC5R6`*rU?{-i%DT%&74MiUttogeV4+ n4d5_=#~QjeP*`Bsb{VK0qzxQ00p6@^Amf;TFb_yC1Dgr}t2=DL literal 0 HcmV?d00001 From dbf5e7b54d4bb8e0045633df8d82b5eab2eb7cda Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 14:33:30 +0530 Subject: [PATCH 076/146] Add test for a compressed npz file --- test/io/test_np.f90 | 55 ++++++++++++++++-- test/io/test_zip.f90 | 2 +- test/io/zip_files/two_arr_iint64_rdp_comp.npz | Bin 0 -> 402 bytes test/io/zip_files/two_files_compressed.npz | Bin 415 -> 0 bytes 4 files changed, 52 insertions(+), 5 deletions(-) create mode 100644 test/io/zip_files/two_arr_iint64_rdp_comp.npz delete mode 100644 test/io/zip_files/two_files_compressed.npz diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index cd9d1bdc6..274957f89 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -45,7 +45,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_arr_rand_2_3", npz_load_arr_rand_2_3), & new_unittest("npz_load_arr_arange_10_20", npz_load_arr_arange_10_20), & new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx), & - new_unittest("npz_load_two_arr_iint64_rdp", npz_load_two_arr_iint64_rdp) & + new_unittest("npz_load_two_arr_iint64_rdp", npz_load_two_arr_iint64_rdp), & + new_unittest("npz_load_two_arr_iint64_rdp_comp", npz_load_two_arr_iint64_rdp_comp) & ] end subroutine collect_np @@ -798,7 +799,7 @@ subroutine npz_load_arr_cmplx(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) - integer :: stat, i + integer :: stat character(*), parameter :: filename = "cmplx_arr.npz" character(:), allocatable :: path @@ -829,13 +830,59 @@ subroutine npz_load_two_arr_iint64_rdp(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) - integer :: stat, i + integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp.npz" character(:), allocatable :: path path = get_path(filename) call load_npz(path, arrays, stat) - call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") + call check(error, stat, "Loading an npz file that contains valid nd_arrays shouldn't fail.") + if (stat /= 0) return + call check(error, size(arrays) == 2, "'"//filename//"' is supposed to contain two arrays.") + if (size(arrays) /= 2) return + call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") + if (arrays(1)%array%name /= "arr_0.npy") return + call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") + if (arrays(2)%array%name /= "arr_1.npy") return + select type (typed_array => arrays(1)%array) + class is (t_array_iint64_1) + call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") + if (size(typed_array%values) /= 3) return + call check(error, typed_array%values(1) == 1, "First integer does not match.") + if (typed_array%values(1) /= 1) return + call check(error, typed_array%values(2) == 2, "Second integer does not match.") + if (typed_array%values(2) /= 2) return + call check(error, typed_array%values(3) == 3, "Third integer does not match.") + if (typed_array%values(3) /= 3) return + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + select type (typed_array => arrays(2)%array) + class is (t_array_rdp_1) + call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") + if (size(typed_array%values) /= 3) return + call check(error, typed_array%values(1) == 1., "First number does not match.") + if (typed_array%values(1) /= 1.) return + call check(error, typed_array%values(2) == 1., "Second number does not match.") + if (typed_array%values(2) /= 1.) return + call check(error, typed_array%values(3) == 1., "Third number does not match.") + if (typed_array%values(3) /= 1.) return + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + end + + subroutine npz_load_two_arr_iint64_rdp_comp(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat, i + character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" + character(:), allocatable :: path + + path = get_path(filename) + call load_npz(path, arrays, stat) + call check(error, stat, "Loading a compressed npz file that contains valid nd_arrays shouldn't fail.") if (stat /= 0) return call check(error, size(arrays) == 2, "'"//filename//"' is supposed to contain two arrays.") if (size(arrays) /= 2) return diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 9d27ea748..51c000e75 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -142,7 +142,7 @@ subroutine unzip_compressed_npz(error) type(error_type), allocatable, intent(out) :: error integer :: stat - character(*), parameter :: filename = "two_files_compressed.npz" + character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" character(:), allocatable :: path path = get_path(filename) diff --git a/test/io/zip_files/two_arr_iint64_rdp_comp.npz b/test/io/zip_files/two_arr_iint64_rdp_comp.npz new file mode 100644 index 0000000000000000000000000000000000000000..43fdc578948fb412eb22361ca95eb9ad5144af19 GIT binary patch literal 402 zcmWIWW@gc4U|`??Vnv2M6GQv{Ljfm)2t#5~QM`d(UO^=zg8;(}pb`-9g-{H$--y4G z7C3n#;8?)gd6S~%#4O2Mx*%_I=E8N07tEU$9}+ZWhWPyWDU-N_%DvBM`muJ2r>lr9 zVfra`%xabu*H$hO20b@6j)bO5X9A=c0#Mws-fc=cx;qTf-QkVj9cd)EgU#SaLcbp~ z&=rhKy3DBI0rD=$>zq*QKvV-Gh=hj@x;BvWL9WBp)&bQ9_Dp~`D;vlhCLqiM(tKc3 E0crVfzW@LL literal 0 HcmV?d00001 diff --git a/test/io/zip_files/two_files_compressed.npz b/test/io/zip_files/two_files_compressed.npz deleted file mode 100644 index ddd8cb2a915a199f9944331e45903f6e106cbe75..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 415 zcmWIWW@gc4U|`??Vnv2M6GQv{Ljfm)2t#5~QM`d(UO^=zg8;(}pb`-9g-{H$--y4G z7C3n#;8?)gd6S~%#4O2Mx*%_I=E8N07tEU$9}+ZWhWPyWDU-N_%DvBM`muJ2r>lr9 zVfra`%xabu*H$hO20b@6j)bO5X9A=c0#MwMrZDj`x;qSE?$`jeKLWoy(g?c4&5G+7 z*d-~<>mrRE6PDYy*k$JPuuU)gkbjFA=p;raU1rq40r?#i4xCWCK~w`Hh=d0fx;Bts fKu!fY8&z8eR2$f50p6@^Kt2N#5at1CX|SmPaLaYT From 46acdb93554a3ae544d01832e1a54d4cda7630ce Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 17:33:50 +0530 Subject: [PATCH 077/146] Inject tmp folder so tests don't use the same one --- src/stdlib_io_np.fypp | 3 ++- src/stdlib_io_np_load.fypp | 18 ++++++++++++------ src/stdlib_io_zip.f90 | 14 +++++++------- test/io/test_np.f90 | 38 ++++++++++++++++++++++++++------------ 4 files changed, 47 insertions(+), 26 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index aef015e93..a248e44d1 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -121,11 +121,12 @@ 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_arrays(filename, arrays, iostat, iomsg) + module subroutine load_npz_to_arrays(filename, arrays, iostat, iomsg, tmp_dir) 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 + character(len=*), intent(in), optional :: tmp_dir end end interface diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 2e3a279d8..24671e8f6 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -9,7 +9,7 @@ submodule(stdlib_io_np) stdlib_io_np_load use stdlib_array use stdlib_error, only: error_stop use stdlib_filesystem, only: exists, list_dir, temp_dir - use stdlib_io_zip, only: unzip, unzipped_folder, zip_contents + use stdlib_io_zip, only: unzip, default_unzip_dir, zip_contents use stdlib_strings, only: to_string, starts_with use stdlib_string_type, only: string_type, as_string => char implicit none @@ -105,33 +105,39 @@ contains !> !> 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) + module subroutine load_npz_to_arrays(filename, arrays, iostat, iomsg, tmp_dir) 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 + character(*), intent(in), optional :: tmp_dir integer :: stat - character(len=:), allocatable :: msg + character(len=:), allocatable :: msg, unzip_dir type(string_type), allocatable :: files(:) if (present(iostat)) iostat = 0 + if (present(tmp_dir)) then + unzip_dir = tmp_dir + else + unzip_dir = default_unzip_dir + end if - call unzip(filename, unzipped_folder, stat, msg) + call unzip(filename, unzip_dir, stat, msg) if (stat /= 0) then if (present(iostat)) iostat = stat if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) return end if - call list_dir(unzipped_folder, files, stat, msg) + call list_dir(unzip_dir, files, stat, msg) if (stat /= 0) then if (present(iostat)) iostat = stat if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) return end if - call load_unzipped_files_to_arrays(files, unzipped_folder, arrays, stat, msg) + call load_unzipped_files_to_arrays(files, unzip_dir, arrays, stat, msg) if (stat /= 0) then if (present(iostat)) iostat = stat if (present(iomsg) .and. allocated(msg)) call move_alloc(msg, iomsg) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 5f6194145..83fd4bb1b 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -3,10 +3,10 @@ module stdlib_io_zip implicit none private - public :: unzip, unzipped_folder, zip_contents + public :: unzip, default_unzip_dir, zip_contents - character(*), parameter :: unzipped_folder = temp_dir//'/unzipped_files' - character(*), parameter :: zip_contents = unzipped_folder//'/zip_contents.txt' + character(*), parameter :: default_unzip_dir = temp_dir//'/unzipped_files' + character(*), parameter :: zip_contents = default_unzip_dir//'/zip_contents.txt' contains @@ -22,16 +22,16 @@ subroutine unzip(filename, outputdir, stat, msg) if (present(outputdir)) then output_dir = outputdir else - output_dir = unzipped_folder + output_dir = default_unzip_dir end if if (present(stat)) stat = 0 run_stat = 0 - call run('rm -rf '//unzipped_folder, run_stat) + call run('rm -rf '//default_unzip_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat - if (present(msg)) msg = "Error removing folder '"//unzipped_folder//"'." + if (present(msg)) msg = "Error removing folder '"//default_unzip_dir//"'." return end if @@ -44,7 +44,7 @@ subroutine unzip(filename, outputdir, stat, msg) end if end if - call run('unzip '//filename//' -d '//unzipped_folder, run_stat) + call run('unzip '//filename//' -d '//output_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) msg = "Error unzipping '"//filename//"'." diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 274957f89..47785d73d 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,5 +1,6 @@ module test_np use stdlib_array + use stdlib_filesystem, only : temp_dir use stdlib_kinds, only : int8, int16, int32, int64, sp, dp use stdlib_io_np, only : save_npy, load_npy, load_npz use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed @@ -659,9 +660,10 @@ subroutine npz_load_nonexistent_file(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat - character(len=*), parameter :: filename = "nonexistent.npz" + character(*), parameter :: filename = "nonexistent.npz" + character(*), parameter :: tmp = temp_dir//"nonexistent" - call load_npz(filename, arrays, stat) + call load_npz(filename, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading a non-existent npz file should fail.") end @@ -672,9 +674,11 @@ subroutine npz_load_invalid_dir(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat - character(len=*), parameter :: filename = "." + character(*), parameter :: filename = "." + character(*), parameter :: tmp = temp_dir//"invalid_dir" - call load_npz(filename, arrays, stat) + + call load_npz(filename, arrays, stat, tmp_dir=tmp) call check(error, stat, "A file name that points towards a directory should fail.") end @@ -686,11 +690,12 @@ subroutine npz_load_empty_file(error) integer :: io, stat character(*), parameter :: filename = "empty_file" + character(*), parameter :: tmp = temp_dir//"empty_file" open(newunit=io, file=filename) close(io) - call load_npz(filename, arrays, stat) + call load_npz(filename, arrays, stat, tmp_dir=tmp) call check(error, stat, "Try loading an empty file as an npz file should fail.") call delete_file(filename) @@ -704,13 +709,14 @@ subroutine npz_load_empty_zip(error) integer :: io, stat character(*), parameter :: filename = "empty.zip" + character(*), parameter :: tmp = temp_dir//"empty_zip" 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 load_npz(filename, arrays, stat) + call load_npz(filename, arrays, stat, tmp_dir=tmp) call check(error, stat, "Trying to load an npz file that is an empty zip file should fail.") call delete_file(filename) @@ -722,10 +728,12 @@ subroutine npz_load_arr_empty_0(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "empty_0.npz" + character(*), parameter :: tmp = temp_dir//"empty_0" character(:), allocatable :: path + path = get_path(filename) - call load_npz(path, arrays, stat) + call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz that contains a single empty array shouldn't fail.") if (stat /= 0) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") @@ -746,10 +754,11 @@ subroutine npz_load_arr_rand_2_3(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "rand_2_3.npz" + character(*), parameter :: tmp = temp_dir//"rand_2_3" character(:), allocatable :: path path = get_path(filename) - call load_npz(path, arrays, stat) + call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") if (stat /= 0) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") @@ -770,10 +779,12 @@ subroutine npz_load_arr_arange_10_20(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat, i character(*), parameter :: filename = "arange_10_20.npz" + character(*), parameter :: tmp = temp_dir//"arange_10_20" + character(:), allocatable :: path path = get_path(filename) - call load_npz(path, arrays, stat) + call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") if (stat /= 0) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") @@ -801,10 +812,11 @@ subroutine npz_load_arr_cmplx(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "cmplx_arr.npz" + character(*), parameter :: tmp = temp_dir//"cmplx_arr" character(:), allocatable :: path path = get_path(filename) - call load_npz(path, arrays, stat) + call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") if (stat /= 0) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") @@ -832,10 +844,11 @@ subroutine npz_load_two_arr_iint64_rdp(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp.npz" + character(*), parameter :: tmp = temp_dir//"two_arr_iint64_rdp" character(:), allocatable :: path path = get_path(filename) - call load_npz(path, arrays, stat) + call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains valid nd_arrays shouldn't fail.") if (stat /= 0) return call check(error, size(arrays) == 2, "'"//filename//"' is supposed to contain two arrays.") @@ -878,10 +891,11 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat, i character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" + character(*), parameter :: tmp = temp_dir//"two_arr_iint64_rdp_comp" character(:), allocatable :: path path = get_path(filename) - call load_npz(path, arrays, stat) + call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading a compressed npz file that contains valid nd_arrays shouldn't fail.") if (stat /= 0) return call check(error, size(arrays) == 2, "'"//filename//"' is supposed to contain two arrays.") From a91f083d804f68676c59c7e2e06c025c264b1e23 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 21:56:46 +0530 Subject: [PATCH 078/146] Add zip compression with tests --- src/stdlib_io_zip.f90 | 35 ++++++++++++++- test/io/test_zip.f90 | 99 ++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 132 insertions(+), 2 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 83fd4bb1b..d35967451 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -1,15 +1,48 @@ module stdlib_io_zip use stdlib_filesystem, only: exists, run, temp_dir + use stdlib_string_type, only: string_type, char implicit none private - public :: unzip, default_unzip_dir, zip_contents + public :: zip, unzip, default_unzip_dir, zip_contents character(*), parameter :: default_unzip_dir = temp_dir//'/unzipped_files' character(*), parameter :: zip_contents = default_unzip_dir//'/zip_contents.txt' + character(*), parameter :: default_zip_dir = temp_dir//'.' contains + subroutine zip(output_file, files, stat, msg) + character(*), intent(in) :: output_file + type(string_type), intent(in) :: files(:) + integer, intent(out), optional :: stat + character(len=:), allocatable, intent(out), optional :: msg + + integer :: run_stat, i + character(:), allocatable :: files_str + + if (present(stat)) stat = 0 + run_stat = 0 + + if (trim(output_file) == '') then + if (present(stat)) stat = 1 + if (present(msg)) msg = "Output file name is empty." + return + end if + + files_str = '' + do i = 1, size(files) + files_str = files_str//' '//char(files(i)) + end do + + call run('zip '//output_file//files_str, run_stat) + if (run_stat /= 0) then + if (present(stat)) stat = run_stat + if (present(msg)) msg = "Error creating zip file '"//output_file//"'." + return + end if + end + subroutine unzip(filename, outputdir, stat, msg) character(len=*), intent(in) :: filename character(len=*), intent(in), optional :: outputdir diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 51c000e75..711677315 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -1,5 +1,6 @@ module test_zip use stdlib_io_zip + use stdlib_string_type, only : string_type, char use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private @@ -22,7 +23,12 @@ subroutine collect_zip(testsuite) new_unittest("unzip_zip_has_txt_file", unzip_zip_has_txt_file), & new_unittest("unzip_npz_array_empty_0_file", unzip_npz_array_empty_0_file), & new_unittest("unzip_two_files", unzip_two_files), & - new_unittest("unzip_compressed_npz", unzip_compressed_npz) & + new_unittest("unzip_compressed_npz", unzip_compressed_npz), & + new_unittest("zip_nonexistent_file", zip_nonexistent_file, should_fail=.true.), & + new_unittest("zip_invalid_file", zip_invalid_file, should_fail=.true.), & + new_unittest("zip_empty_file", zip_empty_file), & + new_unittest("zip_invalid_output_file", zip_invalid_output_file, should_fail=.true.), & + new_unittest("zip_two_files", zip_two_files) & ] end @@ -150,6 +156,97 @@ subroutine unzip_compressed_npz(error) call check(error, stat, "Listing the contents of a compressed npz file should not fail.") end + subroutine zip_nonexistent_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(*), parameter :: output_file = "temp.zip" + character(*), parameter :: input_file = "nonexistent" + type(string_type), allocatable :: files(:) + + files = [string_type(input_file)] + + call zip(output_file, files, stat) + call check(error, stat, "Compressing a non-existent file should fail.") + end + + subroutine zip_invalid_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat + character(*), parameter :: output_file = "temp.zip" + character(*), parameter :: input_file = "." + type(string_type), allocatable :: files(:) + + files = [string_type(input_file)] + + call zip(output_file, files, stat) + call check(error, stat, "Compressing an invalid file should fail.") + end + + subroutine zip_empty_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat, unit + character(*), parameter :: output_file = "temp.zip" + character(*), parameter :: input_file = "abc.txt" + type(string_type), allocatable :: files(:) + + files = [string_type(input_file)] + + open(newunit= unit, file=input_file) + close(unit) + + call zip(output_file, files, stat) + call check(error, stat, "Compressing a valid empty file should not fail.") + + call delete_file(input_file) + call delete_file(output_file) + end + + subroutine zip_invalid_output_file(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat, unit + character(*), parameter :: output_file = " " + character(*), parameter :: input_file = "abc.txt" + type(string_type), allocatable :: files(:) + + files = [string_type(input_file)] + + open(newunit=unit, file=input_file) + close(unit) + + call zip(output_file, files, stat) + call check(error, stat, "Providing an empty output file should fail.") + + call delete_file(input_file) + end + + subroutine zip_two_files(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat, unit + character(*), parameter :: output_file = "temp.zip" + character(*), parameter :: input_file_1 = "abc.txt" + character(*), parameter :: input_file_2 = "def.txt" + type(string_type), allocatable :: files(:) + + files = [string_type(input_file_1), string_type(input_file_2)] + + open(newunit=unit, file=input_file_1) + close(unit) + open(newunit=unit, file=input_file_2) + close(unit) + + call zip(output_file, files, stat) + call check(error, stat, "Compressing two valid files should not fail.") + + call delete_file(input_file_1) + call delete_file(input_file_2) + call delete_file(output_file) + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file From 5fcd7d9aba3b159ce729c5b7024cc34a287cfbd4 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Tue, 13 Aug 2024 22:11:15 +0530 Subject: [PATCH 079/146] Add zip as msys2 package --- .github/workflows/ci_windows.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 4c46eecc1..c20ab0a77 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -34,6 +34,7 @@ jobs: mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja unzip + zip - run: >- PATH=$PATH:/mingw64/bin/ cmake From cc633e01677e4535e22b9213e75fd4e83778aa77 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 00:38:27 +0530 Subject: [PATCH 080/146] Implement save_npz --- src/stdlib_io_np.fypp | 2 +- src/stdlib_io_np_load.fypp | 2 +- src/stdlib_io_np_save.fypp | 67 +++++++++++++++++++++++++++++++++++++- 3 files changed, 68 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index a248e44d1..949f04b29 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -137,7 +137,7 @@ module stdlib_io_np interface 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(*) + 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 24671e8f6..75bf5b8f7 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -9,7 +9,7 @@ submodule(stdlib_io_np) stdlib_io_np_load use stdlib_array use stdlib_error, only: error_stop use stdlib_filesystem, only: exists, list_dir, temp_dir - use stdlib_io_zip, only: unzip, default_unzip_dir, zip_contents + use stdlib_io_zip, only: unzip, default_unzip_dir, zip_contents, zip use stdlib_strings, only: to_string, starts_with use stdlib_string_type, only: string_type, as_string => char implicit none diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 197325437..4eb477c47 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -6,8 +6,12 @@ !> Implementation of saving multidimensional arrays to npy files submodule(stdlib_io_np) stdlib_io_np_save + use stdlib_array use stdlib_error, only: error_stop + use stdlib_filesystem, only: run use stdlib_strings, only: to_string + use stdlib_string_type, only: string_type, char + use stdlib_io_zip, only: zip implicit none contains @@ -137,18 +141,79 @@ contains !> ([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(*) + 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 + integer :: i, j, stat logical :: is_compressed + character(len=:), allocatable :: msg + type(string_type), allocatable :: files(:) + + if (present(iostat)) iostat = 0 if (present(compressed)) then is_compressed = compressed else is_compressed = .false. end if + + allocate(files(size(arrays))) + do i = 1, size(arrays) + select type (typed_array => arrays(i)%array) +#:for k1, t1 in KINDS_TYPES +#:for rank in RANKS + class is (t_array_${t1[0]}$${k1}$_${rank}$) + do j = 1, size(files) + if (char(files(j)) == typed_array%name) then + if (present(iostat)) iostat = 1 + if (present(iomsg)) iomsg = "Error saving array to file '"//filename// & + "': Array with the same name '"//typed_array%name//"' already exists." + call delete_files(files) + return + end if + end do + + call save_npy(typed_array%name, typed_array%values, stat, msg) + if (stat /= 0) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = msg + call delete_files(files) + return + end if + + files = [files, string_type(typed_array%name)] +#:endfor +#:endfor + class default + if (present(iostat)) iostat = 1 + if (present(iomsg)) iomsg = "Error saving array to file '"//filename//"': Unsupported array type." + call delete_files(files) + return + end select + end do + + call zip(filename, files, stat, msg) + if (stat /= 0) then + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = msg + call delete_files(files) + return + end if + + call delete_files(files) + end + + subroutine delete_files(files) + type(string_type), allocatable, intent(in) :: files(:) + + integer :: i, unit + + do i = 1, size(files) + open(newunit=unit, file=char(files(i))) + close(unit, status="delete") + end do end end From 1133a59ea68894f82b07460e6529cc76b2863e28 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 00:46:12 +0530 Subject: [PATCH 081/146] Use redirected import to satisfy intel once more --- src/stdlib_io_np_save.fypp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 4eb477c47..271d3449a 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -10,7 +10,7 @@ submodule(stdlib_io_np) stdlib_io_np_save use stdlib_error, only: error_stop use stdlib_filesystem, only: run use stdlib_strings, only: to_string - use stdlib_string_type, only: string_type, char + use stdlib_string_type, only: string_type, as_string => char use stdlib_io_zip, only: zip implicit none @@ -167,7 +167,7 @@ contains #:for rank in RANKS class is (t_array_${t1[0]}$${k1}$_${rank}$) do j = 1, size(files) - if (char(files(j)) == typed_array%name) then + if (as_string(files(j)) == typed_array%name) then if (present(iostat)) iostat = 1 if (present(iomsg)) iomsg = "Error saving array to file '"//filename// & "': Array with the same name '"//typed_array%name//"' already exists." @@ -212,7 +212,7 @@ contains integer :: i, unit do i = 1, size(files) - open(newunit=unit, file=char(files(i))) + open(newunit=unit, file=as_string(files(i))) close(unit, status="delete") end do end From ad6e96e3b19f41c437b986e0472a030584e70876 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 16:41:19 +0530 Subject: [PATCH 082/146] Improve tests by checking error, add a test for npz_write --- src/stdlib_io_np.fypp | 13 ++-- src/stdlib_io_np_save.fypp | 6 +- src/stdlib_io_zip.f90 | 2 +- test/io/test_filesystem.f90 | 27 +++---- test/io/test_np.f90 | 136 ++++++++++++++++++++++++------------ 5 files changed, 112 insertions(+), 72 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 949f04b29..aa3cccbec 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -74,7 +74,7 @@ module stdlib_io_np implicit none private - public :: load_npy, save_npy, load_npz, save_npz + public :: load_npy, save_npy, load_npz, save_npz, add_array character(len=*), parameter :: & type_iint8 = " 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) + module subroutine save_npz_from_arrays(filename, arrays, iostat, iomsg, compressed) 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 + !> If true, the file is saved in compressed format. The default is false. + logical, intent(in), optional :: compressed end end interface @@ -159,4 +159,9 @@ module stdlib_io_np #:endfor #:endfor end interface + +contains + + subroutine add_array() + end end diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 271d3449a..be36ca4a6 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -139,13 +139,13 @@ 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_arrays(filename, arrays, compressed, iostat, iomsg) + module subroutine save_npz_from_arrays(filename, arrays, iostat, iomsg, compressed) 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 + !> If true, the file is saved in compressed format. The default is false. + logical, intent(in), optional :: compressed integer :: i, j, stat logical :: is_compressed diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index d35967451..9f8bba418 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -26,7 +26,7 @@ subroutine zip(output_file, files, stat, msg) if (trim(output_file) == '') then if (present(stat)) stat = 1 - if (present(msg)) msg = "Output file name is empty." + if (present(msg)) msg = "Output file is empty." return end if diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index fdb0d9fb1..6ef6f2512 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -97,14 +97,12 @@ subroutine fs_list_dir_empty(error) call run('rm -rf '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return end if call run('mkdir '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if call list_dir(temp_list_dir, files, stat) @@ -124,20 +122,17 @@ subroutine fs_list_dir_one_file(error) call run('rm -rf '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return end if call run('mkdir '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if call run('touch '//temp_list_dir//'/'//filename, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating file'"//filename//"' in directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Creating file'"//filename//"' in directory '"//temp_list_dir//"' failed."); return end if call list_dir(temp_list_dir, files, stat) @@ -159,26 +154,22 @@ subroutine fs_list_dir_two_files(error) call run('rm -rf '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Removing directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return end if call run('mkdir '//temp_list_dir, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if call run('touch '//temp_list_dir//'/'//filename1, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return end if call run('touch '//temp_list_dir//'/'//filename2, stat=stat) if (stat /= 0) then - call test_failed(error, "Creating file 2 in directory '"//temp_list_dir//"' failed.") - return + call test_failed(error, "Creating file 2 in directory '"//temp_list_dir//"' failed."); return end if call list_dir(temp_list_dir, files, stat) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 47785d73d..d357bb187 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -2,7 +2,7 @@ module test_np use stdlib_array use stdlib_filesystem, only : temp_dir use stdlib_kinds, only : int8, int16, int32, int64, sp, dp - use stdlib_io_np, only : save_npy, load_npy, load_npz + use stdlib_io_np, only : save_npy, load_npy, load_npz, save_npz use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private @@ -47,7 +47,9 @@ subroutine collect_np(testsuite) new_unittest("npz_load_arr_arange_10_20", npz_load_arr_arange_10_20), & new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx), & new_unittest("npz_load_two_arr_iint64_rdp", npz_load_two_arr_iint64_rdp), & - new_unittest("npz_load_two_arr_iint64_rdp_comp", npz_load_two_arr_iint64_rdp_comp) & + new_unittest("npz_load_two_arr_iint64_rdp_comp", npz_load_two_arr_iint64_rdp_comp), & + new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.), & + new_unittest("npz_save_rdp_2", npz_save_rdp_2) & ] end subroutine collect_np @@ -735,11 +737,11 @@ subroutine npz_load_arr_empty_0(error) path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz that contains a single empty array shouldn't fail.") - if (stat /= 0) return + if (allocated(error)) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") - if (size(arrays) /= 1) return + if (allocated(error)) return call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") - if (arrays(1)%array%name /= "arr_0.npy") return + if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_rdp_1) call check(error, size(typed_array%values) == 0, "Array in '"//filename//"' is supposed to be empty.") @@ -760,11 +762,11 @@ subroutine npz_load_arr_rand_2_3(error) path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") - if (stat /= 0) return + if (allocated(error)) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") - if (size(arrays) /= 1) return + if (allocated(error)) return call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") - if (arrays(1)%array%name /= "arr_0.npy") return + if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_rdp_2) call check(error, size(typed_array%values) == 6, "Array in '"//filename//"' is supposed to have 6 entries.") @@ -786,20 +788,20 @@ subroutine npz_load_arr_arange_10_20(error) path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") - if (stat /= 0) return + if (allocated(error)) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") - if (size(arrays) /= 1) return + if (allocated(error)) return call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") - if (arrays(1)%array%name /= "arr_0.npy") return + if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_iint64_1) call check(error, size(typed_array%values) == 10, "Array in '"//filename//"' is supposed to have 10 entries.") - if (size(typed_array%values) /= 10) return + if (allocated(error)) return call check(error, typed_array%values(1) == 10, "First entry is supposed to be 10.") - if (typed_array%values(1) /= 10) return + if (allocated(error)) return do i = 2, 10 call check(error, typed_array%values(i) == typed_array%values(i-1) + 1, "Array is supposed to be an arange.") - if (typed_array%values(i) /= typed_array%values(i-1) + 1) return + if (allocated(error)) return end do class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") @@ -818,21 +820,21 @@ subroutine npz_load_arr_cmplx(error) path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") - if (stat /= 0) return + if (allocated(error)) return call check(error, size(arrays) == 1, "'"//filename//"' is supposed to contain a single array.") - if (size(arrays) /= 1) return + if (allocated(error)) return call check(error, arrays(1)%array%name == "cmplx.npy", "Wrong array name.") - if (arrays(1)%array%name /= "cmplx.npy") return + if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_csp_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") - if (size(typed_array%values) /= 3) return + if (allocated(error)) return call check(error, typed_array%values(1) == cmplx(1_dp, 2_dp), "First complex number does not match.") - if (typed_array%values(1) /= cmplx(1_dp, 2_dp)) return + if (allocated(error)) return call check(error, typed_array%values(2) == cmplx(3_dp, 4_dp), "Second complex number does not match.") - if (typed_array%values(2) /= cmplx(3_dp, 4_dp)) return + if (allocated(error)) return call check(error, typed_array%values(3) == cmplx(5_dp, 6_dp), "Third complex number does not match.") - if (typed_array%values(3) /= cmplx(5_dp, 6_dp)) return + if (allocated(error)) return class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") end select @@ -850,36 +852,36 @@ subroutine npz_load_two_arr_iint64_rdp(error) path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains valid nd_arrays shouldn't fail.") - if (stat /= 0) return + if (allocated(error)) return call check(error, size(arrays) == 2, "'"//filename//"' is supposed to contain two arrays.") - if (size(arrays) /= 2) return + if (allocated(error)) return call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") - if (arrays(1)%array%name /= "arr_0.npy") return + if (allocated(error)) return call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") - if (arrays(2)%array%name /= "arr_1.npy") return + if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_iint64_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") - if (size(typed_array%values) /= 3) return + if (allocated(error)) return call check(error, typed_array%values(1) == 1, "First integer does not match.") - if (typed_array%values(1) /= 1) return + if (allocated(error)) return call check(error, typed_array%values(2) == 2, "Second integer does not match.") - if (typed_array%values(2) /= 2) return + if (allocated(error)) return call check(error, typed_array%values(3) == 3, "Third integer does not match.") - if (typed_array%values(3) /= 3) return + if (allocated(error)) return class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") end select select type (typed_array => arrays(2)%array) class is (t_array_rdp_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") - if (size(typed_array%values) /= 3) return + if (allocated(error)) return call check(error, typed_array%values(1) == 1., "First number does not match.") - if (typed_array%values(1) /= 1.) return + if (allocated(error)) return call check(error, typed_array%values(2) == 1., "Second number does not match.") - if (typed_array%values(2) /= 1.) return + if (allocated(error)) return call check(error, typed_array%values(3) == 1., "Third number does not match.") - if (typed_array%values(3) /= 1.) return + if (allocated(error)) return class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") end select @@ -889,7 +891,7 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) - integer :: stat, i + integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" character(*), parameter :: tmp = temp_dir//"two_arr_iint64_rdp_comp" character(:), allocatable :: path @@ -897,41 +899,83 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading a compressed npz file that contains valid nd_arrays shouldn't fail.") - if (stat /= 0) return + if (allocated(error)) return call check(error, size(arrays) == 2, "'"//filename//"' is supposed to contain two arrays.") - if (size(arrays) /= 2) return + if (allocated(error)) return call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") - if (arrays(1)%array%name /= "arr_0.npy") return + if (allocated(error)) return call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") - if (arrays(2)%array%name /= "arr_1.npy") return + if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_iint64_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") - if (size(typed_array%values) /= 3) return + if (allocated(error)) return call check(error, typed_array%values(1) == 1, "First integer does not match.") - if (typed_array%values(1) /= 1) return + if (allocated(error)) return call check(error, typed_array%values(2) == 2, "Second integer does not match.") - if (typed_array%values(2) /= 2) return + if (allocated(error)) return call check(error, typed_array%values(3) == 3, "Third integer does not match.") - if (typed_array%values(3) /= 3) return + if (allocated(error)) return class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") end select select type (typed_array => arrays(2)%array) class is (t_array_rdp_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") - if (size(typed_array%values) /= 3) return + if (allocated(error)) return call check(error, typed_array%values(1) == 1., "First number does not match.") - if (typed_array%values(1) /= 1.) return + if (allocated(error)) return call check(error, typed_array%values(2) == 1., "Second number does not match.") - if (typed_array%values(2) /= 1.) return + if (allocated(error)) return call check(error, typed_array%values(3) == 1., "Third number does not match.") - if (typed_array%values(3) /= 1.) return + if (allocated(error)) return class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") end select end + subroutine npz_save_empty_array_input(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + character(*), parameter :: filename = "output.npz" + + allocate(arrays(0)) + call save_npz(filename, arrays, stat) + call check(error, stat, "Trying to save an empty array fail.") + end + + subroutine npz_save_rdp_2(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + character(*), parameter :: filename = "npz_save_rdp_2.npz" + character(*), parameter :: arr_name = "arr_0.npy" + real(dp), allocatable :: input(:,:), output(:,:) + + allocate(input(10, 4)) + call random_number(input) + ! call add_array(arrays, input) + + ! call save_npz(filename, arrays, stat) + ! call check(error, stat, "Writing of npz file failed") + ! if (allocated(error)) return + + ! call load_npy(filename, output, stat) + ! call delete_file(filename) + + ! call check(error, stat, "Reading of npy file failed") + ! if (allocated(error)) return + + ! call check(error, size(output), size(input)) + ! if (allocated(error)) return + + ! call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & + ! "Precision loss when rereading array") + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file From b6f2f69e1002c84695e48f84711de2caa88d1419 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 18:43:30 +0530 Subject: [PATCH 083/146] Implement add_array --- src/stdlib_io_np.fypp | 22 +++++++++++++---- src/stdlib_io_np_save.fypp | 48 ++++++++++++++++++++++++++++++++++++++ test/io/test_np.f90 | 16 +++++++++---- 3 files changed, 77 insertions(+), 9 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index aa3cccbec..dbd125420 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -160,8 +160,22 @@ module stdlib_io_np #:endfor end interface -contains - - subroutine add_array() - end + interface add_array +#:for k1, t1 in KINDS_TYPES +#:for rank in RANKS + module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, name, stat, msg) + !> Array of arrays to which the array is to be added. + type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) + !> Array to be added. + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + !> Name of the array to be added. + character(len=*), intent(in) :: name + !> Status of addition. + integer, intent(out), optional :: stat + !> Error message. + character(len=:), allocatable, intent(out), optional :: msg + end +#:endfor +#:endfor + end interface end diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index be36ca4a6..7a86cda8b 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -133,6 +133,54 @@ contains end if end #:endfor +#:endfor + +#:for k1, t1 in KINDS_TYPES +#:for rank in RANKS + module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, name, stat, msg) + !> Array of arrays to which the array is to be added. + type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) + !> Array to be added. + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + !> Name of the array to be added. + character(len=*), intent(in) :: name + !> Status of addition. + integer, intent(out), optional :: stat + !> Error message. + character(len=:), allocatable, intent(out), optional :: msg + + integer :: i + type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr + + if (present(stat)) stat = 0 + + if (trim(name) == '') then + if (present(stat)) stat = 1 + if (present(msg)) msg = "Array name cannot be empty." + return + end if + + t_arr%name = name + t_arr%values = array + + if (.not. allocated(arrays)) then + allocate(arrays(1)) + allocate(arrays(1)%array, source=t_arr) + return + end if + + do i = 1, size(arrays) + if (arrays(i)%array%name == name) then + if (present(stat)) stat = 1 + if (present(msg)) msg = "Array with the same name '"//name//"' already exists." + return + end if + end do + + allocate(arrays(size(arrays) + 1)) + arrays(size(arrays))%array = t_arr + end +#:endfor #:endfor !> Version: experimental diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index d357bb187..5f9273f26 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -2,7 +2,7 @@ module test_np use stdlib_array use stdlib_filesystem, only : temp_dir use stdlib_kinds, only : int8, int16, int32, int64, sp, dp - use stdlib_io_np, only : save_npy, load_npy, load_npz, save_npz + use stdlib_io_np, only : save_npy, load_npy, load_npz, add_array, save_npz use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private @@ -953,11 +953,17 @@ subroutine npz_save_rdp_2(error) integer :: stat character(*), parameter :: filename = "npz_save_rdp_2.npz" character(*), parameter :: arr_name = "arr_0.npy" - real(dp), allocatable :: input(:,:), output(:,:) + real(dp), allocatable :: input_array(:,:), output(:,:) - allocate(input(10, 4)) - call random_number(input) - ! call add_array(arrays, input) + allocate(input_array(10, 4)) + call random_number(input_array) + call add_array(arrays, input_array, arr_name, stat) + call check(error, stat, "Error adding an array to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") + if (allocated(error)) return + call check(error, arrays(1)%array%name == arr_name, "Wrong array name.") + if (allocated(error)) return ! call save_npz(filename, arrays, stat) ! call check(error, stat, "Writing of npz file failed") From 1aacaa9c2b451cbbe3be389caee71a97c5eba077 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 19:00:47 +0530 Subject: [PATCH 084/146] Extract arr_size to satisfy Intel --- src/stdlib_io_np_save.fypp | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 7a86cda8b..9af0c82cf 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -149,7 +149,7 @@ contains !> Error message. character(len=:), allocatable, intent(out), optional :: msg - integer :: i + integer :: i, arr_size type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr if (present(stat)) stat = 0 @@ -169,7 +169,8 @@ contains return end if - do i = 1, size(arrays) + arr_size = size(arrays) + do i = 1, arr_size if (arrays(i)%array%name == name) then if (present(stat)) stat = 1 if (present(msg)) msg = "Array with the same name '"//name//"' already exists." @@ -177,8 +178,9 @@ contains end if end do - allocate(arrays(size(arrays) + 1)) - arrays(size(arrays))%array = t_arr + arr_size = arr_size + 1 + allocate(arrays(arr_size)) + arrays(arr_size)%array = t_arr end #:endfor #:endfor From aece66a1d3cab196cec97f44f5d7edd20c161f5b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 19:55:40 +0530 Subject: [PATCH 085/146] Make array name optional such as in np --- src/stdlib_io_np.fypp | 6 +++--- src/stdlib_io_np_save.fypp | 28 ++++++++++++++++++---------- test/io/test_np.f90 | 5 ++--- 3 files changed, 23 insertions(+), 16 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index dbd125420..c75909ba5 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -163,17 +163,17 @@ module stdlib_io_np interface add_array #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, name, stat, msg) + module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) !> Array of arrays to which the array is to be added. type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) !> Array to be added. ${t1}$, intent(in) :: array${ranksuffix(rank)}$ - !> Name of the array to be added. - character(len=*), intent(in) :: name !> Status of addition. integer, intent(out), optional :: stat !> Error message. character(len=:), allocatable, intent(out), optional :: msg + !> Name of the array to be added. A default name will be used if not provided. + character(len=*), intent(in), optional :: name end #:endfor #:endfor diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 9af0c82cf..44f2e0233 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -137,30 +137,38 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, name, stat, msg) + module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) !> Array of arrays to which the array is to be added. type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) !> Array to be added. ${t1}$, intent(in) :: array${ranksuffix(rank)}$ - !> Name of the array to be added. - character(len=*), intent(in) :: name !> Status of addition. integer, intent(out), optional :: stat !> Error message. character(len=:), allocatable, intent(out), optional :: msg + !> Name of the array to be added. A default name will be used if not provided. + character(len=*), intent(in), optional :: name integer :: i, arr_size type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr if (present(stat)) stat = 0 - if (trim(name) == '') then - if (present(stat)) stat = 1 - if (present(msg)) msg = "Array name cannot be empty." - return + if (present(name)) then + if (trim(name) == '') then + if (present(stat)) stat = 1 + if (present(msg)) msg = "Array name cannot be empty." + return + end if + t_arr%name = name + else + if (allocated(arrays)) then + t_arr%name = "arr_"//trim(to_string(size(arrays)))//".npy" + else + t_arr%name = "arr_0.npy" + end if end if - t_arr%name = name t_arr%values = array if (.not. allocated(arrays)) then @@ -171,9 +179,9 @@ contains arr_size = size(arrays) do i = 1, arr_size - if (arrays(i)%array%name == name) then + if (arrays(i)%array%name == t_arr%name) then if (present(stat)) stat = 1 - if (present(msg)) msg = "Array with the same name '"//name//"' already exists." + if (present(msg)) msg = "Array with the same name '"//t_arr%name//"' already exists." return end if end do diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 5f9273f26..9389e575c 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -952,17 +952,16 @@ subroutine npz_save_rdp_2(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "npz_save_rdp_2.npz" - character(*), parameter :: arr_name = "arr_0.npy" real(dp), allocatable :: input_array(:,:), output(:,:) allocate(input_array(10, 4)) call random_number(input_array) - call add_array(arrays, input_array, arr_name, stat) + call add_array(arrays, input_array, stat) call check(error, stat, "Error adding an array to the list of arrays.") if (allocated(error)) return call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") if (allocated(error)) return - call check(error, arrays(1)%array%name == arr_name, "Wrong array name.") + call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") if (allocated(error)) return ! call save_npz(filename, arrays, stat) From d5fa8ab2e64900fe6acc60d37ec5524fbb2a6abb Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 20:55:05 +0530 Subject: [PATCH 086/146] Finish first proper test for add_array --- test/io/test_np.f90 | 71 +++++++++++++++++++++++++++------------------ 1 file changed, 42 insertions(+), 29 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 9389e575c..0f0b9911e 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -48,8 +48,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx), & new_unittest("npz_load_two_arr_iint64_rdp", npz_load_two_arr_iint64_rdp), & new_unittest("npz_load_two_arr_iint64_rdp_comp", npz_load_two_arr_iint64_rdp_comp), & - new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.), & - new_unittest("npz_save_rdp_2", npz_save_rdp_2) & + new_unittest("npz_add_to_empty_arr", npz_add_to_empty_arr), & + new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.) & ] end subroutine collect_np @@ -934,25 +934,13 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) end select end - subroutine npz_save_empty_array_input(error) + subroutine npz_add_to_empty_arr(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) integer :: stat - character(*), parameter :: filename = "output.npz" - - allocate(arrays(0)) - call save_npz(filename, arrays, stat) - call check(error, stat, "Trying to save an empty array fail.") - end - - subroutine npz_save_rdp_2(error) - type(error_type), allocatable, intent(out) :: error - - type(t_array_wrapper), allocatable :: arrays(:) - integer :: stat - character(*), parameter :: filename = "npz_save_rdp_2.npz" - real(dp), allocatable :: input_array(:,:), output(:,:) + character(*), parameter :: filename = "npz_add_arr.npz" + real(dp), allocatable :: input_array(:,:) allocate(input_array(10, 4)) call random_number(input_array) @@ -963,22 +951,47 @@ subroutine npz_save_rdp_2(error) if (allocated(error)) return call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") if (allocated(error)) return + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + call check(error, size(typed_array%values), size(input_array), "Array sizes to not match.") + if (allocated(error)) return + call check(error, any(abs(typed_array%values - input_array) <= epsilon(1.0_dp)), & + "Precision loss when adding array.") + if (allocated(error)) return + class default + call test_failed(error, "Array in '"//filename//"' is of wrong type.") + end select + end - ! call save_npz(filename, arrays, stat) - ! call check(error, stat, "Writing of npz file failed") - ! if (allocated(error)) return - - ! call load_npy(filename, output, stat) - ! call delete_file(filename) + ! subroutine npz_add_arr(error) + ! type(error_type), allocatable, intent(out) :: error + + ! type(t_array_wrapper), allocatable :: arrays(:) + ! integer :: stat + ! character(*), parameter :: filename = "npz_add_arr.npz" + ! real(dp), allocatable :: input_array(:,:) + + ! allocate(input_array(10, 4)) + ! call random_number(input_array) + ! call add_array(arrays, input_array, stat) + ! call check(error, stat, "Error adding an array to the list of arrays.") + ! if (allocated(error)) return + ! call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") + ! if (allocated(error)) return + ! call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") + ! if (allocated(error)) return + ! end - ! call check(error, stat, "Reading of npy file failed") - ! if (allocated(error)) return + subroutine npz_save_empty_array_input(error) + type(error_type), allocatable, intent(out) :: error - ! call check(error, size(output), size(input)) - ! if (allocated(error)) return + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + character(*), parameter :: filename = "output.npz" - ! call check(error, any(abs(output - input) <= epsilon(1.0_dp)), & - ! "Precision loss when rereading array") + allocate(arrays(0)) + call save_npz(filename, arrays, stat) + call check(error, stat, "Trying to save an empty array fail.") end !> Makes sure that we find the file when running both `ctest` and `fpm test`. From 6cbf98950f13ca2098c64c10d4ef75016abca979 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 21:11:03 +0530 Subject: [PATCH 087/146] Remove redundant interface --- src/stdlib_io_np.fypp | 15 --------------- src/stdlib_io_np_load.fypp | 6 +++--- 2 files changed, 3 insertions(+), 18 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index c75909ba5..607c619d5 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -145,21 +145,6 @@ module stdlib_io_np end end interface - 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 - interface add_array #:for k1, t1 in KINDS_TYPES #:for rank in RANKS diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 75bf5b8f7..874224229 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -58,7 +58,7 @@ contains exit catch end if - call allocate_array_from_shape(array, vshape, stat) + call allocate_array_from_shape_${t1[0]}$${k1}$_${rank}$(array, vshape, stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//vtype//"' "//& & "with total size of "//to_string(product(vshape)) @@ -86,7 +86,7 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine allocate_array_from_shape_${t1[0]}$${k1}$_${rank}$(array, vshape, stat) + 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 @@ -180,7 +180,7 @@ contains block ${t1}$, allocatable :: array${ranksuffix(rank)}$ - call allocate_array_from_shape(array, vshape, stat) + call allocate_array_from_shape_${t1[0]}$${k1}$_${rank}$(array, vshape, stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"'."; close(io, status='delete'); return From fdae839929b8fb22d9cf3151b5031db6fbf55980 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 21:35:35 +0530 Subject: [PATCH 088/146] Not reallocate array --- src/stdlib_io_np_save.fypp | 11 +++++----- test/io/test_np.f90 | 42 ++++++++++++++++++++++++++++++++++---- 2 files changed, 43 insertions(+), 10 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 44f2e0233..0dcd9fcb2 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -149,8 +149,9 @@ contains !> Name of the array to be added. A default name will be used if not provided. character(len=*), intent(in), optional :: name - integer :: i, arr_size + integer :: i type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr + type(t_array_wrapper) :: wrapper if (present(stat)) stat = 0 @@ -177,8 +178,7 @@ contains return end if - arr_size = size(arrays) - do i = 1, arr_size + do i = 1, size(arrays) if (arrays(i)%array%name == t_arr%name) then if (present(stat)) stat = 1 if (present(msg)) msg = "Array with the same name '"//t_arr%name//"' already exists." @@ -186,9 +186,8 @@ contains end if end do - arr_size = arr_size + 1 - allocate(arrays(arr_size)) - arrays(arr_size)%array = t_arr + wrapper%array = t_arr + arrays = [arrays, wrapper] end #:endfor #:endfor diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 0f0b9911e..2a555d3a1 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -48,7 +48,8 @@ subroutine collect_np(testsuite) new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx), & new_unittest("npz_load_two_arr_iint64_rdp", npz_load_two_arr_iint64_rdp), & new_unittest("npz_load_two_arr_iint64_rdp_comp", npz_load_two_arr_iint64_rdp_comp), & - new_unittest("npz_add_to_empty_arr", npz_add_to_empty_arr), & + new_unittest("npz_add_arr_to_empty", npz_add_arr_to_empty), & + new_unittest("npz_add_two_arrays", npz_add_two_arrays), & new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.) & ] end subroutine collect_np @@ -934,12 +935,11 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) end select end - subroutine npz_add_to_empty_arr(error) + subroutine npz_add_arr_to_empty(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) integer :: stat - character(*), parameter :: filename = "npz_add_arr.npz" real(dp), allocatable :: input_array(:,:) allocate(input_array(10, 4)) @@ -959,10 +959,44 @@ subroutine npz_add_to_empty_arr(error) "Precision loss when adding array.") if (allocated(error)) return class default - call test_failed(error, "Array in '"//filename//"' is of wrong type.") + call test_failed(error, "Array is of wrong type.") end select end + subroutine npz_add_two_arrays(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + real(dp), allocatable :: array_1(:,:) + real(sp), allocatable :: array_2(:) + + allocate(array_1(10, 4)) + call random_number(array_1) + call add_array(arrays, array_1, stat) + call check(error, stat, "Error adding an array to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") + if (allocated(error)) return + call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") + if (allocated(error)) return + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + call check(error, size(typed_array%values), size(array_1), "Array sizes to not match.") + if (allocated(error)) return + call check(error, any(abs(typed_array%values - array_1) <= epsilon(1.0_dp)), & + "Precision loss when adding array.") + if (allocated(error)) return + class default + call test_failed(error, "Array 1 is of wrong type.") + end select + + allocate(array_2(10)) + call random_number(array_2) + call add_array(arrays, array_2, stat) + call check(error, stat, "Error adding an array to the list of arrays.") + end + ! subroutine npz_add_arr(error) ! type(error_type), allocatable, intent(out) :: error From 7354010948afa90b7ce183a567a33c010edc1698 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 21:43:32 +0530 Subject: [PATCH 089/146] Finish seconds test --- src/stdlib_io_np_save.fypp | 2 +- test/io/test_np.f90 | 19 +++++++++++++++++-- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 0dcd9fcb2..e55acc5f0 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -164,7 +164,7 @@ contains t_arr%name = name else if (allocated(arrays)) then - t_arr%name = "arr_"//trim(to_string(size(arrays)))//".npy" + t_arr%name = "arr_"//to_string(size(arrays))//".npy" else t_arr%name = "arr_0.npy" end if diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 2a555d3a1..ba00dc287 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -974,7 +974,7 @@ subroutine npz_add_two_arrays(error) allocate(array_1(10, 4)) call random_number(array_1) call add_array(arrays, array_1, stat) - call check(error, stat, "Error adding an array to the list of arrays.") + call check(error, stat, "Error adding the first array to the list of arrays.") if (allocated(error)) return call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") if (allocated(error)) return @@ -994,7 +994,22 @@ subroutine npz_add_two_arrays(error) allocate(array_2(10)) call random_number(array_2) call add_array(arrays, array_2, stat) - call check(error, stat, "Error adding an array to the list of arrays.") + call check(error, stat, "Error adding the second array to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 2, "Array was not added to the list of arrays.") + if (allocated(error)) return + call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") + if (allocated(error)) return + select type (typed_array => arrays(2)%array) + class is (t_array_rsp_1) + call check(error, size(typed_array%values), size(array_2), "Array sizes to not match.") + if (allocated(error)) return + call check(error, any(abs(typed_array%values - array_2) <= epsilon(1.0_sp)), & + "Precision loss when adding array.") + if (allocated(error)) return + class default + call test_failed(error, "Array 2 is of wrong type.") + end select end ! subroutine npz_add_arr(error) From 0854521e36c5bb02a39b634afeed367922e2bf0e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 14 Aug 2024 23:00:06 +0530 Subject: [PATCH 090/146] Add more tests for add_arr --- test/io/test_np.f90 | 66 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index ba00dc287..3b9572657 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -50,6 +50,9 @@ subroutine collect_np(testsuite) new_unittest("npz_load_two_arr_iint64_rdp_comp", npz_load_two_arr_iint64_rdp_comp), & new_unittest("npz_add_arr_to_empty", npz_add_arr_to_empty), & new_unittest("npz_add_two_arrays", npz_add_two_arrays), & + new_unittest("npz_add_arr_custom_name", npz_add_arr_custom_name), & + new_unittest("npz_add_arr_empty_name", npz_add_arr_empty_name, should_fail=.true.), & + new_unittest("npz_add_arr_duplicate_names", npz_add_arr_duplicate_names, should_fail=.true.), & new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.) & ] end subroutine collect_np @@ -1012,6 +1015,69 @@ subroutine npz_add_two_arrays(error) end select end + subroutine npz_add_arr_custom_name(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + real(dp), allocatable :: input_array(:,:) + character(*), parameter :: arr_name = "custom_name.npy" + + allocate(input_array(10, 4)) + call random_number(input_array) + call add_array(arrays, input_array, stat, name=arr_name) + call check(error, stat, "Error adding an array to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") + if (allocated(error)) return + call check(error, arrays(1)%array%name == arr_name, "Wrong array name.") + if (allocated(error)) return + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + call check(error, size(typed_array%values), size(input_array), "Array sizes to not match.") + if (allocated(error)) return + call check(error, any(abs(typed_array%values - input_array) <= epsilon(1.0_dp)), & + "Precision loss when adding array.") + if (allocated(error)) return + class default + call test_failed(error, "Array is of wrong type.") + end select + end + + subroutine npz_add_arr_empty_name(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + real(dp), allocatable :: input_array(:,:) + character(*), parameter :: arr_name = " " + + allocate(input_array(10, 4)) + call random_number(input_array) + call add_array(arrays, input_array, stat, name=arr_name) + call check(error, stat, "Empty file names are not allowed.") + end + + subroutine npz_add_arr_duplicate_names(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + real(dp), allocatable :: array_1(:,:) + real(sp), allocatable :: array_2(:) + character(*), parameter :: arr_name = "arr_0.npy" + + allocate(array_1(10, 4)) + call random_number(array_1) + call add_array(arrays, array_1, stat, name=arr_name) + call check(error, stat, "Error adding the first array to the list of arrays.") + + allocate(array_2(10)) + call random_number(array_2) + call add_array(arrays, array_2, stat, name=arr_name) + call check(error, stat, "Adding a second array with the same name shouldn't work.") + end + ! subroutine npz_add_arr(error) ! type(error_type), allocatable, intent(out) :: error From ecbb3499b76ed955be457c6f8947fcee58a87afa Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 00:52:40 +0530 Subject: [PATCH 091/146] Add option to either compress zip file or not --- src/stdlib_io_np.fypp | 2 +- src/stdlib_io_np_save.fypp | 4 +-- src/stdlib_io_zip.f90 | 17 ++++++++++--- test/io/test_np.f90 | 19 -------------- test/io/test_zip.f90 | 51 +++++++++++++++++++++++++++++++++++--- 5 files changed, 65 insertions(+), 28 deletions(-) diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 607c619d5..cf46505f2 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -135,7 +135,7 @@ 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_arrays(filename, arrays, iostat, iomsg, compressed) + module subroutine save_arrays_to_npz(filename, arrays, iostat, iomsg, compressed) character(len=*), intent(in) :: filename type(t_array_wrapper), intent(in) :: arrays(:) integer, intent(out), optional :: iostat diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index e55acc5f0..1a830d75b 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -196,7 +196,7 @@ 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_arrays(filename, arrays, iostat, iomsg, compressed) + module subroutine save_arrays_to_npz(filename, arrays, iostat, iomsg, compressed) character(len=*), intent(in) :: filename type(t_array_wrapper), intent(in) :: arrays(:) integer, intent(out), optional :: iostat @@ -252,7 +252,7 @@ contains end select end do - call zip(filename, files, stat, msg) + call zip(filename, files, stat, msg, is_compressed) if (stat /= 0) then if (present(iostat)) iostat = stat if (present(iomsg)) iomsg = msg diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 9f8bba418..8cd954b69 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -12,18 +12,26 @@ module stdlib_io_zip contains - subroutine zip(output_file, files, stat, msg) + subroutine zip(output_file, files, stat, msg, compressed) character(*), intent(in) :: output_file type(string_type), intent(in) :: files(:) integer, intent(out), optional :: stat character(len=:), allocatable, intent(out), optional :: msg + logical, intent(in), optional :: compressed integer :: run_stat, i - character(:), allocatable :: files_str + character(:), allocatable :: files_str, cmd + logical :: is_compressed if (present(stat)) stat = 0 run_stat = 0 + if (present(compressed)) then + is_compressed = compressed + else + is_compressed = .true. + end if + if (trim(output_file) == '') then if (present(stat)) stat = 1 if (present(msg)) msg = "Output file is empty." @@ -35,7 +43,10 @@ subroutine zip(output_file, files, stat, msg) files_str = files_str//' '//char(files(i)) end do - call run('zip '//output_file//files_str, run_stat) + cmd = 'zip '//''//output_file//' '//files_str + if (.not. is_compressed) cmd = cmd//' -0' + + call run(cmd, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) msg = "Error creating zip file '"//output_file//"'." diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 3b9572657..c879e4815 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1078,25 +1078,6 @@ subroutine npz_add_arr_duplicate_names(error) call check(error, stat, "Adding a second array with the same name shouldn't work.") end - ! subroutine npz_add_arr(error) - ! type(error_type), allocatable, intent(out) :: error - - ! type(t_array_wrapper), allocatable :: arrays(:) - ! integer :: stat - ! character(*), parameter :: filename = "npz_add_arr.npz" - ! real(dp), allocatable :: input_array(:,:) - - ! allocate(input_array(10, 4)) - ! call random_number(input_array) - ! call add_array(arrays, input_array, stat) - ! call check(error, stat, "Error adding an array to the list of arrays.") - ! if (allocated(error)) return - ! call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") - ! if (allocated(error)) return - ! call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") - ! if (allocated(error)) return - ! end - subroutine npz_save_empty_array_input(error) type(error_type), allocatable, intent(out) :: error diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 711677315..f95020d56 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -1,7 +1,8 @@ module test_zip + use stdlib_filesystem, only: exists use stdlib_io_zip - use stdlib_string_type, only : string_type, char - use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed + use stdlib_string_type, only: string_type, char + use testdrive, only: new_unittest, unittest_type, error_type, check, test_failed implicit none private @@ -28,7 +29,8 @@ subroutine collect_zip(testsuite) new_unittest("zip_invalid_file", zip_invalid_file, should_fail=.true.), & new_unittest("zip_empty_file", zip_empty_file), & new_unittest("zip_invalid_output_file", zip_invalid_output_file, should_fail=.true.), & - new_unittest("zip_two_files", zip_two_files) & + new_unittest("zip_two_files", zip_two_files), & + new_unittest("zip_without_comp", zip_without_comp) & ] end @@ -199,6 +201,13 @@ subroutine zip_empty_file(error) call zip(output_file, files, stat) call check(error, stat, "Compressing a valid empty file should not fail.") + if (allocated(error)) then + call delete_file(input_file) + call delete_file(output_file) + return + end if + + call check(error, exists(output_file), "The output file should exist.") call delete_file(input_file) call delete_file(output_file) @@ -241,12 +250,48 @@ subroutine zip_two_files(error) call zip(output_file, files, stat) call check(error, stat, "Compressing two valid files should not fail.") + if (allocated(error)) then + call delete_file(input_file_1) + call delete_file(input_file_2) + call delete_file(output_file) + return + end if + + call check(error, exists(output_file), "The output file should exist.") call delete_file(input_file_1) call delete_file(input_file_2) call delete_file(output_file) end + + subroutine zip_without_comp(error) + type(error_type), allocatable, intent(out) :: error + + integer :: stat, unit + character(*), parameter :: output_file = "temp.zip" + character(*), parameter :: input_file = "abc.txt" + type(string_type), allocatable :: files(:) + + files = [string_type(input_file)] + + open(newunit= unit, file=input_file) + close(unit) + + call zip(output_file, files, stat, compressed=.false.) + call check(error, stat, "Zipping a valid file without compression shouldn't fail.") + if (allocated(error)) then + call delete_file(input_file) + call delete_file(output_file) + return + end if + + call check(error, exists(output_file), "The output file should exist.") + + call delete_file(input_file) + call delete_file(output_file) + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file From 14033592ee4edff0bf0c98589f721226ae960066 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 17:16:22 +0530 Subject: [PATCH 092/146] Finalize all tests --- src/stdlib_io_np_save.fypp | 6 +- test/io/test_np.f90 | 149 ++++++++++++++++++++++++++++++++++--- 2 files changed, 142 insertions(+), 13 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 1a830d75b..540ab5c1e 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -197,9 +197,13 @@ contains !> Save multidimensional arrays to a compressed or an uncompressed npz file. !> ([Specification](../page/specs/stdlib_io.html#save_npz)) module subroutine save_arrays_to_npz(filename, arrays, iostat, iomsg, compressed) + !> Name of the npz file to save to. character(len=*), intent(in) :: filename + !> Array of arrays to be saved. type(t_array_wrapper), intent(in) :: arrays(:) + !> Optional error status of saving, zero on success. integer, intent(out), optional :: iostat + !> Optional error message. character(len=:), allocatable, intent(out), optional :: iomsg !> If true, the file is saved in compressed format. The default is false. logical, intent(in), optional :: compressed @@ -217,7 +221,7 @@ contains is_compressed = .false. end if - allocate(files(size(arrays))) + if (.not. allocated(files)) allocate(files(0)) do i = 1, size(arrays) select type (typed_array => arrays(i)%array) #:for k1, t1 in KINDS_TYPES diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index c879e4815..c4b822f87 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,6 +1,6 @@ module test_np use stdlib_array - use stdlib_filesystem, only : temp_dir + use stdlib_filesystem, only : temp_dir, exists use stdlib_kinds, only : int8, int16, int32, int64, sp, dp use stdlib_io_np, only : save_npy, load_npy, load_npz, add_array, save_npz use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed @@ -48,12 +48,14 @@ subroutine collect_np(testsuite) new_unittest("npz_load_arr_cmplx", npz_load_arr_cmplx), & new_unittest("npz_load_two_arr_iint64_rdp", npz_load_two_arr_iint64_rdp), & new_unittest("npz_load_two_arr_iint64_rdp_comp", npz_load_two_arr_iint64_rdp_comp), & - new_unittest("npz_add_arr_to_empty", npz_add_arr_to_empty), & - new_unittest("npz_add_two_arrays", npz_add_two_arrays), & - new_unittest("npz_add_arr_custom_name", npz_add_arr_custom_name), & - new_unittest("npz_add_arr_empty_name", npz_add_arr_empty_name, should_fail=.true.), & - new_unittest("npz_add_arr_duplicate_names", npz_add_arr_duplicate_names, should_fail=.true.), & - new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.) & + new_unittest("add_array_to_empty", add_array_to_empty), & + new_unittest("add_two_arrays", add_two_arrays), & + new_unittest("add_array_custom_name", add_array_custom_name), & + new_unittest("add_array_empty_name", add_array_empty_name, should_fail=.true.), & + new_unittest("add_array_duplicate_names", add_array_duplicate_names, should_fail=.true.), & + new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.), & + new_unittest("npz_save_one_array", npz_save_one_array), & + new_unittest("npz_save_two_arrays", npz_save_two_arrays) & ] end subroutine collect_np @@ -938,7 +940,7 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) end select end - subroutine npz_add_arr_to_empty(error) + subroutine add_array_to_empty(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) @@ -966,7 +968,7 @@ subroutine npz_add_arr_to_empty(error) end select end - subroutine npz_add_two_arrays(error) + subroutine add_two_arrays(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) @@ -1015,7 +1017,7 @@ subroutine npz_add_two_arrays(error) end select end - subroutine npz_add_arr_custom_name(error) + subroutine add_array_custom_name(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) @@ -1044,7 +1046,7 @@ subroutine npz_add_arr_custom_name(error) end select end - subroutine npz_add_arr_empty_name(error) + subroutine add_array_empty_name(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) @@ -1058,7 +1060,7 @@ subroutine npz_add_arr_empty_name(error) call check(error, stat, "Empty file names are not allowed.") end - subroutine npz_add_arr_duplicate_names(error) + subroutine add_array_duplicate_names(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:) @@ -1090,6 +1092,129 @@ subroutine npz_save_empty_array_input(error) call check(error, stat, "Trying to save an empty array fail.") end + subroutine npz_save_one_array(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) + integer :: stat + real(dp), allocatable :: input_array(:,:) + character(*), parameter :: output_file = "one_array.npz" + + allocate(input_array(10, 4)) + call random_number(input_array) + call add_array(arrays, input_array, stat) + call check(error, stat, "Error adding an array to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") + if (allocated(error)) return + call save_npz(output_file, arrays, stat) + call check(error, stat, "Error saving the array.") + if (allocated(error)) then + call delete_file(output_file); return + end if + call check(error, exists(output_file), "Output file does not exist.") + if (allocated(error)) then + call delete_file(output_file); return + end if + + call load_npz(output_file, arrays_reloaded, stat) + call check(error, stat, "Error loading the npz file.") + if (allocated(error)) then + call delete_file(output_file); return + end if + call check(error, size(arrays_reloaded) == 1, "Wrong number of arrays.") + if (allocated(error)) then + call delete_file(output_file); return + end if + select type (typed_array => arrays_reloaded(1)%array) + class is (t_array_rdp_2) + call check(error, size(typed_array%values), size(input_array), "Array sizes to not match.") + if (allocated(error)) then + call delete_file(output_file); return + end if + call check(error, any(abs(typed_array%values - input_array) <= epsilon(1.0_dp)), & + "Precision loss when adding array.") + if (allocated(error)) then + call delete_file(output_file); return + end if + class default + call test_failed(error, "Array is of wrong type.") + end select + call delete_file(output_file) + end + + subroutine npz_save_two_arrays(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) + integer :: stat + real(dp), allocatable :: input_array_1(:,:) + complex(dp), allocatable :: input_array_2(:) + character(*), parameter :: output_file = "two_arrays.npz" + + allocate(input_array_1(5, 6)) + call random_number(input_array_1) + input_array_2 = [(1.0_dp, 2.0_dp), (3.0_dp, 4.0_dp), (5.0_dp, 6.0_dp)] + call add_array(arrays, input_array_1, stat) + call check(error, stat, "Error adding array 1 to the list of arrays.") + if (allocated(error)) return + call add_array(arrays, input_array_2, stat) + call check(error, stat, "Error adding array 2 to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 2, "Wrong array size.") + if (allocated(error)) return + call save_npz(output_file, arrays, stat) + call check(error, stat, "Error saving arrays as an npz file.") + if (allocated(error)) then + call delete_file(output_file); return + end if + call check(error, exists(output_file), "Output file does not exist.") + if (allocated(error)) then + call delete_file(output_file); return + end if + + call load_npz(output_file, arrays_reloaded, stat) + call check(error, stat, "Error loading npz file.") + if (allocated(error)) then + call delete_file(output_file); return + end if + call check(error, size(arrays_reloaded) == 2, "Wrong number of arrays.") + if (allocated(error)) then + call delete_file(output_file); return + end if + + select type (typed_array => arrays_reloaded(1)%array) + class is (t_array_rdp_2) + call check(error, size(typed_array%values), size(input_array_1), "Array sizes to not match.") + if (allocated(error)) then + call delete_file(output_file); return + end if + call check(error, any(abs(typed_array%values - input_array_1) <= epsilon(1.0_dp)), & + "Precision loss when adding array.") + if (allocated(error)) then + call delete_file(output_file); return + end if + class default + call test_failed(error, "Array 1 is of wrong type.") + end select + + select type (typed_array => arrays_reloaded(2)%array) + class is (t_array_cdp_2) + call check(error, size(typed_array%values), size(input_array_2), "Array sizes to not match.") + if (allocated(error)) then + call delete_file(output_file); return + end if + call check(error, any(abs(typed_array%values - input_array_2) <= epsilon(1.0_dp)), & + "Precision loss when adding array.") + if (allocated(error)) then + call delete_file(output_file); return + end if + class default + call test_failed(error, "Array 2 is of wrong type.") + end select + call delete_file(output_file) + end + !> Makes sure that we find the file when running both `ctest` and `fpm test`. function get_path(file) result(path) character(*), intent(in) :: file From 9c56d6da53ae428de4f297387743390d301a7318 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 18:19:44 +0530 Subject: [PATCH 093/146] Fix rank --- test/io/test_np.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index c4b822f87..02aa61786 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1199,7 +1199,7 @@ subroutine npz_save_two_arrays(error) end select select type (typed_array => arrays_reloaded(2)%array) - class is (t_array_cdp_2) + class is (t_array_cdp_1) call check(error, size(typed_array%values), size(input_array_2), "Array sizes to not match.") if (allocated(error)) then call delete_file(output_file); return From 6cf09609f9f68290ceac7056c946424c89d43982 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 19:50:58 +0530 Subject: [PATCH 094/146] Try fixing errors --- test/io/test_np.f90 | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 02aa61786..dfa3d5196 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -958,7 +958,7 @@ subroutine add_array_to_empty(error) if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_rdp_2) - call check(error, size(typed_array%values), size(input_array), "Array sizes to not match.") + call check(error, size(typed_array%values), size(input_array), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - input_array) <= epsilon(1.0_dp)), & "Precision loss when adding array.") @@ -987,7 +987,7 @@ subroutine add_two_arrays(error) if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_rdp_2) - call check(error, size(typed_array%values), size(array_1), "Array sizes to not match.") + call check(error, size(typed_array%values), size(array_1), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - array_1) <= epsilon(1.0_dp)), & "Precision loss when adding array.") @@ -1007,7 +1007,7 @@ subroutine add_two_arrays(error) if (allocated(error)) return select type (typed_array => arrays(2)%array) class is (t_array_rsp_1) - call check(error, size(typed_array%values), size(array_2), "Array sizes to not match.") + call check(error, size(typed_array%values), size(array_2), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - array_2) <= epsilon(1.0_sp)), & "Precision loss when adding array.") @@ -1036,7 +1036,7 @@ subroutine add_array_custom_name(error) if (allocated(error)) return select type (typed_array => arrays(1)%array) class is (t_array_rdp_2) - call check(error, size(typed_array%values), size(input_array), "Array sizes to not match.") + call check(error, size(typed_array%values), size(input_array), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - input_array) <= epsilon(1.0_dp)), & "Precision loss when adding array.") @@ -1099,6 +1099,7 @@ subroutine npz_save_one_array(error) integer :: stat real(dp), allocatable :: input_array(:,:) character(*), parameter :: output_file = "one_array.npz" + character(*), parameter :: tmp = temp_dir//"one_array" allocate(input_array(10, 4)) call random_number(input_array) @@ -1117,7 +1118,7 @@ subroutine npz_save_one_array(error) call delete_file(output_file); return end if - call load_npz(output_file, arrays_reloaded, stat) + call load_npz(output_file, arrays_reloaded, stat, tmp_dir=tmp) call check(error, stat, "Error loading the npz file.") if (allocated(error)) then call delete_file(output_file); return @@ -1128,7 +1129,7 @@ subroutine npz_save_one_array(error) end if select type (typed_array => arrays_reloaded(1)%array) class is (t_array_rdp_2) - call check(error, size(typed_array%values), size(input_array), "Array sizes to not match.") + call check(error, size(typed_array%values), size(input_array), "Array sizes do not match.") if (allocated(error)) then call delete_file(output_file); return end if @@ -1150,15 +1151,18 @@ subroutine npz_save_two_arrays(error) integer :: stat real(dp), allocatable :: input_array_1(:,:) complex(dp), allocatable :: input_array_2(:) + character(*), parameter :: array_name_1 = "array_1" + character(*), parameter :: array_name_2 = "array_2" character(*), parameter :: output_file = "two_arrays.npz" + character(*), parameter :: tmp = temp_dir//"two_arrays" allocate(input_array_1(5, 6)) call random_number(input_array_1) input_array_2 = [(1.0_dp, 2.0_dp), (3.0_dp, 4.0_dp), (5.0_dp, 6.0_dp)] - call add_array(arrays, input_array_1, stat) + call add_array(arrays, input_array_1, stat, name=array_name_1) call check(error, stat, "Error adding array 1 to the list of arrays.") if (allocated(error)) return - call add_array(arrays, input_array_2, stat) + call add_array(arrays, input_array_2, stat, name=array_name_2) call check(error, stat, "Error adding array 2 to the list of arrays.") if (allocated(error)) return call check(error, size(arrays) == 2, "Wrong array size.") @@ -1173,7 +1177,7 @@ subroutine npz_save_two_arrays(error) call delete_file(output_file); return end if - call load_npz(output_file, arrays_reloaded, stat) + call load_npz(output_file, arrays_reloaded, stat, tmp_dir=tmp) call check(error, stat, "Error loading npz file.") if (allocated(error)) then call delete_file(output_file); return @@ -1185,7 +1189,7 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(1)%array) class is (t_array_rdp_2) - call check(error, size(typed_array%values), size(input_array_1), "Array sizes to not match.") + call check(error, size(typed_array%values), size(input_array_1), "First array does not match in size.") if (allocated(error)) then call delete_file(output_file); return end if @@ -1200,7 +1204,7 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(2)%array) class is (t_array_cdp_1) - call check(error, size(typed_array%values), size(input_array_2), "Array sizes to not match.") + call check(error, size(typed_array%values), size(input_array_2), "Second array does not match in size.") if (allocated(error)) then call delete_file(output_file); return end if From 20ab3aa14b7deb7371fa69dcfb9d7cf98f082ddc Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 20:31:07 +0530 Subject: [PATCH 095/146] Fix paths, print expected values --- test/io/test_np.f90 | 33 +++++++++++++++++++-------------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index dfa3d5196..04dd8b6da 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -3,6 +3,7 @@ module test_np use stdlib_filesystem, only : temp_dir, exists use stdlib_kinds, only : int8, int16, int32, int64, sp, dp use stdlib_io_np, only : save_npy, load_npy, load_npz, add_array, save_npz + use stdlib_string_type, only : char use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private @@ -669,7 +670,7 @@ subroutine npz_load_nonexistent_file(error) integer :: stat character(*), parameter :: filename = "nonexistent.npz" - character(*), parameter :: tmp = temp_dir//"nonexistent" + character(*), parameter :: tmp = temp_dir//"/nonexistent" call load_npz(filename, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading a non-existent npz file should fail.") @@ -683,7 +684,7 @@ subroutine npz_load_invalid_dir(error) integer :: stat character(*), parameter :: filename = "." - character(*), parameter :: tmp = temp_dir//"invalid_dir" + character(*), parameter :: tmp = temp_dir//"/invalid_dir" call load_npz(filename, arrays, stat, tmp_dir=tmp) @@ -698,7 +699,7 @@ subroutine npz_load_empty_file(error) integer :: io, stat character(*), parameter :: filename = "empty_file" - character(*), parameter :: tmp = temp_dir//"empty_file" + character(*), parameter :: tmp = temp_dir//"/empty_file" open(newunit=io, file=filename) close(io) @@ -717,7 +718,7 @@ subroutine npz_load_empty_zip(error) integer :: io, stat character(*), parameter :: filename = "empty.zip" - character(*), parameter :: tmp = temp_dir//"empty_zip" + character(*), parameter :: tmp = temp_dir//"/empty_zip" character(*), parameter:: binary_data = 'PK'//char(5)//char(6)//repeat(char(0), 18) open (newunit=io, file=filename, form='unformatted', access='stream') @@ -736,7 +737,7 @@ subroutine npz_load_arr_empty_0(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "empty_0.npz" - character(*), parameter :: tmp = temp_dir//"empty_0" + character(*), parameter :: tmp = temp_dir//"/empty_0" character(:), allocatable :: path @@ -762,7 +763,7 @@ subroutine npz_load_arr_rand_2_3(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "rand_2_3.npz" - character(*), parameter :: tmp = temp_dir//"rand_2_3" + character(*), parameter :: tmp = temp_dir//"/rand_2_3" character(:), allocatable :: path path = get_path(filename) @@ -787,7 +788,7 @@ subroutine npz_load_arr_arange_10_20(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat, i character(*), parameter :: filename = "arange_10_20.npz" - character(*), parameter :: tmp = temp_dir//"arange_10_20" + character(*), parameter :: tmp = temp_dir//"/arange_10_20" character(:), allocatable :: path @@ -820,7 +821,7 @@ subroutine npz_load_arr_cmplx(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "cmplx_arr.npz" - character(*), parameter :: tmp = temp_dir//"cmplx_arr" + character(*), parameter :: tmp = temp_dir//"/cmplx_arr" character(:), allocatable :: path path = get_path(filename) @@ -852,7 +853,7 @@ subroutine npz_load_two_arr_iint64_rdp(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp.npz" - character(*), parameter :: tmp = temp_dir//"two_arr_iint64_rdp" + character(*), parameter :: tmp = temp_dir//"/two_arr_iint64_rdp" character(:), allocatable :: path path = get_path(filename) @@ -899,7 +900,7 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) type(t_array_wrapper), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" - character(*), parameter :: tmp = temp_dir//"two_arr_iint64_rdp_comp" + character(*), parameter :: tmp = temp_dir//"/two_arr_iint64_rdp_comp" character(:), allocatable :: path path = get_path(filename) @@ -1099,7 +1100,7 @@ subroutine npz_save_one_array(error) integer :: stat real(dp), allocatable :: input_array(:,:) character(*), parameter :: output_file = "one_array.npz" - character(*), parameter :: tmp = temp_dir//"one_array" + character(*), parameter :: tmp = temp_dir//"/one_array" allocate(input_array(10, 4)) call random_number(input_array) @@ -1154,7 +1155,7 @@ subroutine npz_save_two_arrays(error) character(*), parameter :: array_name_1 = "array_1" character(*), parameter :: array_name_2 = "array_2" character(*), parameter :: output_file = "two_arrays.npz" - character(*), parameter :: tmp = temp_dir//"two_arrays" + character(*), parameter :: tmp = temp_dir//"/two_arrays" allocate(input_array_1(5, 6)) call random_number(input_array_1) @@ -1189,7 +1190,9 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(1)%array) class is (t_array_rdp_2) - call check(error, size(typed_array%values), size(input_array_1), "First array does not match in size.") + call check(error, size(typed_array%values), size(input_array_1), & + "First array does not match in size: "//char(size(input_array_1))//" expected, " & + //char(size(typed_array%values))//" obtained.") if (allocated(error)) then call delete_file(output_file); return end if @@ -1204,7 +1207,9 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(2)%array) class is (t_array_cdp_1) - call check(error, size(typed_array%values), size(input_array_2), "Second array does not match in size.") + call check(error, size(typed_array%values), size(input_array_2), & + "Second array does not match in size: "//char(size(input_array_2))//" expected, " & + //char(size(typed_array%values))//" obtained.") if (allocated(error)) then call delete_file(output_file); return end if From c803c486650e39be120d8d0120fc4ab56a15f08c Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 20:53:11 +0530 Subject: [PATCH 096/146] Add prints --- test/io/test_np.f90 | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 04dd8b6da..aaefccf8e 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -3,7 +3,6 @@ module test_np use stdlib_filesystem, only : temp_dir, exists use stdlib_kinds, only : int8, int16, int32, int64, sp, dp use stdlib_io_np, only : save_npy, load_npy, load_npz, add_array, save_npz - use stdlib_string_type, only : char use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private @@ -1190,9 +1189,8 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(1)%array) class is (t_array_rdp_2) - call check(error, size(typed_array%values), size(input_array_1), & - "First array does not match in size: "//char(size(input_array_1))//" expected, " & - //char(size(typed_array%values))//" obtained.") + print *, size(typed_array%values), size(input_array_1) + call check(error, size(typed_array%values), size(input_array_1), "First array does not match in size.") if (allocated(error)) then call delete_file(output_file); return end if @@ -1207,9 +1205,7 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(2)%array) class is (t_array_cdp_1) - call check(error, size(typed_array%values), size(input_array_2), & - "Second array does not match in size: "//char(size(input_array_2))//" expected, " & - //char(size(typed_array%values))//" obtained.") + call check(error, size(typed_array%values), size(input_array_2), "Second array does not match in size.") if (allocated(error)) then call delete_file(output_file); return end if From bd3a93e84f9abbbde09f105d04fa1ba42dfbd84b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 21:10:45 +0530 Subject: [PATCH 097/146] Try allocate differently, run zip quietly --- src/stdlib_io_np_load.fypp | 2 +- src/stdlib_io_zip.f90 | 2 +- test/io/test_np.f90 | 1 - 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 874224229..e920f8f43 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -202,7 +202,7 @@ contains select type (typed_array => arrays(i)%array) class is (t_array_${t1[0]}$${k1}$_${rank}$) - typed_array%values = array + allocate(typed_array%value, source=array) class default msg = 'Failed to allocate values.'; stat = 1 close(io, status='delete'); return diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 8cd954b69..f4da9b374 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -43,7 +43,7 @@ subroutine zip(output_file, files, stat, msg, compressed) files_str = files_str//' '//char(files(i)) end do - cmd = 'zip '//''//output_file//' '//files_str + cmd = 'zip -q '//''//output_file//' '//files_str if (.not. is_compressed) cmd = cmd//' -0' call run(cmd, run_stat) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index aaefccf8e..2fe1e3bc5 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1189,7 +1189,6 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(1)%array) class is (t_array_rdp_2) - print *, size(typed_array%values), size(input_array_1) call check(error, size(typed_array%values), size(input_array_1), "First array does not match in size.") if (allocated(error)) then call delete_file(output_file); return From 53cf78617f062dd26ea4141173f76838841fae4e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 21:25:04 +0530 Subject: [PATCH 098/146] Fix typo --- src/stdlib_io_np_load.fypp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index e920f8f43..d9deb2499 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -202,7 +202,7 @@ contains select type (typed_array => arrays(i)%array) class is (t_array_${t1[0]}$${k1}$_${rank}$) - allocate(typed_array%value, source=array) + allocate(typed_array%values, source=array) class default msg = 'Failed to allocate values.'; stat = 1 close(io, status='delete'); return From c3d370a089e778689efa554e385cc4085029f593 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 21:31:24 +0530 Subject: [PATCH 099/146] Run unzip quietly --- src/stdlib_io_zip.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index f4da9b374..18d7f4a0f 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -88,7 +88,7 @@ subroutine unzip(filename, outputdir, stat, msg) end if end if - call run('unzip '//filename//' -d '//output_dir, run_stat) + call run('unzip -q '//filename//' -d '//output_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat if (present(msg)) msg = "Error unzipping '"//filename//"'." From e0057fcbc82a9d0f8a6c088682ad996f9c091c26 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 22:07:09 +0530 Subject: [PATCH 100/146] Add some more prints --- src/stdlib_io_np_load.fypp | 2 ++ test/io/test_np.f90 | 1 + 2 files changed, 3 insertions(+) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index d9deb2499..7ee99669a 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -203,6 +203,8 @@ contains select type (typed_array => arrays(i)%array) class is (t_array_${t1[0]}$${k1}$_${rank}$) allocate(typed_array%values, source=array) + print *, 'array size: ' size(array) + print *, 'typed_array%value size: ' size(typed_array%values) class default msg = 'Failed to allocate values.'; stat = 1 close(io, status='delete'); return diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 2fe1e3bc5..7f737bdf9 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1189,6 +1189,7 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(1)%array) class is (t_array_rdp_2) + print *, typed_array%values, input_array_1 call check(error, size(typed_array%values), size(input_array_1), "First array does not match in size.") if (allocated(error)) then call delete_file(output_file); return From 7b1e1dc7e95fab6c5fd82618968e2b60e04dfac2 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 22:19:11 +0530 Subject: [PATCH 101/146] Where is the comma --- src/stdlib_io_np_load.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 7ee99669a..2a0ed0fd5 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -203,8 +203,8 @@ contains select type (typed_array => arrays(i)%array) class is (t_array_${t1[0]}$${k1}$_${rank}$) allocate(typed_array%values, source=array) - print *, 'array size: ' size(array) - print *, 'typed_array%value size: ' size(typed_array%values) + print *, 'array size: ', size(array) + print *, 'typed_array%value size: ', size(typed_array%values) class default msg = 'Failed to allocate values.'; stat = 1 close(io, status='delete'); return From 4803954359edf181fefb3cf1608eae6e97021a66 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 15 Aug 2024 22:47:10 +0530 Subject: [PATCH 102/146] Remove prints, initialize stat to 0 --- src/stdlib_io_np_load.fypp | 4 +--- src/stdlib_io_np_save.fypp | 1 + test/io/test_np.f90 | 1 - 3 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 2a0ed0fd5..4f26b46bf 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -193,7 +193,7 @@ contains close(io, status='delete'); return end if - allocate (t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) + allocate(t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"' "//& & 'with total size of '//to_string(product(vshape)) @@ -203,8 +203,6 @@ contains select type (typed_array => arrays(i)%array) class is (t_array_${t1[0]}$${k1}$_${rank}$) allocate(typed_array%values, source=array) - print *, 'array size: ', size(array) - print *, 'typed_array%value size: ', size(typed_array%values) class default msg = 'Failed to allocate values.'; stat = 1 close(io, status='delete'); return diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 540ab5c1e..cefbd3fdc 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -214,6 +214,7 @@ contains type(string_type), allocatable :: files(:) if (present(iostat)) iostat = 0 + stat = 0 if (present(compressed)) then is_compressed = compressed diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 7f737bdf9..2fe1e3bc5 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1189,7 +1189,6 @@ subroutine npz_save_two_arrays(error) select type (typed_array => arrays_reloaded(1)%array) class is (t_array_rdp_2) - print *, typed_array%values, input_array_1 call check(error, size(typed_array%values), size(input_array_1), "First array does not match in size.") if (allocated(error)) then call delete_file(output_file); return From 6e6fa4b739732fb87f169822d15fcbb52a29a123 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 00:06:32 +0530 Subject: [PATCH 103/146] Print stuff --- src/stdlib_io_np_save.fypp | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index cefbd3fdc..72bd651d6 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -257,6 +257,13 @@ contains end select end do +do j = 1, size(files) + print *, as_string(files(j)) +end do +do j = 1, size(arrays) + print *, arrays(j)%array%name + print *, arrays(j)%array%values +end do call zip(filename, files, stat, msg, is_compressed) if (stat /= 0) then if (present(iostat)) iostat = stat From 5035d21eab6f30b8783f77f14c0a95f01041e0e8 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 00:20:56 +0530 Subject: [PATCH 104/146] Properly read value --- src/stdlib_io_np_save.fypp | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 72bd651d6..726d5c4d6 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -262,7 +262,13 @@ do j = 1, size(files) end do do j = 1, size(arrays) print *, arrays(j)%array%name - print *, arrays(j)%array%values + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default + end select end do call zip(filename, files, stat, msg, is_compressed) if (stat /= 0) then From 3beff30d543a076b824eec95e36c8a024c27ca8d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 03:20:33 +0530 Subject: [PATCH 105/146] Print --- src/stdlib_io_np_save.fypp | 28 +++++++++++++--------------- test/io/test_np.f90 | 13 ++++++++++++- 2 files changed, 25 insertions(+), 16 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 726d5c4d6..ed8084c8e 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -199,7 +199,7 @@ contains module subroutine save_arrays_to_npz(filename, arrays, iostat, iomsg, compressed) !> Name of the npz file to save to. character(len=*), intent(in) :: filename - !> Array of arrays to be saved. + !> Arrays to be saved. type(t_array_wrapper), intent(in) :: arrays(:) !> Optional error status of saving, zero on success. integer, intent(out), optional :: iostat @@ -221,8 +221,19 @@ contains else is_compressed = .false. end if +print *, 'in subroutine' +do j = 1, size(arrays) + print *, arrays(j)%array%name + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default + end select +end do - if (.not. allocated(files)) allocate(files(0)) + allocate(files(0)) do i = 1, size(arrays) select type (typed_array => arrays(i)%array) #:for k1, t1 in KINDS_TYPES @@ -257,19 +268,6 @@ contains end select end do -do j = 1, size(files) - print *, as_string(files(j)) -end do -do j = 1, size(arrays) - print *, arrays(j)%array%name - select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default - end select -end do call zip(filename, files, stat, msg, is_compressed) if (stat /= 0) then if (present(iostat)) iostat = stat diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 2fe1e3bc5..b33f31b7f 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1148,7 +1148,7 @@ subroutine npz_save_two_arrays(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) - integer :: stat + integer :: stat, j real(dp), allocatable :: input_array_1(:,:) complex(dp), allocatable :: input_array_2(:) character(*), parameter :: array_name_1 = "array_1" @@ -1167,6 +1167,17 @@ subroutine npz_save_two_arrays(error) if (allocated(error)) return call check(error, size(arrays) == 2, "Wrong array size.") if (allocated(error)) return +print *, 'in test' +do j = 1, size(arrays) + print *, arrays(j)%array%name + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default + end select +end do call save_npz(output_file, arrays, stat) call check(error, stat, "Error saving arrays as an npz file.") if (allocated(error)) then From 36b7ad736303678348310ecdc2f8457d3cd51107 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 03:37:40 +0530 Subject: [PATCH 106/146] Use other array notation --- test/io/test_np.f90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index b33f31b7f..1798337a3 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1158,15 +1158,17 @@ subroutine npz_save_two_arrays(error) allocate(input_array_1(5, 6)) call random_number(input_array_1) - input_array_2 = [(1.0_dp, 2.0_dp), (3.0_dp, 4.0_dp), (5.0_dp, 6.0_dp)] call add_array(arrays, input_array_1, stat, name=array_name_1) call check(error, stat, "Error adding array 1 to the list of arrays.") if (allocated(error)) return + + input_array_2 = (/(1.0_dp, 2.0_dp), (3.0_dp, 4.0_dp), (5.0_dp, 6.0_dp)/) call add_array(arrays, input_array_2, stat, name=array_name_2) call check(error, stat, "Error adding array 2 to the list of arrays.") if (allocated(error)) return call check(error, size(arrays) == 2, "Wrong array size.") if (allocated(error)) return + print *, 'in test' do j = 1, size(arrays) print *, arrays(j)%array%name @@ -1178,6 +1180,7 @@ subroutine npz_save_two_arrays(error) class default end select end do + call save_npz(output_file, arrays, stat) call check(error, stat, "Error saving arrays as an npz file.") if (allocated(error)) then From 0c0c4a1597ef146a5115ab3321017df47f977d7d Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 03:53:32 +0530 Subject: [PATCH 107/146] Maybe it needs allocation --- test/io/test_np.f90 | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 1798337a3..5bb7d75c5 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1161,15 +1161,8 @@ subroutine npz_save_two_arrays(error) call add_array(arrays, input_array_1, stat, name=array_name_1) call check(error, stat, "Error adding array 1 to the list of arrays.") if (allocated(error)) return - - input_array_2 = (/(1.0_dp, 2.0_dp), (3.0_dp, 4.0_dp), (5.0_dp, 6.0_dp)/) - call add_array(arrays, input_array_2, stat, name=array_name_2) - call check(error, stat, "Error adding array 2 to the list of arrays.") - if (allocated(error)) return - call check(error, size(arrays) == 2, "Wrong array size.") - if (allocated(error)) return -print *, 'in test' +print *, 'first array' do j = 1, size(arrays) print *, arrays(j)%array%name select type (typed_array => arrays(1)%array) @@ -1181,6 +1174,25 @@ subroutine npz_save_two_arrays(error) end select end do + allocate(input_array_2, source=[(1.0_dp, 2.0_dp), (3.0_dp, 4.0_dp), (5.0_dp, 6.0_dp)]) + call add_array(arrays, input_array_2, stat, name=array_name_2) + call check(error, stat, "Error adding array 2 to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 2, "Wrong array size.") + if (allocated(error)) return + + print *, 'in test' + do j = 1, size(arrays) + print *, arrays(j)%array%name + select type (typed_array => arrays(1)%array) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default + end select + end do + call save_npz(output_file, arrays, stat) call check(error, stat, "Error saving arrays as an npz file.") if (allocated(error)) then From c5134f28e6d68017e343843cc6119dfc484ef672 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 04:16:01 +0530 Subject: [PATCH 108/146] Use another notation --- src/stdlib_io_np_save.fypp | 11 ----------- test/io/test_np.f90 | 26 +------------------------- 2 files changed, 1 insertion(+), 36 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index ed8084c8e..711e85e59 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -221,17 +221,6 @@ contains else is_compressed = .false. end if -print *, 'in subroutine' -do j = 1, size(arrays) - print *, arrays(j)%array%name - select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default - end select -end do allocate(files(0)) do i = 1, size(arrays) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 5bb7d75c5..2299e19cb 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1162,37 +1162,13 @@ subroutine npz_save_two_arrays(error) call check(error, stat, "Error adding array 1 to the list of arrays.") if (allocated(error)) return -print *, 'first array' -do j = 1, size(arrays) - print *, arrays(j)%array%name - select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default - end select -end do - - allocate(input_array_2, source=[(1.0_dp, 2.0_dp), (3.0_dp, 4.0_dp), (5.0_dp, 6.0_dp)]) + input_array_2 = [cmplx(1, 2, kind=8), cmplx(3, 4, kind=8), cmplx(5, 6, kind=8)] call add_array(arrays, input_array_2, stat, name=array_name_2) call check(error, stat, "Error adding array 2 to the list of arrays.") if (allocated(error)) return call check(error, size(arrays) == 2, "Wrong array size.") if (allocated(error)) return - print *, 'in test' - do j = 1, size(arrays) - print *, arrays(j)%array%name - select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default - end select - end do - call save_npz(output_file, arrays, stat) call check(error, stat, "Error saving arrays as an npz file.") if (allocated(error)) then From bdbd9c9c152740fe2150b7027ce0daa49e5bad7f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 04:31:03 +0530 Subject: [PATCH 109/146] Let's use a constant literal --- test/io/test_np.f90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 2299e19cb..66e3414dc 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1150,7 +1150,7 @@ subroutine npz_save_two_arrays(error) type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) integer :: stat, j real(dp), allocatable :: input_array_1(:,:) - complex(dp), allocatable :: input_array_2(:) + complex(dp), parameter, dimension(3) :: input_array_2 = [cmplx(1, 2, kind=8), cmplx(3, 4, kind=8), cmplx(5, 6, kind=8)] character(*), parameter :: array_name_1 = "array_1" character(*), parameter :: array_name_2 = "array_2" character(*), parameter :: output_file = "two_arrays.npz" @@ -1162,7 +1162,6 @@ subroutine npz_save_two_arrays(error) call check(error, stat, "Error adding array 1 to the list of arrays.") if (allocated(error)) return - input_array_2 = [cmplx(1, 2, kind=8), cmplx(3, 4, kind=8), cmplx(5, 6, kind=8)] call add_array(arrays, input_array_2, stat, name=array_name_2) call check(error, stat, "Error adding array 2 to the list of arrays.") if (allocated(error)) return From ded2c3ca4d6f1f877a12b3176e9f8bcf463b152a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 04:48:13 +0530 Subject: [PATCH 110/146] Use proper allocates in add_array --- src/stdlib_io_np_save.fypp | 4 ++-- test/io/test_np.f90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 711e85e59..291926f87 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -170,7 +170,7 @@ contains end if end if - t_arr%values = array + allocate(t_arr%values, source=array) if (.not. allocated(arrays)) then allocate(arrays(1)) @@ -186,7 +186,7 @@ contains end if end do - wrapper%array = t_arr + allocate(wrapper%array, source=t_arr) arrays = [arrays, wrapper] end #:endfor diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 66e3414dc..8161d56f9 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1150,7 +1150,7 @@ subroutine npz_save_two_arrays(error) type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) integer :: stat, j real(dp), allocatable :: input_array_1(:,:) - complex(dp), parameter, dimension(3) :: input_array_2 = [cmplx(1, 2, kind=8), cmplx(3, 4, kind=8), cmplx(5, 6, kind=8)] + complex(dp), parameter :: input_array_2(3) = [(1, 2._dp), (3, 4._dp), (5, 6._dp)] character(*), parameter :: array_name_1 = "array_1" character(*), parameter :: array_name_2 = "array_2" character(*), parameter :: output_file = "two_arrays.npz" From a8d11818d210d5a6b7f93319b431b4560fefc709 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 05:09:23 +0530 Subject: [PATCH 111/146] Print in add_array --- src/stdlib_io_np_save.fypp | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 291926f87..b0a055f58 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -172,6 +172,15 @@ contains allocate(t_arr%values, source=array) +print *, 'after allocating values' +select type (typed_array => t_arr%values) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default +end select + if (.not. allocated(arrays)) then allocate(arrays(1)) allocate(arrays(1)%array, source=t_arr) @@ -187,7 +196,29 @@ contains end do allocate(wrapper%array, source=t_arr) + +print *, 'after allocating wrapper' +select type (typed_array => t_arr%values) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default +end select + arrays = [arrays, wrapper] + +print *, 'after allocating arrays' +do i = 1, size(arrays) + print *, arrays(i)%array%name + select type (typed_array => arrays(i)%array) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default + end select +end do end #:endfor #:endfor From 473f193d6da4cfbcf67b466d466e319369099245 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 15:40:52 +0530 Subject: [PATCH 112/146] Print properly --- src/stdlib_io_np_save.fypp | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index b0a055f58..98902b591 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -173,13 +173,7 @@ contains allocate(t_arr%values, source=array) print *, 'after allocating values' -select type (typed_array => t_arr%values) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default -end select +print *, array if (.not. allocated(arrays)) then allocate(arrays(1)) @@ -198,7 +192,9 @@ end select allocate(wrapper%array, source=t_arr) print *, 'after allocating wrapper' -select type (typed_array => t_arr%values) +print *, 't_arr: ', t_arr%values +print *, 'wrapper: ' +select type (typed_array => wrapper%array) class is (t_array_rdp_2) print *, typed_array%values class is (t_array_cdp_1) @@ -208,17 +204,17 @@ end select arrays = [arrays, wrapper] -print *, 'after allocating arrays' -do i = 1, size(arrays) - print *, arrays(i)%array%name - select type (typed_array => arrays(i)%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default - end select -end do +! print *, 'after allocating arrays' +! do i = 1, size(arrays) +! print *, arrays(i)%array%name +! select type (typed_array => arrays(i)%array) +! class is (t_array_rdp_2) +! print *, typed_array%values +! class is (t_array_cdp_1) +! print *, typed_array%values +! class default +! end select +! end do end #:endfor #:endfor From feb93f5363e41253f0338f655c70a65c764e3a51 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 16:08:52 +0530 Subject: [PATCH 113/146] Print the most important part --- src/stdlib_io_np_save.fypp | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 98902b591..e0fc15f76 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -171,10 +171,6 @@ contains end if allocate(t_arr%values, source=array) - -print *, 'after allocating values' -print *, array - if (.not. allocated(arrays)) then allocate(arrays(1)) allocate(arrays(1)%array, source=t_arr) @@ -191,8 +187,6 @@ print *, array allocate(wrapper%array, source=t_arr) -print *, 'after allocating wrapper' -print *, 't_arr: ', t_arr%values print *, 'wrapper: ' select type (typed_array => wrapper%array) class is (t_array_rdp_2) @@ -204,17 +198,17 @@ end select arrays = [arrays, wrapper] -! print *, 'after allocating arrays' -! do i = 1, size(arrays) -! print *, arrays(i)%array%name -! select type (typed_array => arrays(i)%array) -! class is (t_array_rdp_2) -! print *, typed_array%values -! class is (t_array_cdp_1) -! print *, typed_array%values -! class default -! end select -! end do +print *, 'after allocating arrays' +do i = 1, size(arrays) + print *, arrays(i)%array%name + select type (typed_array => arrays(i)%array) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default + end select +end do end #:endfor #:endfor From ac91b2fe47550f733c630d2d23e2d6511cb1d0e2 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 16:21:34 +0530 Subject: [PATCH 114/146] Print before and after adding wrapper to array --- src/stdlib_io_np_save.fypp | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index e0fc15f76..04ef7ca46 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -187,18 +187,21 @@ contains allocate(wrapper%array, source=t_arr) -print *, 'wrapper: ' -select type (typed_array => wrapper%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default -end select +print *, 'before adding to arrays' +do i = 1, size(arrays) + print *, arrays(i)%array%name + select type (typed_array => arrays(i)%array) + class is (t_array_rdp_2) + print *, typed_array%values + class is (t_array_cdp_1) + print *, typed_array%values + class default + end select +end do arrays = [arrays, wrapper] -print *, 'after allocating arrays' +print *, 'after adding to arrays' do i = 1, size(arrays) print *, arrays(i)%array%name select type (typed_array => arrays(i)%array) From fd426c7b0fd2bcaf1094df066930db75024b5b70 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 16:31:05 +0530 Subject: [PATCH 115/146] Invert addition and allocation --- src/stdlib_io_np_save.fypp | 27 +-------------------------- 1 file changed, 1 insertion(+), 26 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 04ef7ca46..45a4c11c8 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -185,33 +185,8 @@ contains end if end do - allocate(wrapper%array, source=t_arr) - -print *, 'before adding to arrays' -do i = 1, size(arrays) - print *, arrays(i)%array%name - select type (typed_array => arrays(i)%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default - end select -end do - arrays = [arrays, wrapper] - -print *, 'after adding to arrays' -do i = 1, size(arrays) - print *, arrays(i)%array%name - select type (typed_array => arrays(i)%array) - class is (t_array_rdp_2) - print *, typed_array%values - class is (t_array_cdp_1) - print *, typed_array%values - class default - end select -end do + allocate(wrapper%array, source=t_arr) end #:endfor #:endfor From 666bd515a78601f83273d9072fb98847370a8dc5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 17:29:53 +0530 Subject: [PATCH 116/146] Use tmp_array for allocation instead --- src/stdlib_io_np_save.fypp | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 45a4c11c8..4db8eafd2 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -149,9 +149,10 @@ contains !> Name of the array to be added. A default name will be used if not provided. character(len=*), intent(in), optional :: name - integer :: i + integer :: i, arr_size type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr - type(t_array_wrapper) :: wrapper + type(t_array_wrapper), allocatable :: tmp_arrays(:) + if (present(stat)) stat = 0 @@ -177,7 +178,8 @@ contains return end if - do i = 1, size(arrays) + arr_size = size(arrays) + do i = 1, arr_size if (arrays(i)%array%name == t_arr%name) then if (present(stat)) stat = 1 if (present(msg)) msg = "Array with the same name '"//t_arr%name//"' already exists." @@ -185,8 +187,10 @@ contains end if end do - arrays = [arrays, wrapper] - allocate(wrapper%array, source=t_arr) + allocate(tmp_arrays(arr_size + 1)) + tmp_arrays(:arr_size) = arrays + allocate(tmp_arrays(arr_size + 1)%array, source=t_arr) + call move_alloc(tmp_arrays, arrays) end #:endfor #:endfor From d538078521e536b07047135838bdd60376a7989c Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 19:16:50 +0530 Subject: [PATCH 117/146] Add examples --- example/io/CMakeLists.txt | 2 ++ example/io/example_load_npz.f90 | 21 +++++++++++++++++++++ example/io/example_save_npz.f90 | 14 ++++++++++++++ example_load.npz | Bin 0 -> 618 bytes 4 files changed, 37 insertions(+) create mode 100644 example/io/example_load_npz.f90 create mode 100644 example/io/example_save_npz.f90 create mode 100644 example_load.npz diff --git a/example/io/CMakeLists.txt b/example/io/CMakeLists.txt index 2e606d2d1..ea420ee0c 100644 --- a/example/io/CMakeLists.txt +++ b/example/io/CMakeLists.txt @@ -5,3 +5,5 @@ ADD_EXAMPLE(loadtxt) ADD_EXAMPLE(open) ADD_EXAMPLE(savenpy) ADD_EXAMPLE(savetxt) +ADD_EXAMPLE(load_npz) +ADD_EXAMPLE(save_npz) diff --git a/example/io/example_load_npz.f90 b/example/io/example_load_npz.f90 new file mode 100644 index 000000000..66d3a01eb --- /dev/null +++ b/example/io/example_load_npz.f90 @@ -0,0 +1,21 @@ +program example_load_npz + use stdlib_array + use stdlib_io_np, only: load_npz + implicit none + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: i + + call load_npz('example_load.npz', arrays) + + do i = 1, size(arrays) + select type (array => arrays(i)%array) + class is (t_array_rsp_2) + print *, array%values + class is (t_array_iint32_2) + print *, array%values + class default + print *, 'Array ', i, ' is of unknown type.' + end select + end do +end diff --git a/example/io/example_save_npz.f90 b/example/io/example_save_npz.f90 new file mode 100644 index 000000000..ce4c930fe --- /dev/null +++ b/example/io/example_save_npz.f90 @@ -0,0 +1,14 @@ +program example_save_npz + use stdlib_array, only: t_array_wrapper + use stdlib_io_np, only: add_array, save_npz + implicit none + + type(t_array_wrapper), allocatable :: arrays(:) + real :: x(3, 2) = 1 + integer :: y(2, 3) = 2 + + call add_array(arrays, x) + call add_array(arrays, y) + + call save_npz('example_save.npz', arrays) +end diff --git a/example_load.npz b/example_load.npz new file mode 100644 index 0000000000000000000000000000000000000000..1592ce1731537af91d3ef168ed018d9305b16e2d GIT binary patch literal 618 zcmWIWW@h1H00E&H0+Et=4}@j_*&xixAj6PYR1|NZmse038p6rITobZC4TMW8xEUB( zzA`c}u!sN^PWB7+4Txl9C}XHrPf0CKE>gErP`61lQP)vWPs=YVDN4+X&o4?z1&N0g zm8JrPi!%}nQh{6zV;uz}9R*Dtg<1u20nqgg_SkR$s@It9j-h+akUXzt66H0Zzkt4@ z%xg@*;KhamycwC~m~q9M1W*?QENKMMNU_KYiAA&+#4rvetdNbn4K)rLa=46RWdqsE P1cdW|^fq8hVPF6N?A3M_ literal 0 HcmV?d00001 From 96a49a24f17a561480f603a60ac150ab61561242 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 16 Aug 2024 19:44:04 +0530 Subject: [PATCH 118/146] Relocate add_array to stdlib_array bc that's where it belongs --- example/io/example_save_npz.f90 | 4 +- src/stdlib_array.fypp | 82 ++++++++++++++++++++++++++++++++- src/stdlib_io_np.fypp | 21 +-------- src/stdlib_io_np_save.fypp | 60 ------------------------ test/io/test_np.f90 | 2 +- 5 files changed, 85 insertions(+), 84 deletions(-) diff --git a/example/io/example_save_npz.f90 b/example/io/example_save_npz.f90 index ce4c930fe..d06334a2a 100644 --- a/example/io/example_save_npz.f90 +++ b/example/io/example_save_npz.f90 @@ -1,6 +1,6 @@ program example_save_npz - use stdlib_array, only: t_array_wrapper - use stdlib_io_np, only: add_array, save_npz + use stdlib_array, only: t_array_wrapper, add_array + use stdlib_io_np, only: save_npz implicit none type(t_array_wrapper), allocatable :: arrays(:) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 37fe35ab9..936277d95 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -9,10 +9,11 @@ !> 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 + use stdlib_strings, only: to_string implicit none private - public :: trueloc, falseloc + public :: add_array, trueloc, falseloc !> Helper class to allocate t_array as an abstract type. type, public :: t_array_wrapper @@ -31,8 +32,87 @@ module stdlib_array #:endfor #:endfor + interface add_array +#:for k1, t1 in KINDS_TYPES +#:for rank in RANKS + module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) + !> Array of arrays to which the array is to be added. + type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) + !> Array to be added. + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + !> Status of addition. + integer, intent(out), optional :: stat + !> Error message. + character(len=:), allocatable, intent(out), optional :: msg + !> Name of the array to be added. A default name will be used if not provided. + character(len=*), intent(in), optional :: name + end +#:endfor +#:endfor + end interface + contains +#:for k1, t1 in KINDS_TYPES +#:for rank in RANKS + module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) + !> Array of arrays to which the array is to be added. + type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) + !> Array to be added. + ${t1}$, intent(in) :: array${ranksuffix(rank)}$ + !> Status of addition. + integer, intent(out), optional :: stat + !> Error message. + character(len=:), allocatable, intent(out), optional :: msg + !> Name of the array to be added. A default name will be used if not provided. + character(len=*), intent(in), optional :: name + + integer :: i, arr_size + type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr + type(t_array_wrapper), allocatable :: tmp_arrays(:) + + + if (present(stat)) stat = 0 + + if (present(name)) then + if (trim(name) == '') then + if (present(stat)) stat = 1 + if (present(msg)) msg = "Array name cannot be empty." + return + end if + t_arr%name = name + else + if (allocated(arrays)) then + t_arr%name = "arr_"//to_string(size(arrays))//".npy" + else + t_arr%name = "arr_0.npy" + end if + end if + + allocate(t_arr%values, source=array) + if (.not. allocated(arrays)) then + allocate(arrays(1)) + allocate(arrays(1)%array, source=t_arr) + return + end if + + arr_size = size(arrays) + do i = 1, arr_size + if (arrays(i)%array%name == t_arr%name) then + if (present(stat)) stat = 1 + if (present(msg)) msg = "Array with the same name '"//t_arr%name//"' already exists." + return + end if + end do + + allocate(tmp_arrays(arr_size + 1)) + tmp_arrays(:arr_size) = arrays + allocate(tmp_arrays(arr_size + 1)%array, source=t_arr) + call move_alloc(tmp_arrays, arrays) + end +#:endfor +#:endfor + !> Version: experimental !> !> Return the positions of the true elements in array. diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index cf46505f2..98574b9dd 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -74,7 +74,7 @@ module stdlib_io_np implicit none private - public :: load_npy, save_npy, load_npz, save_npz, add_array + public :: load_npy, save_npy, load_npz, save_npz character(len=*), parameter :: & type_iint8 = " Array of arrays to which the array is to be added. - type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) - !> Array to be added. - ${t1}$, intent(in) :: array${ranksuffix(rank)}$ - !> Status of addition. - integer, intent(out), optional :: stat - !> Error message. - character(len=:), allocatable, intent(out), optional :: msg - !> Name of the array to be added. A default name will be used if not provided. - character(len=*), intent(in), optional :: name - end -#:endfor -#:endfor - end interface end diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 4db8eafd2..76c16b622 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -133,66 +133,6 @@ contains end if end #:endfor -#:endfor - -#:for k1, t1 in KINDS_TYPES -#:for rank in RANKS - module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) - !> Array of arrays to which the array is to be added. - type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) - !> Array to be added. - ${t1}$, intent(in) :: array${ranksuffix(rank)}$ - !> Status of addition. - integer, intent(out), optional :: stat - !> Error message. - character(len=:), allocatable, intent(out), optional :: msg - !> Name of the array to be added. A default name will be used if not provided. - character(len=*), intent(in), optional :: name - - integer :: i, arr_size - type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr - type(t_array_wrapper), allocatable :: tmp_arrays(:) - - - if (present(stat)) stat = 0 - - if (present(name)) then - if (trim(name) == '') then - if (present(stat)) stat = 1 - if (present(msg)) msg = "Array name cannot be empty." - return - end if - t_arr%name = name - else - if (allocated(arrays)) then - t_arr%name = "arr_"//to_string(size(arrays))//".npy" - else - t_arr%name = "arr_0.npy" - end if - end if - - allocate(t_arr%values, source=array) - if (.not. allocated(arrays)) then - allocate(arrays(1)) - allocate(arrays(1)%array, source=t_arr) - return - end if - - arr_size = size(arrays) - do i = 1, arr_size - if (arrays(i)%array%name == t_arr%name) then - if (present(stat)) stat = 1 - if (present(msg)) msg = "Array with the same name '"//t_arr%name//"' already exists." - return - end if - end do - - allocate(tmp_arrays(arr_size + 1)) - tmp_arrays(:arr_size) = arrays - allocate(tmp_arrays(arr_size + 1)%array, source=t_arr) - call move_alloc(tmp_arrays, arrays) - end -#:endfor #:endfor !> Version: experimental diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 8161d56f9..9afdf03e0 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -2,7 +2,7 @@ module test_np use stdlib_array use stdlib_filesystem, only : temp_dir, exists use stdlib_kinds, only : int8, int16, int32, int64, sp, dp - use stdlib_io_np, only : save_npy, load_npy, load_npz, add_array, save_npz + use stdlib_io_np, only : save_npy, load_npy, load_npz, save_npz use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private From 5b3506df6ee588c2265dae53222f1fd04a1dce45 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Aug 2024 01:36:55 +0530 Subject: [PATCH 119/146] Set working directory directly in cmake --- test/CMakeLists.txt | 9 --------- test/io/CMakeLists.txt | 16 ++++----------- test/io/test_np.f90 | 34 ++++++++----------------------- test/io/test_zip.f90 | 45 +++++++----------------------------------- 4 files changed, 19 insertions(+), 85 deletions(-) diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 3c3377813..67001cea3 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -31,12 +31,3 @@ add_subdirectory(quadrature) add_subdirectory(math) add_subdirectory(stringlist) add_subdirectory(terminal) - -set(setRootDir - test_np - test_zip -) - -foreach(target ${setRootDir}) - target_compile_definitions(${target} PRIVATE TEST_ROOT_DIR="${CMAKE_CURRENT_SOURCE_DIR}") -endforeach() diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 25148b3db..7009b1e67 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -5,17 +5,6 @@ set( ) fypp_f90("${fyppFlags}" "${fppFiles}" outFiles) -set(needsCPP - test_np.f90 - test_zip.f90 -) - -if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") - set_source_files_properties(${needsCPP} PROPERTIES COMPILE_FLAGS "-cpp") -elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "Intel") - set_source_files_properties(${needsCPP} PROPERTIES COMPILE_FLAGS "-fpp") -endif() - ADDTEST(loadtxt) ADDTEST(savetxt) @@ -26,7 +15,10 @@ set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) ADDTEST(filesystem) ADDTEST(getline) -ADDTEST(np) ADDTEST(open) ADDTEST(parse_mode) + +ADDTEST(np) ADDTEST(zip) +set_tests_properties(np PROPERTIES WORKING_DIRECTORY ${PROJECT_SOURCE_DIR}) +set_tests_properties(zip PROPERTIES WORKING_DIRECTORY ${PROJECT_SOURCE_DIR}) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 9afdf03e0..fbee87a3f 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -9,6 +9,8 @@ module test_np public :: collect_np + character(*), parameter :: path_to_zip_files = "test/io/zip_files/" + contains !> Collect all exported unit tests @@ -737,10 +739,8 @@ subroutine npz_load_arr_empty_0(error) integer :: stat character(*), parameter :: filename = "empty_0.npz" character(*), parameter :: tmp = temp_dir//"/empty_0" - character(:), allocatable :: path - + character(*), parameter :: path = path_to_zip_files//filename - path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz that contains a single empty array shouldn't fail.") if (allocated(error)) return @@ -763,9 +763,8 @@ subroutine npz_load_arr_rand_2_3(error) integer :: stat character(*), parameter :: filename = "rand_2_3.npz" character(*), parameter :: tmp = temp_dir//"/rand_2_3" - character(:), allocatable :: path + character(*), parameter :: path = path_to_zip_files//filename - path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") if (allocated(error)) return @@ -788,10 +787,8 @@ subroutine npz_load_arr_arange_10_20(error) integer :: stat, i character(*), parameter :: filename = "arange_10_20.npz" character(*), parameter :: tmp = temp_dir//"/arange_10_20" + character(*), parameter :: path = path_to_zip_files//filename - character(:), allocatable :: path - - path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") if (allocated(error)) return @@ -821,9 +818,8 @@ subroutine npz_load_arr_cmplx(error) integer :: stat character(*), parameter :: filename = "cmplx_arr.npz" character(*), parameter :: tmp = temp_dir//"/cmplx_arr" - character(:), allocatable :: path + character(*), parameter :: path = path_to_zip_files//filename - path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains a valid nd_array shouldn't fail.") if (allocated(error)) return @@ -853,9 +849,8 @@ subroutine npz_load_two_arr_iint64_rdp(error) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp.npz" character(*), parameter :: tmp = temp_dir//"/two_arr_iint64_rdp" - character(:), allocatable :: path + character(*), parameter :: path = path_to_zip_files//filename - path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading an npz file that contains valid nd_arrays shouldn't fail.") if (allocated(error)) return @@ -900,9 +895,8 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" character(*), parameter :: tmp = temp_dir//"/two_arr_iint64_rdp_comp" - character(:), allocatable :: path + character(*), parameter :: path = path_to_zip_files//filename - path = get_path(filename) call load_npz(path, arrays, stat, tmp_dir=tmp) call check(error, stat, "Loading a compressed npz file that contains valid nd_arrays shouldn't fail.") if (allocated(error)) return @@ -1220,18 +1214,6 @@ subroutine npz_save_two_arrays(error) call delete_file(output_file) end - !> Makes sure that we find the file when running both `ctest` and `fpm test`. - function get_path(file) result(path) - character(*), intent(in) :: file - character(:), allocatable :: path - -#ifdef TEST_ROOT_DIR - path = TEST_ROOT_DIR//'/io/zip_files/'//file -#else - path = 'test/io/zip_files/'//file -#endif - end - subroutine delete_file(filename) character(len=*), intent(in) :: filename diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index f95020d56..6ab246a43 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -8,6 +8,8 @@ module test_zip public :: collect_zip + character(*), parameter :: path_to_zip_files = "test/io/zip_files/" + contains !> Collect all exported unit tests @@ -87,12 +89,7 @@ subroutine unzip_zip_has_empty_file(error) integer :: stat character(*), parameter :: filename = "empty.zip" - character(:), allocatable :: path - - path = get_path(filename) - if (.not. allocated(path)) then - call test_failed(error, "The file '"//filename//"' could not be found."); return - end if + character(*), parameter :: path = path_to_zip_files//filename call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") @@ -103,12 +100,7 @@ subroutine unzip_zip_has_txt_file(error) integer :: stat character(*), parameter :: filename = "textfile.zip" - character(:), allocatable :: path - - path = get_path(filename) - if (.not. allocated(path)) then - call test_failed(error, "The file '"//filename//"' could not be found."); return - end if + character(*), parameter :: path = path_to_zip_files//filename call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") @@ -119,12 +111,7 @@ subroutine unzip_npz_array_empty_0_file(error) integer :: stat character(*), parameter :: filename = "empty_0.npz" - character(:), allocatable :: path - - path = get_path(filename) - if (.not. allocated(path)) then - call test_failed(error, "The file '"//filename//"' could not be found."); return - end if + character(*), parameter :: path = path_to_zip_files//filename call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") @@ -135,12 +122,7 @@ subroutine unzip_two_files(error) integer :: stat character(*), parameter :: filename = "two_files.zip" - character(:), allocatable :: path - - path = get_path(filename) - if (.not. allocated(path)) then - call test_failed(error, "The file '"//filename//"' could not be found."); return - end if + character(*), parameter :: path = path_to_zip_files//filename call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a zip file that contains an empty file should not fail.") @@ -151,9 +133,8 @@ subroutine unzip_compressed_npz(error) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" - character(:), allocatable :: path + character(*), parameter :: path = path_to_zip_files//filename - path = get_path(filename) call unzip(path, stat=stat) call check(error, stat, "Listing the contents of a compressed npz file should not fail.") end @@ -292,18 +273,6 @@ subroutine zip_without_comp(error) call delete_file(output_file) end - !> Makes sure that we find the file when running both `ctest` and `fpm test`. - function get_path(file) result(path) - character(*), intent(in) :: file - character(:), allocatable :: path - -#ifdef TEST_ROOT_DIR - path = TEST_ROOT_DIR//'/io/zip_files/'//file -#else - path = 'test/io/zip_files/'//file -#endif - end - subroutine delete_file(filename) character(len=*), intent(in) :: filename From 751d4953471e5cf42088759d9c729f4e689f0974 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Aug 2024 16:23:24 +0530 Subject: [PATCH 120/146] Print pwd --- src/stdlib_io_zip.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 18d7f4a0f..7124b157d 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -88,6 +88,8 @@ subroutine unzip(filename, outputdir, stat, msg) end if end if + print *, 'hellohello' + call execute_command_line('pwd') call run('unzip -q '//filename//' -d '//output_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat From 9e9c76d030aa91b53a44c39c107d8fc90740c00e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Aug 2024 17:38:21 +0530 Subject: [PATCH 121/146] Fix unzip and check for file existence --- src/stdlib_io_zip.f90 | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 7124b157d..27bbd5b84 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -8,7 +8,6 @@ module stdlib_io_zip character(*), parameter :: default_unzip_dir = temp_dir//'/unzipped_files' character(*), parameter :: zip_contents = default_unzip_dir//'/zip_contents.txt' - character(*), parameter :: default_zip_dir = temp_dir//'.' contains @@ -72,14 +71,20 @@ subroutine unzip(filename, outputdir, stat, msg) if (present(stat)) stat = 0 run_stat = 0 - call run('rm -rf '//default_unzip_dir, run_stat) + if (.not. exists(filename)) then + if (present(stat)) stat = 1 + if (present(msg)) msg = "File '"//filename//"' does not exist." + return + end if + + call run('rm -rf '//output_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat - if (present(msg)) msg = "Error removing folder '"//default_unzip_dir//"'." + if (present(msg)) msg = "Error removing folder '"//output_dir//"'." return end if - if (.not. exists(temp_dir)) then + if (.not. present(outputdir) .and. .not. exists(temp_dir)) then call run('mkdir '//temp_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat @@ -88,8 +93,6 @@ subroutine unzip(filename, outputdir, stat, msg) end if end if - print *, 'hellohello' - call execute_command_line('pwd') call run('unzip -q '//filename//' -d '//output_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat From eb4db699ebef71d40701b7270d5d32a9a5bdb1b9 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Aug 2024 20:24:01 +0530 Subject: [PATCH 122/146] Create temp dir --- src/stdlib_io_zip.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 27bbd5b84..f3bf6d9a0 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -1,6 +1,7 @@ module stdlib_io_zip use stdlib_filesystem, only: exists, run, temp_dir use stdlib_string_type, only: string_type, char + use stdlib_strings, only: starts_with implicit none private @@ -84,7 +85,7 @@ subroutine unzip(filename, outputdir, stat, msg) return end if - if (.not. present(outputdir) .and. .not. exists(temp_dir)) then + if (starts_with(output_dir, temp_dir) .and. .not. exists(temp_dir)) then call run('mkdir '//temp_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat From 69d4798f164e20397c0a8f92572bf5ea14406321 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Sat, 17 Aug 2024 20:37:59 +0530 Subject: [PATCH 123/146] Move example npz file to io --- example.npy | 0 example_load.npz => example/io/example_load.npz | Bin src/stdlib_io_zip.f90 | 6 ------ 3 files changed, 6 deletions(-) create mode 100644 example.npy rename example_load.npz => example/io/example_load.npz (100%) diff --git a/example.npy b/example.npy new file mode 100644 index 000000000..e69de29bb diff --git a/example_load.npz b/example/io/example_load.npz similarity index 100% rename from example_load.npz rename to example/io/example_load.npz diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index f3bf6d9a0..17287b7d0 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -72,12 +72,6 @@ subroutine unzip(filename, outputdir, stat, msg) if (present(stat)) stat = 0 run_stat = 0 - if (.not. exists(filename)) then - if (present(stat)) stat = 1 - if (present(msg)) msg = "File '"//filename//"' does not exist." - return - end if - call run('rm -rf '//output_dir, run_stat) if (run_stat /= 0) then if (present(stat)) stat = run_stat From acea2a31933cfe2d8e881aac9bea315f00040f95 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 21:37:18 +0530 Subject: [PATCH 124/146] Revert ci changes --- .github/workflows/ci_windows.yml | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index c20ab0a77..e64d7377d 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -13,14 +13,17 @@ jobs: fail-fast: false matrix: include: - [{ msystem: MINGW64, arch: x86_64 }, { msystem: MINGW32, arch: i686 }] + [ + { msystem: MSYS, arch: x86_64 }, + { msystem: MINGW64, arch: x86_64 }, + { msystem: MINGW32, arch: i686 }, + ] defaults: run: shell: msys2 {0} steps: - uses: actions/checkout@v2 - - - name: Setup MinGW native environment + - name: Setup environment uses: msys2/setup-msys2@v2 with: msystem: ${{ matrix.msystem }} From d0cbbbca402f5431e66dd4cffadb5a970e6e35c3 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 21:43:28 +0530 Subject: [PATCH 125/146] Revert CI changes all the way --- .github/workflows/ci_windows.yml | 35 +++++++++++++++++++++++--------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index e64d7377d..e4ce407f1 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -23,8 +23,9 @@ jobs: shell: msys2 {0} steps: - uses: actions/checkout@v2 - - name: Setup environment + - name: Setup MinGW native environment uses: msys2/setup-msys2@v2 + if: contains(matrix.msystem, 'MINGW') with: msystem: ${{ matrix.msystem }} update: false @@ -33,20 +34,34 @@ jobs: mingw-w64-${{ matrix.arch }}-gcc mingw-w64-${{ matrix.arch }}-gcc-fortran mingw-w64-${{ matrix.arch }}-python - mingw-w64-${{ matrix.arch }}-python-fypp + mingw-w64-${{ matrix.arch }}-python-pip + mingw-w64-${{ matrix.arch }}-python-setuptools mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja - unzip - zip - + - 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 - run: >- PATH=$PATH:/mingw64/bin/ cmake -Wdev - -B build - -DCMAKE_BUILD_TYPE=Debug - -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" - -DCMAKE_MAXIMUM_RANK:String=4 - -DCMAKE_INSTALL_PREFIX=$PWD/_dist + -B build + -DCMAKE_BUILD_TYPE=Debug + -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" + -DCMAKE_MAXIMUM_RANK:String=4 + -DCMAKE_INSTALL_PREFIX=$PWD/_dist env: FC: gfortran CC: gcc From b2ac7dead36447bb12316dfa67a7d4716dbf6a91 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 22:06:27 +0530 Subject: [PATCH 126/146] Indent correctly --- .github/workflows/ci_windows.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index e4ce407f1..f893f22f3 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -57,11 +57,11 @@ jobs: - run: >- PATH=$PATH:/mingw64/bin/ cmake -Wdev - -B build - -DCMAKE_BUILD_TYPE=Debug - -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" - -DCMAKE_MAXIMUM_RANK:String=4 - -DCMAKE_INSTALL_PREFIX=$PWD/_dist + -B build + -DCMAKE_BUILD_TYPE=Debug + -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" + -DCMAKE_MAXIMUM_RANK:String=4 + -DCMAKE_INSTALL_PREFIX=$PWD/_dist env: FC: gfortran CC: gcc From e91d25f89b43f8e8acd5e3c5f7a6bd3016cff5e5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 22:18:49 +0530 Subject: [PATCH 127/146] Try venv --- .github/workflows/ci_windows.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index f893f22f3..4801f112f 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -53,7 +53,10 @@ jobs: cmake ninja - name: Install fypp - run: pip install fypp + run: >- + python -v venv venv + source venv/bin/activate + pip install fypp - run: >- PATH=$PATH:/mingw64/bin/ cmake -Wdev From 7f599e33ac35c8281957f740927497ee55e40d84 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 22:23:29 +0530 Subject: [PATCH 128/146] Use -m --- .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 4801f112f..a85d92c73 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -54,7 +54,7 @@ jobs: ninja - name: Install fypp run: >- - python -v venv venv + python -m venv venv source venv/bin/activate pip install fypp - run: >- From cfcfe964247f0052b912237b865af1a7c8efeaa0 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 22:26:15 +0530 Subject: [PATCH 129/146] Use correct pipe symbol --- .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 a85d92c73..4e587699c 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -53,7 +53,7 @@ jobs: cmake ninja - name: Install fypp - run: >- + run: | python -m venv venv source venv/bin/activate pip install fypp From cb2bbf30c7bdfe18b0ae96b478ae4346da21747c Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 22:48:05 +0530 Subject: [PATCH 130/146] Source --- .github/workflows/ci_windows.yml | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index 4e587699c..204f7c375 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -57,13 +57,14 @@ jobs: python -m venv venv source venv/bin/activate pip install fypp - - run: >- - PATH=$PATH:/mingw64/bin/ cmake - -Wdev - -B build - -DCMAKE_BUILD_TYPE=Debug - -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" - -DCMAKE_MAXIMUM_RANK:String=4 + - run: | + source venv/bin/activate + PATH=$PATH:/mingw64/bin/ cmake \ + -Wdev \ + -B build \ + -DCMAKE_BUILD_TYPE=Debug \ + -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" \ + -DCMAKE_MAXIMUM_RANK:String=4 \ -DCMAKE_INSTALL_PREFIX=$PWD/_dist env: FC: gfortran From aeacc543ee6daed947557ee9cee6ad1a96b98ca1 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Wed, 21 Aug 2024 23:47:40 +0530 Subject: [PATCH 131/146] Do in one go --- .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 204f7c375..dd5762887 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -52,13 +52,10 @@ jobs: python-pip cmake ninja - - name: Install fypp - run: | + - run: | python -m venv venv source venv/bin/activate pip install fypp - - run: | - source venv/bin/activate PATH=$PATH:/mingw64/bin/ cmake \ -Wdev \ -B build \ From 4c39f57656cffb989f62714adadb87e92fd3aa6f Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 01:19:38 +0530 Subject: [PATCH 132/146] Align with current state of master --- .github/workflows/ci_windows.yml | 115 +++++++++++++------------------ 1 file changed, 48 insertions(+), 67 deletions(-) diff --git a/.github/workflows/ci_windows.yml b/.github/workflows/ci_windows.yml index dd5762887..66551fdd2 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -1,9 +1,9 @@ name: CI_windows -on: push +on: [push, pull_request] env: - CTEST_TIME_TIMEOUT: "5" # some failures hang forever + CTEST_TIME_TIMEOUT: "5" # some failures hang forever CMAKE_GENERATOR: Ninja jobs: @@ -12,77 +12,58 @@ jobs: strategy: fail-fast: false matrix: - include: - [ - { msystem: MSYS, arch: x86_64 }, - { msystem: MINGW64, arch: x86_64 }, - { msystem: MINGW32, arch: i686 }, - ] + include: [ + { msystem: MINGW64, arch: x86_64 }, + { msystem: MINGW32, arch: i686 } + ] defaults: run: shell: msys2 {0} steps: - - uses: actions/checkout@v2 - - name: Setup MinGW native environment - uses: msys2/setup-msys2@v2 - if: contains(matrix.msystem, 'MINGW') - with: - msystem: ${{ matrix.msystem }} - update: false - install: >- - git - 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 }}-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 - - run: | - python -m venv venv - source venv/bin/activate - pip install fypp - PATH=$PATH:/mingw64/bin/ cmake \ - -Wdev \ - -B build \ - -DCMAKE_BUILD_TYPE=Debug \ - -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" \ - -DCMAKE_MAXIMUM_RANK:String=4 \ - -DCMAKE_INSTALL_PREFIX=$PWD/_dist - env: - FC: gfortran - CC: gcc - CXX: g++ + - uses: actions/checkout@v2 - - name: CMake build - run: PATH=$PATH:/mingw64/bin/ cmake --build build --parallel + - name: Setup MinGW native environment + uses: msys2/setup-msys2@v2 + with: + msystem: ${{ matrix.msystem }} + update: false + install: >- + git + mingw-w64-${{ matrix.arch }}-gcc + mingw-w64-${{ matrix.arch }}-gcc-fortran + mingw-w64-${{ matrix.arch }}-python + mingw-w64-${{ matrix.arch }}-python-fypp + mingw-w64-${{ matrix.arch }}-cmake + mingw-w64-${{ matrix.arch }}-ninja - - name: catch build fail - run: PATH=$PATH:/mingw64/bin/ cmake --build build --verbose --parallel 1 - if: failure() + - run: >- + PATH=$PATH:/mingw64/bin/ cmake + -Wdev + -B build + -DCMAKE_BUILD_TYPE=Debug + -DCMAKE_Fortran_FLAGS_DEBUG="-Wall -Wextra -Wimplicit-interface -fPIC -g -fcheck=all -fbacktrace" + -DCMAKE_MAXIMUM_RANK:String=4 + -DCMAKE_INSTALL_PREFIX=$PWD/_dist + env: + FC: gfortran + CC: gcc + CXX: g++ - - name: CTest - run: PATH=$PATH:/mingw64/bin/ ctest --test-dir build --output-on-failure --parallel -V -LE quadruple_precision + - name: CMake build + run: PATH=$PATH:/mingw64/bin/ cmake --build build --parallel - - uses: actions/upload-artifact@v1 - if: failure() - with: - name: WindowsCMakeTestlog - path: build/Testing/Temporary/LastTest.log + - name: catch build fail + run: PATH=$PATH:/mingw64/bin/ cmake --build build --verbose --parallel 1 + if: failure() - - name: Install project - run: PATH=$PATH:/mingw64/bin/ cmake --install build + - name: CTest + run: PATH=$PATH:/mingw64/bin/ ctest --test-dir build --output-on-failure --parallel -V -LE quadruple_precision + + - uses: actions/upload-artifact@v1 + if: failure() + with: + name: WindowsCMakeTestlog + path: build/Testing/Temporary/LastTest.log + + - name: Install project + run: PATH=$PATH:/mingw64/bin/ cmake --install build From c873d1b96f0c9d7dfe063b70b25cc9a6046a64fd Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 15:21:24 +0530 Subject: [PATCH 133/146] Install unzip and zip dependencies --- .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 66551fdd2..fa938073d 100644 --- a/.github/workflows/ci_windows.yml +++ b/.github/workflows/ci_windows.yml @@ -35,6 +35,8 @@ jobs: mingw-w64-${{ matrix.arch }}-python-fypp mingw-w64-${{ matrix.arch }}-cmake mingw-w64-${{ matrix.arch }}-ninja + unzip + zip - run: >- PATH=$PATH:/mingw64/bin/ cmake From ca38bef0e0dec6c42768b86f2384f17902e5472a Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 15:33:59 +0530 Subject: [PATCH 134/146] Revert "Revert to macos-12" This reverts commit 557e65ef67f3b5bbe10663462a16a9e7a6371223. --- .github/workflows/CI.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 95624205f..61b7caa98 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -19,7 +19,7 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-latest, macos-12] + os: [ubuntu-latest, macos-13] toolchain: - { compiler: gcc, version: 10 } - { compiler: gcc, version: 11 } @@ -34,9 +34,9 @@ jobs: toolchain: - { compiler: gcc, version: 10 } exclude: - - os: macos-12 + - os: macos-13 toolchain: { compiler: intel, version: "2024.1" } - - os: macos-12 + - os: macos-13 toolchain: { compiler: gcc, version: 13 } env: BUILD_DIR: ${{ matrix.build == 'cmake' && 'build' || '.' }} From 239a67009695d30cebc5d961b0c7e90aa1eccbdc Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 15:34:04 +0530 Subject: [PATCH 135/146] Revert "Bump to macos and intel-classic version" This reverts commit cf1cfe1fbe73aaf0e19ebc1bf86ec100753b9670. --- .github/workflows/CI.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 61b7caa98..55512ffa8 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -19,14 +19,14 @@ jobs: strategy: fail-fast: false matrix: - os: [ubuntu-latest, macos-13] + os: [ubuntu-latest, macos-12] toolchain: - { compiler: gcc, version: 10 } - { compiler: gcc, version: 11 } - { compiler: gcc, version: 12 } - { compiler: gcc, version: 13 } - { compiler: intel, version: "2024.1" } - - { compiler: intel-classic, version: "2021.10" } + - { compiler: intel-classic, version: "2021.9" } build: [cmake] include: - os: ubuntu-latest @@ -34,9 +34,9 @@ jobs: toolchain: - { compiler: gcc, version: 10 } exclude: - - os: macos-13 + - os: macos-12 toolchain: { compiler: intel, version: "2024.1" } - - os: macos-13 + - os: macos-12 toolchain: { compiler: gcc, version: 13 } env: BUILD_DIR: ${{ matrix.build == 'cmake' && 'build' || '.' }} From dec06a4d168910e4cd375f6b6e3ebd06a216d360 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 15:34:12 +0530 Subject: [PATCH 136/146] Revert "Clean up CI, run all on push only" This reverts commit abcd256ae6815c08c456de055487a16fa43c71d9. --- .github/PULL_REQUEST_TEMPLATE.md | 4 ++ .github/workflows/CI.yml | 100 +++++++++++++-------------- .github/workflows/PR-review.yml | 17 +++++ .github/workflows/doc-deployment.yml | 66 ++++++++++++++++++ .github/workflows/fpm-deployment.yml | 13 ++-- 5 files changed, 144 insertions(+), 56 deletions(-) create mode 100644 .github/PULL_REQUEST_TEMPLATE.md create mode 100644 .github/workflows/PR-review.yml create mode 100644 .github/workflows/doc-deployment.yml diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 000000000..fc7101e17 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,4 @@ + diff --git a/.github/workflows/CI.yml b/.github/workflows/CI.yml index 55512ffa8..6988259d3 100644 --- a/.github/workflows/CI.yml +++ b/.github/workflows/CI.yml @@ -1,12 +1,12 @@ name: CI -on: push +on: [push, pull_request] env: CMAKE_BUILD_PARALLEL_LEVEL: "2" # 2 cores on each GHA VM, enable parallel builds CTEST_OUTPUT_ON_FAILURE: "ON" # This way we don't need a flag to ctest CTEST_PARALLEL_LEVEL: "2" - CTEST_TIME_TIMEOUT: "5" # some failures hang forever + CTEST_TIME_TIMEOUT: "5" # some failures hang forever HOMEBREW_NO_ANALYTICS: "ON" # Make Homebrew installation a little quicker HOMEBREW_NO_AUTO_UPDATE: "ON" HOMEBREW_NO_BOTTLE_SOURCE_FALLBACK: "ON" @@ -21,71 +21,71 @@ jobs: matrix: os: [ubuntu-latest, macos-12] toolchain: - - { compiler: gcc, version: 10 } - - { compiler: gcc, version: 11 } - - { compiler: gcc, version: 12 } - - { compiler: gcc, version: 13 } - - { compiler: intel, version: "2024.1" } - - { compiler: intel-classic, version: "2021.9" } + - {compiler: gcc, version: 10} + - {compiler: gcc, version: 11} + - {compiler: gcc, version: 12} + - {compiler: gcc, version: 13} + - {compiler: intel, version: '2024.1'} + - {compiler: intel-classic, version: '2021.9'} build: [cmake] include: - os: ubuntu-latest build: cmake-inline toolchain: - - { compiler: gcc, version: 10 } + - {compiler: gcc, version: 10} exclude: - os: macos-12 - toolchain: { compiler: intel, version: "2024.1" } + toolchain: {compiler: intel, version: '2024.1'} - os: macos-12 - toolchain: { compiler: gcc, version: 13 } + toolchain: {compiler: gcc, version: 13} env: BUILD_DIR: ${{ matrix.build == 'cmake' && 'build' || '.' }} steps: - - name: Checkout code - uses: actions/checkout@v4 + - name: Checkout code + uses: actions/checkout@v4 - - name: Set up Python 3.x - uses: actions/setup-python@v5 # Use pip to install latest CMake, & FORD/Jin2For, etc. - with: - python-version: 3.x + - name: Set up Python 3.x + uses: actions/setup-python@v5 # Use pip to install latest CMake, & FORD/Jin2For, etc. + with: + python-version: 3.x - - name: Install fypp - run: pip install --upgrade fypp ninja + - name: Install fypp + run: pip install --upgrade fypp ninja - - name: Setup Fortran compiler - uses: fortran-lang/setup-fortran@v1.6.1 - id: setup-fortran - with: - compiler: ${{ matrix.toolchain.compiler }} - version: ${{ matrix.toolchain.version }} + - name: Setup Fortran compiler + uses: fortran-lang/setup-fortran@v1.6.1 + id: setup-fortran + with: + compiler: ${{ matrix.toolchain.compiler }} + version: ${{ matrix.toolchain.version }} - - name: Configure with CMake - if: ${{ contains(matrix.build, 'cmake') }} - run: >- - cmake -Wdev -G Ninja - -DCMAKE_BUILD_TYPE=Release - -DCMAKE_MAXIMUM_RANK:String=4 - -DCMAKE_INSTALL_PREFIX=$PWD/_dist - -S . -B ${{ env.BUILD_DIR }} + - name: Configure with CMake + if: ${{ contains(matrix.build, 'cmake') }} + run: >- + cmake -Wdev -G Ninja + -DCMAKE_BUILD_TYPE=Release + -DCMAKE_MAXIMUM_RANK:String=4 + -DCMAKE_INSTALL_PREFIX=$PWD/_dist + -S . -B ${{ env.BUILD_DIR }} - - name: Build and compile - if: ${{ contains(matrix.build, 'cmake') }} - run: cmake --build ${{ env.BUILD_DIR }} --parallel + - name: Build and compile + if: ${{ contains(matrix.build, 'cmake') }} + run: cmake --build ${{ env.BUILD_DIR }} --parallel - - name: catch build fail - run: cmake --build ${{ env.BUILD_DIR }} --verbose --parallel 1 - if: ${{ failure() && contains(matrix.build, 'cmake') }} + - name: catch build fail + run: cmake --build ${{ env.BUILD_DIR }} --verbose --parallel 1 + if: ${{ failure() && contains(matrix.build, 'cmake') }} - - name: test - if: ${{ contains(matrix.build, 'cmake') }} - run: >- - ctest - --test-dir ${{ env.BUILD_DIR }} - --parallel - --output-on-failure - --no-tests=error + - name: test + if: ${{ contains(matrix.build, 'cmake') }} + run: >- + ctest + --test-dir ${{ env.BUILD_DIR }} + --parallel + --output-on-failure + --no-tests=error - - name: Install project - if: ${{ contains(matrix.build, 'cmake') }} - run: cmake --install ${{ env.BUILD_DIR }} + - name: Install project + if: ${{ contains(matrix.build, 'cmake') }} + run: cmake --install ${{ env.BUILD_DIR }} diff --git a/.github/workflows/PR-review.yml b/.github/workflows/PR-review.yml new file mode 100644 index 000000000..c16d0ee54 --- /dev/null +++ b/.github/workflows/PR-review.yml @@ -0,0 +1,17 @@ +name: PR-Review +on: [pull_request] +jobs: + misspell: + name: review-dog / misspell + runs-on: ubuntu-latest + steps: + - name: Check out code. + uses: actions/checkout@v2 + - name: misspell + uses: reviewdog/action-misspell@v1 + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + locale: "US" + reporter: github-pr-review + level: warning + ignore: colour diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml new file mode 100644 index 000000000..d48149407 --- /dev/null +++ b/.github/workflows/doc-deployment.yml @@ -0,0 +1,66 @@ +name: Build and Deploy Documents + +on: [push, pull_request] + +env: + LANG: "en_US.UTF-8" + LC_ALL: "en_US.UTF-8" + PIP_DISABLE_PIP_VERSION_CHECK: "ON" + PIP_NO_CLEAN: "ON" + PIP_PREFER_BINARY: "ON" + TZ: "UTC" + FORD_FILE: "API-doc-FORD-file.md" + +jobs: + Build-API-Docs: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v2 + - uses: actions/setup-python@v1 + with: + python-version: '3.x' + + - name: Install dependencies + run: | + pip install -v ford==7.0.5 + pip install fypp + python --version + ford --version + fypp --version + + - name: Skip graph and search unless deploying + if: github.ref != 'refs/heads/master' && ! startsWith( github.ref, 'refs/tags/' ) + run: | + sed -i 's/^[[:blank:]]*graph: *[Tt]rue/graph: false/' "${FORD_FILE}" + echo "MAYBE_SKIP_SEARCH=--no-search" >> $GITHUB_ENV + + - name: Build Docs + run: | + git fetch --all --tags + ford -r $(git describe --always) --debug ${MAYBE_SKIP_SEARCH} "${FORD_FILE}" + + - name: Upload Documentation + uses: actions/upload-artifact@v2 + with: + name: FORD-API-docs + path: ./API-doc/ + + - name: Broken Link Check + uses: technote-space/broken-link-checker-action@v1 + with: + TARGET: file://${{ github.workspace }}/API-doc/index.html + RECURSIVE: true + ASSIGNEES: ${{ github.actor }} + + - name: Deploy API Docs + uses: peaceiris/actions-gh-pages@v3 + if: github.event_name == 'push' && github.repository == 'fortran-lang/stdlib' && ( startsWith( github.ref, 'refs/tags/' ) || github.ref == 'refs/heads/master' ) + with: + deploy_key: ${{ secrets.ACTIONS_DEPLOY_KEY }} + cname: 'stdlib.fortran-lang.org' + external_repository: fortran-lang/stdlib-docs + publish_dir: ./API-doc + publish_branch: master + allow_empty_commit: true + force_orphan: false + commit_message: "From https://github.com/${{ github.repository }}/commit/${{ github.sha }} ${{ github.ref }}" diff --git a/.github/workflows/fpm-deployment.yml b/.github/workflows/fpm-deployment.yml index b55a37ba2..19cf58d8b 100644 --- a/.github/workflows/fpm-deployment.yml +++ b/.github/workflows/fpm-deployment.yml @@ -1,6 +1,6 @@ name: fpm-deployment -on: push +on: [push, pull_request] jobs: test: @@ -10,7 +10,7 @@ jobs: matrix: include: - os: ubuntu-latest - toolchain: { compiler: gcc, version: 13 } + toolchain: {compiler: gcc, version: 13} steps: - name: Checkout code @@ -33,18 +33,19 @@ jobs: - name: Setup Fortran Package Manager uses: fortran-lang/setup-fpm@v5 with: - fpm-version: "v0.10.0" + fpm-version: 'v0.10.0' - run: | # Just for deployment: create stdlib-fpm folder python config/fypp_deployment.py --deploy_stdlib_fpm - - run: | # Use fpm gnu ci to check xdp and qp + - run: | # Use fpm gnu ci to check xdp and qp python config/fypp_deployment.py --with_xdp --with_qp fpm test --profile release --flag '-DWITH_XDP -DWITH_QP' - # Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch. + # Update and deploy the f90 files generated by github-ci to the `stdlib-fpm` branch. - name: Deploy 🚀 uses: JamesIves/github-pages-deploy-action@4.1.5 + if: github.event_name != 'pull_request' with: BRANCH: stdlib-fpm - FOLDER: stdlib-fpm + FOLDER: stdlib-fpm \ No newline at end of file From 619b655587355eee6db12bc45210ba10cde784cf Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 15:47:02 +0530 Subject: [PATCH 137/146] Remove file that was added by accident --- example.npy | 0 1 file changed, 0 insertions(+), 0 deletions(-) delete mode 100644 example.npy diff --git a/example.npy b/example.npy deleted file mode 100644 index e69de29bb..000000000 From 78e7b9f53c3abd39905deed12feab7b817b33053 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 16:14:06 +0530 Subject: [PATCH 138/146] Actually use values in example instead of just printing them --- example/io/example_load_npz.f90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/example/io/example_load_npz.f90 b/example/io/example_load_npz.f90 index 66d3a01eb..7fe43b9e4 100644 --- a/example/io/example_load_npz.f90 +++ b/example/io/example_load_npz.f90 @@ -1,9 +1,12 @@ program example_load_npz use stdlib_array + use stdlib_kinds, only: int32, sp use stdlib_io_np, only: load_npz implicit none type(t_array_wrapper), allocatable :: arrays(:) + real(sp), allocatable :: array_1(:,:) + integer(int32), allocatable :: array_2(:,:) integer :: i call load_npz('example_load.npz', arrays) @@ -11,11 +14,14 @@ program example_load_npz do i = 1, size(arrays) select type (array => arrays(i)%array) class is (t_array_rsp_2) - print *, array%values + array_1 = array%values class is (t_array_iint32_2) - print *, array%values + array_2 = array%values class default - print *, 'Array ', i, ' is of unknown type.' + print *, 'Array ', i, ' is of unexpected type.' end select end do + + print *, array_1 + print *, array_2 end From d41ee29ba5837ac241126b1f0fc68e0c84dbad3e Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 17:32:03 +0530 Subject: [PATCH 139/146] Add get_values for better user experience --- src/stdlib_array.fypp | 28 ++++++++++++ test/io/test_np.f90 | 100 +++++++++++++++++++++++++++++++++++++++++- 2 files changed, 126 insertions(+), 2 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 936277d95..e44bb3c19 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -18,6 +18,13 @@ 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 :: get_values => get_values_${t1[0]}$${k1}$_${rank}$ + procedure :: get_values_${t1[0]}$${k1}$_${rank}$ +#:endfor +#:endfor end type type, abstract, public :: t_array @@ -53,6 +60,27 @@ module stdlib_array contains +#:for k1, t1 in KINDS_TYPES +#:for rank in RANKS + pure subroutine get_values_${t1[0]}$${k1}$_${rank}$(wrapper, values, stat, msg) + class(t_array_wrapper), intent(in) :: wrapper + ${t1}$, allocatable, intent(out) :: values${ranksuffix(rank)}$ + integer, intent(out), optional :: stat + character(len=:), allocatable, intent(out), optional :: msg + + if (present(stat)) stat = 0 + + select type (array_ => wrapper%array) + class is (t_array_${t1[0]}$${k1}$_${rank}$) + values = array_%values + class default + if (present(stat)) stat = 1 + if (present(msg)) msg = "Array is of unexpected type." + end select + end +#:endfor +#:endfor + #:for k1, t1 in KINDS_TYPES #:for rank in RANKS module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index fbee87a3f..5f285421d 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -57,7 +57,11 @@ subroutine collect_np(testsuite) new_unittest("add_array_duplicate_names", add_array_duplicate_names, should_fail=.true.), & new_unittest("npz_save_empty_array_input", npz_save_empty_array_input, should_fail=.true.), & new_unittest("npz_save_one_array", npz_save_one_array), & - new_unittest("npz_save_two_arrays", npz_save_two_arrays) & + new_unittest("npz_save_two_arrays", npz_save_two_arrays), & + new_unittest("npz_get_values_unallocated", npz_get_values_unallocated, should_fail=.true.), & + new_unittest("npz_get_values_correct_type", npz_get_values_correct_type), & + new_unittest("npz_get_values_wrong_type", npz_get_values_wrong_type, should_fail=.true.), & + new_unittest("npz_get_values_two_arrays", npz_get_values_two_arrays) & ] end subroutine collect_np @@ -1142,7 +1146,7 @@ subroutine npz_save_two_arrays(error) type(error_type), allocatable, intent(out) :: error type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) - integer :: stat, j + integer :: stat real(dp), allocatable :: input_array_1(:,:) complex(dp), parameter :: input_array_2(3) = [(1, 2._dp), (3, 4._dp), (5, 6._dp)] character(*), parameter :: array_name_1 = "array_1" @@ -1214,6 +1218,98 @@ subroutine npz_save_two_arrays(error) call delete_file(output_file) end + subroutine npz_get_values_unallocated(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + real(dp), allocatable :: input_array(:,:) + + allocate(arrays(1)) + call arrays(1)%get_values(input_array, stat) + call check(error, stat, "Getting values from an unallocated array should fail.") + end + + subroutine npz_get_values_correct_type(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + real(dp), allocatable :: input_array(:,:), output_array(:, :) + + allocate(input_array(10, 4)) + call random_number(input_array) + call add_array(arrays, input_array, stat) + call check(error, stat, "Error adding an array to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") + if (allocated(error)) return + call arrays(1)%get_values(output_array, stat) + call check(error, stat, "Error reading values from the array.") + if (allocated(error)) return + call check(error, size(output_array), size(input_array), "Array sizes do not match.") + if (allocated(error)) return + call check(error, any(abs(output_array - input_array) <= epsilon(1.0_dp)), & + "Precision loss when reading values from the array.") + end + + subroutine npz_get_values_wrong_type(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:) + integer :: stat + real(dp), allocatable :: input_array(:,:), output_array(:) + + allocate(input_array(10, 4)) + call random_number(input_array) + call add_array(arrays, input_array, stat) + call check(error, stat, "Error adding an array to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 1, "Array was not added to the list of arrays.") + if (allocated(error)) return + call arrays(1)%get_values(output_array, stat) + call check(error, stat, "Get values shouldn't work due to type mismatch.") + end + + subroutine npz_get_values_two_arrays(error) + type(error_type), allocatable, intent(out) :: error + + type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) + integer :: stat + real(dp), allocatable :: input_array_1(:,:), output_array_1(:,:) + complex(dp), parameter :: input_array_2(3) = [(1, 2._dp), (3, 4._dp), (5, 6._dp)] + complex(dp), allocatable :: output_array_2(:) + + allocate(input_array_1(5, 6)) + call random_number(input_array_1) + call add_array(arrays, input_array_1, stat) + call check(error, stat, "Error adding array 1 to the list of arrays.") + if (allocated(error)) return + + call add_array(arrays, input_array_2, stat) + call check(error, stat, "Error adding array 2 to the list of arrays.") + if (allocated(error)) return + call check(error, size(arrays) == 2, "Wrong array size.") + if (allocated(error)) return + + call arrays(1)%get_values(output_array_1, stat) + call check(error, stat, "Error reading values from the first array.") + if (allocated(error)) return + call check(error, size(input_array_1), size(output_array_1), "First array does not match in size.") + if (allocated(error)) return + call check(error, any(abs(output_array_1 - input_array_1) <= epsilon(1.0_dp)), & + "Precision loss when reading values from the first array.") + if (allocated(error)) return + + call arrays(2)%get_values(output_array_2, stat) + call check(error, stat, "Error reading values from the second array.") + if (allocated(error)) return + call check(error, size(input_array_2), size(output_array_2), "Second array does not match in size.") + if (allocated(error)) return + call check(error, any(abs(output_array_2 - input_array_2) <= epsilon(1.0_dp)), & + "Precision loss when reading values from the second array.") + end + subroutine delete_file(filename) character(len=*), intent(in) :: filename From 5d7789abde3c67c3bc7e2dbd7ae7324dc06784c7 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 18:54:02 +0530 Subject: [PATCH 140/146] Simplify example --- example/io/example_load_npz.f90 | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/example/io/example_load_npz.f90 b/example/io/example_load_npz.f90 index 7fe43b9e4..c554ad22e 100644 --- a/example/io/example_load_npz.f90 +++ b/example/io/example_load_npz.f90 @@ -1,5 +1,5 @@ program example_load_npz - use stdlib_array + use stdlib_array, only: t_array_wrapper use stdlib_kinds, only: int32, sp use stdlib_io_np, only: load_npz implicit none @@ -7,20 +7,11 @@ program example_load_npz type(t_array_wrapper), allocatable :: arrays(:) real(sp), allocatable :: array_1(:,:) integer(int32), allocatable :: array_2(:,:) - integer :: i call load_npz('example_load.npz', arrays) - do i = 1, size(arrays) - select type (array => arrays(i)%array) - class is (t_array_rsp_2) - array_1 = array%values - class is (t_array_iint32_2) - array_2 = array%values - class default - print *, 'Array ', i, ' is of unexpected type.' - end select - end do + call arrays(1)%get_values(array_1) + call arrays(2)%get_values(array_2) print *, array_1 print *, array_2 From a22f40198f3c252cf1ebe5a299bf920bb6fbdddd Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 20:20:04 +0530 Subject: [PATCH 141/146] Rename types and add some documentation --- example/io/example_load_npz.f90 | 4 +- example/io/example_save_npz.f90 | 4 +- src/stdlib_array.fypp | 58 +++++++++++++++++++------- src/stdlib_io_np.fypp | 6 +-- src/stdlib_io_np_load.fypp | 8 ++-- src/stdlib_io_np_save.fypp | 4 +- test/io/test_np.f90 | 74 ++++++++++++++++----------------- 7 files changed, 93 insertions(+), 65 deletions(-) diff --git a/example/io/example_load_npz.f90 b/example/io/example_load_npz.f90 index c554ad22e..edb6fe703 100644 --- a/example/io/example_load_npz.f90 +++ b/example/io/example_load_npz.f90 @@ -1,10 +1,10 @@ program example_load_npz - use stdlib_array, only: t_array_wrapper + use stdlib_array, only: array_wrapper_type use stdlib_kinds, only: int32, sp use stdlib_io_np, only: load_npz implicit none - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) real(sp), allocatable :: array_1(:,:) integer(int32), allocatable :: array_2(:,:) diff --git a/example/io/example_save_npz.f90 b/example/io/example_save_npz.f90 index d06334a2a..3271d9f2a 100644 --- a/example/io/example_save_npz.f90 +++ b/example/io/example_save_npz.f90 @@ -1,9 +1,9 @@ program example_save_npz - use stdlib_array, only: t_array_wrapper, add_array + use stdlib_array, only: array_wrapper_type, add_array use stdlib_io_np, only: save_npz implicit none - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) real :: x(3, 2) = 1 integer :: y(2, 3) = 2 diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index e44bb3c19..ad99032da 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -15,9 +15,13 @@ module stdlib_array public :: add_array, trueloc, falseloc - !> Helper class to allocate t_array as an abstract type. - type, public :: t_array_wrapper - class(t_array), allocatable :: array + !> Version: experimental + !> + !> Wrapper class that helps with allocation of array_type. + !> [Specification](../page/specs/stdlib_array.html#array_wrapper_type) + type, public :: array_wrapper_type + !> Polymorphic array. + class(array_type), allocatable :: array contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS @@ -27,24 +31,38 @@ module stdlib_array #:endfor end type - type, abstract, public :: t_array + !> Version: experimental + !> + !> Abstract class that is extended according to the type of the underlying array. + !> [Specification](../page/specs/stdlib_array.html#array_type) + type, abstract, public :: array_type + !> Name of the 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}$ + !> Version: experimental + !> + !> Array type for ${t1}$ arrays of rank ${rank}. + !> Extends array_type and contains the values of the array. + !> [Specification](../page/specs/stdlib_array.html#array_type_${t1[0]}$${k1}$_${rank}$) + type, extends(array_type), public :: array_type_${t1[0]}$${k1}$_${rank}$ ${t1}$, allocatable :: values${ranksuffix(rank)}$ end type #:endfor #:endfor + !> Version: experimental + !> + !> Add an array to an array of array wrappers. + !> [Specification](../page/specs/stdlib_array.html#add_array) interface add_array #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) + pure module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) !> Array of arrays to which the array is to be added. - type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) + type(array_wrapper_type), allocatable, intent(inout) :: arrays(:) !> Array to be added. ${t1}$, intent(in) :: array${ranksuffix(rank)}$ !> Status of addition. @@ -62,16 +80,24 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS + !> Version: experimental + !> + !> Extract array values from an array wrapper. + !> [Specification](../page/specs/stdlib_array.html#get_values) pure subroutine get_values_${t1[0]}$${k1}$_${rank}$(wrapper, values, stat, msg) - class(t_array_wrapper), intent(in) :: wrapper + !> Array wrapper to extract the values from. + class(array_wrapper_type), intent(in) :: wrapper + !> Extracted values. ${t1}$, allocatable, intent(out) :: values${ranksuffix(rank)}$ + !> Optional status of the extraction. integer, intent(out), optional :: stat + !> Optional error message. character(len=:), allocatable, intent(out), optional :: msg if (present(stat)) stat = 0 select type (array_ => wrapper%array) - class is (t_array_${t1[0]}$${k1}$_${rank}$) + class is (array_type_${t1[0]}$${k1}$_${rank}$) values = array_%values class default if (present(stat)) stat = 1 @@ -83,9 +109,12 @@ contains #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) - !> Array of arrays to which the array is to be added. - type(t_array_wrapper), allocatable, intent(inout) :: arrays(:) + !> Version: experimental + !> + !> Add an array to an array of array wrappers. + pure module subroutine add_array_${t1[0]}$${k1}$_${rank}$(arrays, array, stat, msg, name) + !> Array of wrapper arrays to which the array is to be added. + type(array_wrapper_type), allocatable, intent(inout) :: arrays(:) !> Array to be added. ${t1}$, intent(in) :: array${ranksuffix(rank)}$ !> Status of addition. @@ -96,9 +125,8 @@ contains character(len=*), intent(in), optional :: name integer :: i, arr_size - type(t_array_${t1[0]}$${k1}$_${rank}$) :: t_arr - type(t_array_wrapper), allocatable :: tmp_arrays(:) - + type(array_type_${t1[0]}$${k1}$_${rank}$) :: t_arr + type(array_wrapper_type), allocatable :: tmp_arrays(:) if (present(stat)) stat = 0 diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index 98574b9dd..ba1e90540 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_wrapper + use stdlib_array, only: array_wrapper_type implicit none private @@ -123,7 +123,7 @@ module stdlib_io_np interface load_npz module subroutine load_npz_to_arrays(filename, arrays, iostat, iomsg, tmp_dir) character(len=*), intent(in) :: filename - type(t_array_wrapper), allocatable, intent(out) :: arrays(:) + type(array_wrapper_type), allocatable, intent(out) :: arrays(:) integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg character(len=*), intent(in), optional :: tmp_dir @@ -137,7 +137,7 @@ module stdlib_io_np interface save_npz module subroutine save_arrays_to_npz(filename, arrays, iostat, iomsg, compressed) character(len=*), intent(in) :: filename - type(t_array_wrapper), intent(in) :: arrays(:) + type(array_wrapper_type), intent(in) :: arrays(:) integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg !> If true, the file is saved in compressed format. The default is false. diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 4f26b46bf..9eb8107af 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -107,7 +107,7 @@ contains !> ([Specification](../page/specs/stdlib_io.html#load_npz)) module subroutine load_npz_to_arrays(filename, arrays, iostat, iomsg, tmp_dir) character(len=*), intent(in) :: filename - type(t_array_wrapper), allocatable, intent(out) :: arrays(:) + type(array_wrapper_type), allocatable, intent(out) :: arrays(:) integer, intent(out), optional :: iostat character(len=:), allocatable, intent(out), optional :: iomsg character(*), intent(in), optional :: tmp_dir @@ -148,7 +148,7 @@ contains subroutine load_unzipped_files_to_arrays(files, dir, arrays, stat, msg) type(string_type), intent(in) :: files(:) character(len=*), intent(in) :: dir - type(t_array_wrapper), allocatable, intent(out) :: arrays(:) + type(array_wrapper_type), allocatable, intent(out) :: arrays(:) integer, intent(out) :: stat character(len=:), allocatable, intent(out) :: msg @@ -193,7 +193,7 @@ contains close(io, status='delete'); return end if - allocate(t_array_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) + allocate(array_type_${t1[0]}$${k1}$_${rank}$ :: arrays(i)%array, stat=stat) if (stat /= 0) then msg = "Failed to allocate array of type '"//this_type//"' "//& & 'with total size of '//to_string(product(vshape)) @@ -201,7 +201,7 @@ contains end if select type (typed_array => arrays(i)%array) - class is (t_array_${t1[0]}$${k1}$_${rank}$) + class is (array_type_${t1[0]}$${k1}$_${rank}$) allocate(typed_array%values, source=array) class default msg = 'Failed to allocate values.'; stat = 1 diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 76c16b622..cab966d6d 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -143,7 +143,7 @@ contains !> Name of the npz file to save to. character(len=*), intent(in) :: filename !> Arrays to be saved. - type(t_array_wrapper), intent(in) :: arrays(:) + type(array_wrapper_type), intent(in) :: arrays(:) !> Optional error status of saving, zero on success. integer, intent(out), optional :: iostat !> Optional error message. @@ -170,7 +170,7 @@ contains select type (typed_array => arrays(i)%array) #:for k1, t1 in KINDS_TYPES #:for rank in RANKS - class is (t_array_${t1[0]}$${k1}$_${rank}$) + class is (array_type_${t1[0]}$${k1}$_${rank}$) do j = 1, size(files) if (as_string(files(j)) == typed_array%name) then if (present(iostat)) iostat = 1 diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index 5f285421d..dd2af640b 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -671,7 +671,7 @@ subroutine npz_load_nonexistent_file(error) !> Error handling type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "nonexistent.npz" @@ -685,7 +685,7 @@ subroutine npz_load_invalid_dir(error) !> Error handling type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "." @@ -700,7 +700,7 @@ subroutine npz_load_empty_file(error) !> Error handling type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: io, stat character(*), parameter :: filename = "empty_file" @@ -719,7 +719,7 @@ subroutine npz_load_empty_zip(error) !> Error handling type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: io, stat character(*), parameter :: filename = "empty.zip" @@ -739,7 +739,7 @@ subroutine npz_load_empty_zip(error) subroutine npz_load_arr_empty_0(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "empty_0.npz" character(*), parameter :: tmp = temp_dir//"/empty_0" @@ -753,7 +753,7 @@ subroutine npz_load_arr_empty_0(error) call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_rdp_1) + class is (array_type_rdp_1) call check(error, size(typed_array%values) == 0, "Array in '"//filename//"' is supposed to be empty.") class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") @@ -763,7 +763,7 @@ subroutine npz_load_arr_empty_0(error) subroutine npz_load_arr_rand_2_3(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "rand_2_3.npz" character(*), parameter :: tmp = temp_dir//"/rand_2_3" @@ -777,7 +777,7 @@ subroutine npz_load_arr_rand_2_3(error) call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) + class is (array_type_rdp_2) call check(error, size(typed_array%values) == 6, "Array in '"//filename//"' is supposed to have 6 entries.") class default call test_failed(error, "Array in '"//filename//"' is of wrong type.") @@ -787,7 +787,7 @@ subroutine npz_load_arr_rand_2_3(error) subroutine npz_load_arr_arange_10_20(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat, i character(*), parameter :: filename = "arange_10_20.npz" character(*), parameter :: tmp = temp_dir//"/arange_10_20" @@ -801,7 +801,7 @@ subroutine npz_load_arr_arange_10_20(error) call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_iint64_1) + class is (array_type_iint64_1) call check(error, size(typed_array%values) == 10, "Array in '"//filename//"' is supposed to have 10 entries.") if (allocated(error)) return call check(error, typed_array%values(1) == 10, "First entry is supposed to be 10.") @@ -818,7 +818,7 @@ subroutine npz_load_arr_arange_10_20(error) subroutine npz_load_arr_cmplx(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "cmplx_arr.npz" character(*), parameter :: tmp = temp_dir//"/cmplx_arr" @@ -832,7 +832,7 @@ subroutine npz_load_arr_cmplx(error) call check(error, arrays(1)%array%name == "cmplx.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_csp_1) + class is (array_type_csp_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") if (allocated(error)) return call check(error, typed_array%values(1) == cmplx(1_dp, 2_dp), "First complex number does not match.") @@ -849,7 +849,7 @@ subroutine npz_load_arr_cmplx(error) subroutine npz_load_two_arr_iint64_rdp(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp.npz" character(*), parameter :: tmp = temp_dir//"/two_arr_iint64_rdp" @@ -865,7 +865,7 @@ subroutine npz_load_two_arr_iint64_rdp(error) call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_iint64_1) + class is (array_type_iint64_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") if (allocated(error)) return call check(error, typed_array%values(1) == 1, "First integer does not match.") @@ -878,7 +878,7 @@ subroutine npz_load_two_arr_iint64_rdp(error) call test_failed(error, "Array in '"//filename//"' is of wrong type.") end select select type (typed_array => arrays(2)%array) - class is (t_array_rdp_1) + class is (array_type_rdp_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") if (allocated(error)) return call check(error, typed_array%values(1) == 1., "First number does not match.") @@ -895,7 +895,7 @@ subroutine npz_load_two_arr_iint64_rdp(error) subroutine npz_load_two_arr_iint64_rdp_comp(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "two_arr_iint64_rdp_comp.npz" character(*), parameter :: tmp = temp_dir//"/two_arr_iint64_rdp_comp" @@ -911,7 +911,7 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_iint64_1) + class is (array_type_iint64_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") if (allocated(error)) return call check(error, typed_array%values(1) == 1, "First integer does not match.") @@ -924,7 +924,7 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) call test_failed(error, "Array in '"//filename//"' is of wrong type.") end select select type (typed_array => arrays(2)%array) - class is (t_array_rdp_1) + class is (array_type_rdp_1) call check(error, size(typed_array%values) == 3, "Array in '"//filename//"' is supposed to have 3 entries.") if (allocated(error)) return call check(error, typed_array%values(1) == 1., "First number does not match.") @@ -941,7 +941,7 @@ subroutine npz_load_two_arr_iint64_rdp_comp(error) subroutine add_array_to_empty(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: input_array(:,:) @@ -955,7 +955,7 @@ subroutine add_array_to_empty(error) call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) + class is (array_type_rdp_2) call check(error, size(typed_array%values), size(input_array), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - input_array) <= epsilon(1.0_dp)), & @@ -969,7 +969,7 @@ subroutine add_array_to_empty(error) subroutine add_two_arrays(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: array_1(:,:) real(sp), allocatable :: array_2(:) @@ -984,7 +984,7 @@ subroutine add_two_arrays(error) call check(error, arrays(1)%array%name == "arr_0.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) + class is (array_type_rdp_2) call check(error, size(typed_array%values), size(array_1), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - array_1) <= epsilon(1.0_dp)), & @@ -1004,7 +1004,7 @@ subroutine add_two_arrays(error) call check(error, arrays(2)%array%name == "arr_1.npy", "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(2)%array) - class is (t_array_rsp_1) + class is (array_type_rsp_1) call check(error, size(typed_array%values), size(array_2), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - array_2) <= epsilon(1.0_sp)), & @@ -1018,7 +1018,7 @@ subroutine add_two_arrays(error) subroutine add_array_custom_name(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: input_array(:,:) character(*), parameter :: arr_name = "custom_name.npy" @@ -1033,7 +1033,7 @@ subroutine add_array_custom_name(error) call check(error, arrays(1)%array%name == arr_name, "Wrong array name.") if (allocated(error)) return select type (typed_array => arrays(1)%array) - class is (t_array_rdp_2) + class is (array_type_rdp_2) call check(error, size(typed_array%values), size(input_array), "Array sizes do not match.") if (allocated(error)) return call check(error, any(abs(typed_array%values - input_array) <= epsilon(1.0_dp)), & @@ -1047,7 +1047,7 @@ subroutine add_array_custom_name(error) subroutine add_array_empty_name(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: input_array(:,:) character(*), parameter :: arr_name = " " @@ -1061,7 +1061,7 @@ subroutine add_array_empty_name(error) subroutine add_array_duplicate_names(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: array_1(:,:) real(sp), allocatable :: array_2(:) @@ -1081,7 +1081,7 @@ subroutine add_array_duplicate_names(error) subroutine npz_save_empty_array_input(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat character(*), parameter :: filename = "output.npz" @@ -1093,7 +1093,7 @@ subroutine npz_save_empty_array_input(error) subroutine npz_save_one_array(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) + type(array_wrapper_type), allocatable :: arrays(:), arrays_reloaded(:) integer :: stat real(dp), allocatable :: input_array(:,:) character(*), parameter :: output_file = "one_array.npz" @@ -1126,7 +1126,7 @@ subroutine npz_save_one_array(error) call delete_file(output_file); return end if select type (typed_array => arrays_reloaded(1)%array) - class is (t_array_rdp_2) + class is (array_type_rdp_2) call check(error, size(typed_array%values), size(input_array), "Array sizes do not match.") if (allocated(error)) then call delete_file(output_file); return @@ -1145,7 +1145,7 @@ subroutine npz_save_one_array(error) subroutine npz_save_two_arrays(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) + type(array_wrapper_type), allocatable :: arrays(:), arrays_reloaded(:) integer :: stat real(dp), allocatable :: input_array_1(:,:) complex(dp), parameter :: input_array_2(3) = [(1, 2._dp), (3, 4._dp), (5, 6._dp)] @@ -1187,7 +1187,7 @@ subroutine npz_save_two_arrays(error) end if select type (typed_array => arrays_reloaded(1)%array) - class is (t_array_rdp_2) + class is (array_type_rdp_2) call check(error, size(typed_array%values), size(input_array_1), "First array does not match in size.") if (allocated(error)) then call delete_file(output_file); return @@ -1202,7 +1202,7 @@ subroutine npz_save_two_arrays(error) end select select type (typed_array => arrays_reloaded(2)%array) - class is (t_array_cdp_1) + class is (array_type_cdp_1) call check(error, size(typed_array%values), size(input_array_2), "Second array does not match in size.") if (allocated(error)) then call delete_file(output_file); return @@ -1221,7 +1221,7 @@ subroutine npz_save_two_arrays(error) subroutine npz_get_values_unallocated(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: input_array(:,:) @@ -1233,7 +1233,7 @@ subroutine npz_get_values_unallocated(error) subroutine npz_get_values_correct_type(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: input_array(:,:), output_array(:, :) @@ -1256,7 +1256,7 @@ subroutine npz_get_values_correct_type(error) subroutine npz_get_values_wrong_type(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:) + type(array_wrapper_type), allocatable :: arrays(:) integer :: stat real(dp), allocatable :: input_array(:,:), output_array(:) @@ -1274,7 +1274,7 @@ subroutine npz_get_values_wrong_type(error) subroutine npz_get_values_two_arrays(error) type(error_type), allocatable, intent(out) :: error - type(t_array_wrapper), allocatable :: arrays(:), arrays_reloaded(:) + type(array_wrapper_type), allocatable :: arrays(:), arrays_reloaded(:) integer :: stat real(dp), allocatable :: input_array_1(:,:), output_array_1(:,:) complex(dp), parameter :: input_array_2(3) = [(1, 2._dp), (3, 4._dp), (5, 6._dp)] From 92aca11cd773a1cffce1e7f4a27dfdef5e51f52c Mon Sep 17 00:00:00 2001 From: minhqdao Date: Thu, 22 Aug 2024 22:56:34 +0530 Subject: [PATCH 142/146] Add some docs --- src/stdlib_array.fypp | 2 +- src/stdlib_filesystem.f90 | 19 +++++++++++++++++++ src/stdlib_io_np.fypp | 2 +- src/stdlib_io_np_load.fypp | 9 ++++++--- src/stdlib_io_np_save.fypp | 3 --- src/stdlib_io_zip.f90 | 18 ++++++++++++++++++ 6 files changed, 45 insertions(+), 8 deletions(-) diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index ad99032da..8690107a2 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -4,7 +4,7 @@ #: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 +!> Module for general array handling and index manipulation. !> !> The specification of this module is available [here](../page/specs/stdlib_array.html). module stdlib_array diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_filesystem.f90 index 6d5f0ef1e..f498bec53 100644 --- a/src/stdlib_filesystem.f90 +++ b/src/stdlib_filesystem.f90 @@ -1,3 +1,6 @@ +! SPDX-Identifier: MIT + +!> Interaction with the filesystem. module stdlib_filesystem use stdlib_string_type, only: string_type implicit none @@ -10,7 +13,11 @@ module stdlib_filesystem contains + !> Version: experimental + !> + !> Whether a file or directory exists at the given path. logical function exists(filename) + !> Name of the file or directory. character(len=*), intent(in) :: filename inquire(file=filename, exist=exists) @@ -20,11 +27,17 @@ logical function exists(filename) #endif end + !> Version: experimental + !> !> List files and directories of a directory. Does not list hidden files. subroutine list_dir(dir, files, stat, msg) + !> Directory to list. character(len=*), intent(in) :: dir + !> List of files and directories. type(string_type), allocatable, intent(out) :: files(:) + !> Status of listing. integer, intent(out) :: stat + !> Error message. character(len=:), allocatable, optional, intent(out) :: msg integer :: unit, iostat @@ -60,9 +73,15 @@ subroutine list_dir(dir, files, stat, msg) close(unit, status="delete") end + !> Version: experimental + !> + !> Run a command in the shell. subroutine run(command, stat, msg) + !> Command to run. character(len=*), intent(in) :: command + !> Status of the operation. integer, intent(out), optional :: stat + !> Error message. character(len=:), allocatable, intent(out), optional :: msg integer :: exitstat, cmdstat diff --git a/src/stdlib_io_np.fypp b/src/stdlib_io_np.fypp index ba1e90540..65d1a3f66 100644 --- a/src/stdlib_io_np.fypp +++ b/src/stdlib_io_np.fypp @@ -4,7 +4,7 @@ #:set RANKS = range(1, MAXRANK + 1) #:set KINDS_TYPES = REAL_KINDS_TYPES + INT_KINDS_TYPES + CMPLX_KINDS_TYPES -!> Description of the npy format taken from +!> Description of the npy and npz formats taken from !> https://numpy.org/doc/stable/reference/generated/numpy.lib.format.html !> !>## Format Version 1.0 diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 9eb8107af..3e7e2ab73 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -101,10 +101,7 @@ contains #: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, tmp_dir) character(len=*), intent(in) :: filename type(array_wrapper_type), allocatable, intent(out) :: arrays(:) @@ -145,11 +142,17 @@ contains end if end + !> Load arrays from unzipped files. subroutine load_unzipped_files_to_arrays(files, dir, arrays, stat, msg) + !> List of files to load arrays from. type(string_type), intent(in) :: files(:) + !> Directory containing the files. character(len=*), intent(in) :: dir + !> Array of array wrappers to store the loaded arrays. type(array_wrapper_type), allocatable, intent(out) :: arrays(:) + !> Status of the operation. Zero on success. integer, intent(out) :: stat + !> Error message in case of non-zero status. character(len=:), allocatable, intent(out) :: msg integer :: i, io diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index cab966d6d..586803097 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -135,10 +135,7 @@ contains #: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_arrays_to_npz(filename, arrays, iostat, iomsg, compressed) !> Name of the npz file to save to. character(len=*), intent(in) :: filename diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index 17287b7d0..e6c6b2430 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -1,3 +1,6 @@ +! SPDX-Identifier: MIT + +!> Handling of zip files including creation and extraction. module stdlib_io_zip use stdlib_filesystem, only: exists, run, temp_dir use stdlib_string_type, only: string_type, char @@ -12,11 +15,19 @@ module stdlib_io_zip contains + !> Version: experimental + !> + !> Create a zip file from a list of files. subroutine zip(output_file, files, stat, msg, compressed) + !> Name of the zip file to create. character(*), intent(in) :: output_file + !> List of files to include in the zip file. type(string_type), intent(in) :: files(:) + !> Optional error status of zipping, zero on success. integer, intent(out), optional :: stat + !> Optional error message. character(len=:), allocatable, intent(out), optional :: msg + !> If true, the file is saved in compressed format. The default is true. logical, intent(in), optional :: compressed integer :: run_stat, i @@ -54,10 +65,17 @@ subroutine zip(output_file, files, stat, msg, compressed) end if end + !> Version: experimental + !> + !> Extract a zip file to a directory. subroutine unzip(filename, outputdir, stat, msg) + !> Name of the zip file to extract. character(len=*), intent(in) :: filename + !> Directory to extract the zip file to. character(len=*), intent(in), optional :: outputdir + !> Optional error status of unzipping, zero on success. integer, intent(out), optional :: stat + !> Optional error message. character(len=:), allocatable, intent(out), optional :: msg integer :: run_stat From 99bbef0770546c1c20001aad1896594eb7af2e9b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 23 Aug 2024 01:32:22 +0530 Subject: [PATCH 143/146] Change stdlib_filesystem to stdlib_io_filesystem --- src/CMakeLists.txt | 4 ++-- src/{stdlib_filesystem.f90 => stdlib_io_filesystem.f90} | 2 +- src/stdlib_io_np_load.fypp | 2 +- src/stdlib_io_np_save.fypp | 4 ++-- src/stdlib_io_zip.f90 | 2 +- test/io/test_filesystem.f90 | 4 ++-- test/io/test_np.f90 | 4 ++-- test/io/test_zip.f90 | 2 +- 8 files changed, 12 insertions(+), 12 deletions(-) rename src/{stdlib_filesystem.f90 => stdlib_io_filesystem.f90} (99%) diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 99c59a5f3..d8c4c215f 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -105,11 +105,11 @@ set(SRC stdlib_ansi_to_string.f90 stdlib_codata.f90 stdlib_error.f90 - stdlib_filesystem.f90 stdlib_hashmap_wrappers.f90 stdlib_hashmaps.f90 stdlib_hashmap_chaining.f90 stdlib_hashmap_open.f90 + stdlib_io_filesystem.f90 stdlib_io_zip.f90 stdlib_logger.f90 stdlib_sorting_radix_sort.f90 @@ -124,7 +124,7 @@ set(SRC # Files that have cpp directives need to be compiled with the preprocessor. set(hasCPP - stdlib_filesystem.f90 + stdlib_io_filesystem.f90 ) if(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU") diff --git a/src/stdlib_filesystem.f90 b/src/stdlib_io_filesystem.f90 similarity index 99% rename from src/stdlib_filesystem.f90 rename to src/stdlib_io_filesystem.f90 index f498bec53..e7795d7f6 100644 --- a/src/stdlib_filesystem.f90 +++ b/src/stdlib_io_filesystem.f90 @@ -1,7 +1,7 @@ ! SPDX-Identifier: MIT !> Interaction with the filesystem. -module stdlib_filesystem +module stdlib_io_filesystem use stdlib_string_type, only: string_type implicit none private diff --git a/src/stdlib_io_np_load.fypp b/src/stdlib_io_np_load.fypp index 3e7e2ab73..9a77e5e9a 100644 --- a/src/stdlib_io_np_load.fypp +++ b/src/stdlib_io_np_load.fypp @@ -8,7 +8,7 @@ submodule(stdlib_io_np) stdlib_io_np_load use stdlib_array use stdlib_error, only: error_stop - use stdlib_filesystem, only: exists, list_dir, temp_dir + use stdlib_io_filesystem, only: exists, list_dir, temp_dir use stdlib_io_zip, only: unzip, default_unzip_dir, zip_contents, zip use stdlib_strings, only: to_string, starts_with use stdlib_string_type, only: string_type, as_string => char diff --git a/src/stdlib_io_np_save.fypp b/src/stdlib_io_np_save.fypp index 586803097..1b81b588f 100644 --- a/src/stdlib_io_np_save.fypp +++ b/src/stdlib_io_np_save.fypp @@ -8,10 +8,10 @@ submodule(stdlib_io_np) stdlib_io_np_save use stdlib_array use stdlib_error, only: error_stop - use stdlib_filesystem, only: run + use stdlib_io_filesystem, only: run + use stdlib_io_zip, only: zip use stdlib_strings, only: to_string use stdlib_string_type, only: string_type, as_string => char - use stdlib_io_zip, only: zip implicit none contains diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index e6c6b2430..c6df96a78 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -2,7 +2,7 @@ !> Handling of zip files including creation and extraction. module stdlib_io_zip - use stdlib_filesystem, only: exists, run, temp_dir + use stdlib_io_filesystem, only: exists, run, temp_dir use stdlib_string_type, only: string_type, char use stdlib_strings, only: starts_with implicit none diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 6ef6f2512..73bb17263 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -1,7 +1,7 @@ module test_filesystem - use stdlib_filesystem - use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed + use stdlib_io_filesystem use stdlib_string_type, only : char, string_type + use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private diff --git a/test/io/test_np.f90 b/test/io/test_np.f90 index dd2af640b..a5ffb6c38 100644 --- a/test/io/test_np.f90 +++ b/test/io/test_np.f90 @@ -1,8 +1,8 @@ module test_np use stdlib_array - use stdlib_filesystem, only : temp_dir, exists - use stdlib_kinds, only : int8, int16, int32, int64, sp, dp + use stdlib_io_filesystem, only : temp_dir, exists use stdlib_io_np, only : save_npy, load_npy, load_npz, save_npz + use stdlib_kinds, only : int8, int16, int32, int64, sp, dp use testdrive, only : new_unittest, unittest_type, error_type, check, test_failed implicit none private diff --git a/test/io/test_zip.f90 b/test/io/test_zip.f90 index 6ab246a43..8227218b7 100644 --- a/test/io/test_zip.f90 +++ b/test/io/test_zip.f90 @@ -1,5 +1,5 @@ module test_zip - use stdlib_filesystem, only: exists + use stdlib_io_filesystem, only: exists use stdlib_io_zip use stdlib_string_type, only: string_type, char use testdrive, only: new_unittest, unittest_type, error_type, check, test_failed From 6aa19aa728e3959551bec96f89af8645caa11c1b Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 23 Aug 2024 16:21:21 +0530 Subject: [PATCH 144/146] Add documentation for stdlib_array --- doc/specs/stdlib_array.md | 122 +++++++++++++++++++++++++++++++++++++- src/stdlib_array.fypp | 11 ++-- 2 files changed, 125 insertions(+), 8 deletions(-) diff --git a/doc/specs/stdlib_array.md b/doc/specs/stdlib_array.md index e10a95aff..7dfbb12cc 100644 --- a/doc/specs/stdlib_array.md +++ b/doc/specs/stdlib_array.md @@ -10,8 +10,58 @@ title: array Module for index manipulation and array handling tasks. -## Procedures and methods provided +## Derived types provided + +### `array_wrapper_type` + +A derived type that wraps a polymorphic `array_type` and helps with its allocation. By loading an npz file with `load_npz`, a list of array wrappers will be obtained. On the other hand, a list of array wrappers can be saved to an npz file using `save_npz`. Use `add_array` to add an array to a list of array wrappers and call `get_values` on the array wrapper to obtain the values of the underlying array. + +#### Status + +Experimental + +#### Example + +```fortran +program npz_example + use stdlib_array, only: array_wrapper_type, add_array + use stdlib_io_np, only: save_npz, load_npz + implicit none + + type(array_wrapper_type), allocatable :: input_arrays(:), output_arrays(:) + real :: x(3, 2) = 1 + integer :: y(2, 3) = 2 + real, allocatable :: x_out(:,:) + integer, allocatable :: y_out(:,:) + + call add_array(input_arrays, x) + call add_array(input_arrays, y) + + call save_npz('example_save.npz', input_arrays) + + call load_npz('example_save.npz', output_arrays) + + if (size(input_arrays) /= 2) then + print *, 'Error: Output array has unexpected size.'; stop + end if + + call output_arrays(1)%get_values(x_out) + call output_arrays(2)%get_values(y_out) + + print *, x_out + print *, y_out +end +``` + +### `array_type` +An abstract type that can be extended according to the type and rank of the stored array. It is usually not necessary to interact with this type directly. It is used to store multiple arrays of different types and ranks in a single array. + +#### Status + +Experimental + +## Procedures and methods provided ### `trueloc` @@ -49,7 +99,6 @@ Returns an array of default integer size, with a maximum length of `size(array)` {!example/array/example_trueloc.f90!} ``` - ### `falseloc` #### Status @@ -85,3 +134,72 @@ Returns an array of default integer size, with a maximum length of `size(array)` ```fortran {!example/array/example_falseloc.f90!} ``` + +### `add_array` + +#### Status + +Experimental + +#### Description + +Add an array of defined type and rank to a list of array wrappers. + +#### Syntax + +`call ` [[stdlib_array(module):add_array(interface)]] ` (arrays, array[, stat, msg, name])` + +#### Class + +Pure subroutine. + +#### Arguments + +`arrays`: List of array wrappers of type `array_wrapper_type` to add `array` to. This argument is `intent(inout)`. + +`array`: Array with defined type and rank to be added to the list of array wrappers. This argument is `intent(in)`. + +`stat`: Status variable of type `integer`. This argument is `optional` and `intent(out)`. The operation is successful if `stat` is `0`. + +`msg`: Error message. This argument is `optional` and `intent(out)`. + +`name`: Name of the array. This argument is `optional` and `intent(in)`. If not provided, the name will be set to the default value. + +#### Examples + +```fortran +{!example/io/example_save_npz.f90!} +``` +### `get_values` + +#### Status + +Experimental + +#### Description + +Get the values of the array within the array wrapper. + +#### Syntax + +`call ` [[stdlib_array(module):array_wrapper_type(type)]] `%` [[array_wrapper_type(type):get_values(bound)]] ` (wrapper, values[, stat, msg])` + +#### Class + +Pure subroutine. + +#### Arguments + +`wrapper`: Array wrapper of type `array_wrapper_type` to get the values from. This argument is `intent(in)`. + +`values`: Array of the same type and rank as the array within the array wrapper. This argument is `intent(out)`. + +`stat`: Status variable of type `integer`. This argument is `optional` and `intent(out)`. The operation is successful if `stat` is `0`. + +`msg`: Error message. This argument is `optional` and `intent(out)`. + +#### Examples + +```fortran +{!example/io/example_load_npz.f90!} +``` diff --git a/src/stdlib_array.fypp b/src/stdlib_array.fypp index 8690107a2..af0312a17 100644 --- a/src/stdlib_array.fypp +++ b/src/stdlib_array.fypp @@ -17,7 +17,7 @@ module stdlib_array !> Version: experimental !> - !> Wrapper class that helps with allocation of array_type. + !> Wrapper class that helps with the allocation of `array_type`. !> [Specification](../page/specs/stdlib_array.html#array_wrapper_type) type, public :: array_wrapper_type !> Polymorphic array. @@ -33,7 +33,7 @@ module stdlib_array !> Version: experimental !> - !> Abstract class that is extended according to the type of the underlying array. + !> Abstract type that is extended according to the type and rank of the stored array. !> [Specification](../page/specs/stdlib_array.html#array_type) type, abstract, public :: array_type !> Name of the array. @@ -44,9 +44,8 @@ module stdlib_array #:for rank in RANKS !> Version: experimental !> - !> Array type for ${t1}$ arrays of rank ${rank}. - !> Extends array_type and contains the values of the array. - !> [Specification](../page/specs/stdlib_array.html#array_type_${t1[0]}$${k1}$_${rank}$) + !> Array type for ${t1}$ arrays of ${k1} precision and rank ${rank}. + !> Extends `array_type` and contains the values of the array. type, extends(array_type), public :: array_type_${t1[0]}$${k1}$_${rank}$ ${t1}$, allocatable :: values${ranksuffix(rank)}$ end type @@ -55,7 +54,7 @@ module stdlib_array !> Version: experimental !> - !> Add an array to an array of array wrappers. + !> Add an array of defined type and rank to an array of array wrappers. !> [Specification](../page/specs/stdlib_array.html#add_array) interface add_array #:for k1, t1 in KINDS_TYPES From 7b7675696c08f480cc58b396d3eeb51929c31f24 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 23 Aug 2024 19:10:56 +0530 Subject: [PATCH 145/146] Add documentation --- doc/specs/stdlib_array.md | 5 +- doc/specs/stdlib_io.md | 185 ++++++++++++++++++++++++++++++++++- src/stdlib_io_filesystem.f90 | 45 +++++---- src/stdlib_io_zip.f90 | 2 + 4 files changed, 212 insertions(+), 25 deletions(-) diff --git a/doc/specs/stdlib_array.md b/doc/specs/stdlib_array.md index 7dfbb12cc..3880786bc 100644 --- a/doc/specs/stdlib_array.md +++ b/doc/specs/stdlib_array.md @@ -147,7 +147,7 @@ Add an array of defined type and rank to a list of array wrappers. #### Syntax -`call ` [[stdlib_array(module):add_array(interface)]] ` (arrays, array[, stat, msg, name])` +`call ` [[stdlib_array(module):add_array(interface)]] `(arrays, array[, stat, msg, name])` #### Class @@ -170,6 +170,7 @@ Pure subroutine. ```fortran {!example/io/example_save_npz.f90!} ``` + ### `get_values` #### Status @@ -182,7 +183,7 @@ Get the values of the array within the array wrapper. #### Syntax -`call ` [[stdlib_array(module):array_wrapper_type(type)]] `%` [[array_wrapper_type(type):get_values(bound)]] ` (wrapper, values[, stat, msg])` +`call ` [[stdlib_array(module):array_wrapper_type(type)]] `%` [[array_wrapper_type(type):get_values(bound)]] `(wrapper, values[, stat, msg])` #### Class diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 8c868802a..0c389a136 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -136,11 +136,11 @@ Loads an `array` from a npy formatted binary file. ### Syntax -`call ` [[stdlib_io_npy(module):load_npy(interface)]] `(filename, array[, iostat][, iomsg])` +`call ` [[stdlib_io_np(module):load_npy(interface)]] `(filename, array[, iostat][, iomsg])` ### Arguments -`filename`: Shall be a character expression containing the file name from which to load the `array`. +`filename`: Shall be a character expression containing the file name from which to load the `array`. This argument is `intent(in)`. `array`: Shall be an allocatable array of any rank of type `real`, `complex` or `integer`. @@ -164,7 +164,6 @@ Returns an allocated `array` with the content of `filename` in case of success. {!example/io/example_loadnpy.f90!} ``` - ## `save_npy` ### Status @@ -177,7 +176,7 @@ Saves an `array` into a npy formatted binary file. ### Syntax -`call ` [[stdlib_io_npy(module):save_npy(interface)]] `(filename, array[, iostat][, iomsg])` +`call ` [[stdlib_io_np(module):save_npy(interface)]] `(filename, array[, iostat][, iomsg])` ### Arguments @@ -205,6 +204,70 @@ Provides a npy file called `filename` that contains the rank-2 `array`. {!example/io/example_savenpy.f90!} ``` +## `load_npz` + +### Status + +Experimental + +### Description + +Populates an array of `array_wrapper_type` with the contents of an npz file. + +### Syntax + +`call ` [[stdlib_io_np(module):load_npz(interface)]] `(filename, arrays[, iostat][, iomsg][, tmp_dir])` + +### Arguments + +`filename`: Shall be a character expression containing the name of the npz file to load from. The argument is `intent(in)`. + +`arrays`: Shall be an allocatable array of type `array_wrapper_type` to load the content of the npz file to. This argument is `intent(out)`. + +`iostat`: Default integer, contains status of loading to file, zero in case of success. This argument is `optional` and `intent(out)`. + +`iomsg`: Deferred length character value, contains error message in case `iostat` is non-zero. It is an optional argument, error message will be dropped if not present. This argument is `intent(out)`. + +`tmp_dir`: Shall be a character expression containing the name of the temporary directory to extract the npz file to. The argument is `optional` and `intent(in)`. + +### Example + +```fortran +{!example/io/example_load_npz.f90!} +``` + +## `save_npz` + +### Status + +Experimental + +### Description + +Saves an array of `array_wrapper_type` into a npz file. + +### Syntax + +`call ` [[stdlib_io_np(module):save_npz(interface)]] `(filename, arrays[, iostat][, iomsg][, compressed])` + +### Arguments + +`filename`: Shall be a character expression containing the name of the file that contains the arrays. This argument is `intent(in)`. + +`arrays`: Shall be arrays of type `array_wrapper_type` that are meant to be saved to disk. This argument is `intent(in)`. + +`iostat`: Default integer, contains status of saving to file, zero in case of success. This argument is `optional` and `intent(out)`. + +`iomsg`: Deferred length character value, contains error message in case `iostat` is non-zero. It is an optional argument, error message will be dropped if not present. This argument is `intent(out)`. + +`compressed`: Shall be a logical expression that determines if the npz file should be compressed. The argument is `optional` and `intent(in)`. The default value is `.false.`. + +### Example + +```fortran +{!example/io/example_save_npz.f90!} +``` + ## `getline` ### Status @@ -260,3 +323,117 @@ Provides formats for all kinds as defined in the `stdlib_kinds` module. ```fortran {!example/io/example_fmt_constants.f90!} ``` + +## `zip` + +### Status + +Experimental + +### Description + +Compresses a file or directory into a zip archive. + +### Syntax + +`call ` [[stdlib_io_zip(module):zip(subroutine)]] ` (output_file, files[, stat][, msg][, compressed])` + +### Arguments + +`output_file`: Character expression representing the name of the zip file to create. This argument is `intent(in)`. + +`files`: Array of `string_type` representing the names of the files to compress. This argument is `intent(in)`. + +`stat`: Default integer, contains status of reading from unit, zero in case of success. This argument is `optional` and `intent(out)`. + +`msg`: Deferred length character value, contains error message in case `iostat` is non-zero. It is an `optional` argument, error message will be dropped if not present. This argument is `intent(out)`. + +`compressed`: Logical expression that determines if the zip file should be compressed. The argument is `optional` and `intent(in)`. The default value is `.true.`. + +## `unzip` + +### Status + +Experimental + +### Description + +Extracts a zip archive into a directory. + +### Syntax + +`call ` [[stdlib_io_zip(module):unzip(subroutine)]] ` (filename, outputdir[, stat][, msg])` + +### Arguments + +`filename`: Character expression representing the name of the zip file to extract. This argument is `intent(in)`. + +`outputdir`: Character expression representing the name of the directory to extract the zip file to. This argument is `intent(in)`. + +`stat`: Default integer, contains status of reading from unit, zero in case of success. This argument is `optional` and `intent(out)`. + +`msg`: Deferred length character value, contains error message in case `iostat` is non-zero. It is an `optional` argument, error message will be dropped if not present. This argument is `intent(out)`. + +## `exists` + +### Status + +Experimental + +### Description + +Whether a file or directory exists at the given location in the filesystem. + +### Syntax + +`is_existing = ` [[stdlib_io_filesystem(module):exists(function)]] ` (filename)` + +### Arguments + +`filename`: Character expression representing the name of the file or directory to check for existence. This argument is `intent(in)`. + +## `list_dir` + +### Status + +Experimental + +### Description + +Lists the contents of a directory. + +### Syntax + +`call ` [[stdlib_io_filesystem(module):list_dir(subroutine)]] ` (dir, files[, iostat][, iomsg])` + +### Arguments + +`dir`: Character expression representing the name of the directory to list. This argument is `intent(in)`. + +`files`: Array of `string_type` representing the names of the files in the directory. This argument is `intent(out)`. + +`iostat`: Default integer, contains status of reading from unit, zero in case of success. This argument is `optional` and `intent(out)`. + +`iomsg`: Deferred length character value, contains error message in case `iostat` is non-zero. It is an `optional` argument, error message will be dropped if not present. This argument is `intent(out)`. + +## `run` + +### Status + +Experimental + +### Description + +Runs a command in the shell. + +### Syntax + +`call ` [[stdlib_io_filesystem(module):run(subroutine)]] ` (command[, iostat][, iomsg])` + +### Arguments + +`command`: Character expression representing the command to run. This argument is `intent(in)`. + +`iostat`: Default integer, contains status of reading from unit, zero in case of success. This argument is `optional` and `intent(out)`. + +`iomsg`: Deferred length character value, contains error message in case `iostat` is non-zero. It is an `optional` argument, error message will be dropped if not present. This argument is `intent(out)`. diff --git a/src/stdlib_io_filesystem.f90 b/src/stdlib_io_filesystem.f90 index e7795d7f6..426b36d45 100644 --- a/src/stdlib_io_filesystem.f90 +++ b/src/stdlib_io_filesystem.f90 @@ -16,6 +16,7 @@ module stdlib_io_filesystem !> Version: experimental !> !> Whether a file or directory exists at the given path. + !> [Specification](../page/specs/stdlib_io.html#exists) logical function exists(filename) !> Name of the file or directory. character(len=*), intent(in) :: filename @@ -30,17 +31,18 @@ logical function exists(filename) !> Version: experimental !> !> List files and directories of a directory. Does not list hidden files. - subroutine list_dir(dir, files, stat, msg) + !> [Specification](../page/specs/stdlib_io.html#list_dir) + subroutine list_dir(dir, files, iostat, iomsg) !> Directory to list. character(len=*), intent(in) :: dir !> List of files and directories. type(string_type), allocatable, intent(out) :: files(:) !> Status of listing. - integer, intent(out) :: stat + integer, optional, intent(out) :: iostat !> Error message. - character(len=:), allocatable, optional, intent(out) :: msg + character(len=:), allocatable, optional, intent(out) :: iomsg - integer :: unit, iostat + integer :: unit, stat character(len=256) :: line stat = 0 @@ -48,26 +50,30 @@ subroutine list_dir(dir, files, stat, msg) if (.not. exists(temp_dir)) then call run('mkdir '//temp_dir, stat) if (stat /= 0) then - if (present(msg)) msg = "Failed to create temporary directory '"//temp_dir//"'."; return + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to create temporary directory '"//temp_dir//"'." + return end if end if call run('ls '//dir//' > '//listed_contents, stat) if (stat /= 0) then - if (present(msg)) then - msg = "Failed to list files in directory '"//dir//"'."; return - end if + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to list files in directory '"//dir//"'." + return end if open(newunit=unit, file=listed_contents, status='old', action='read', iostat=stat) if (stat /= 0) then - if (present(msg)) msg = "Failed to open file '"//listed_contents//"'."; return + if (present(iostat)) iostat = stat + if (present(iomsg)) iomsg = "Failed to open file '"//listed_contents//"'." + return end if allocate(files(0)) do - read(unit, '(A)', iostat=iostat) line - if (iostat /= 0) exit + read(unit, '(A)', iostat=stat) line + if (stat /= 0) exit files = [files, string_type(line)] end do close(unit, status="delete") @@ -76,30 +82,31 @@ subroutine list_dir(dir, files, stat, msg) !> Version: experimental !> !> Run a command in the shell. - subroutine run(command, stat, msg) + !> [Specification](../page/specs/stdlib_io.html#run) + subroutine run(command, iostat, iomsg) !> Command to run. character(len=*), intent(in) :: command !> Status of the operation. - integer, intent(out), optional :: stat + integer, intent(out), optional :: iostat !> Error message. - character(len=:), allocatable, intent(out), optional :: msg + character(len=:), allocatable, intent(out), optional :: iomsg integer :: exitstat, cmdstat character(len=256) :: cmdmsg - if (present(stat)) stat = 0 + if (present(iostat)) iostat = 0 exitstat = 0; cmdstat = 0 call execute_command_line(command, exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg) if (exitstat /= 0 .or. cmdstat /= 0) then - if (present(stat)) then + if (present(iostat)) then if (exitstat /= 0) then - stat = exitstat + iostat = exitstat else - stat = cmdstat + iostat = cmdstat end if end if - if (present(msg) .and. trim(adjustl(cmdmsg)) /= '') msg = cmdmsg + if (present(iomsg) .and. trim(adjustl(cmdmsg)) /= '') iomsg = cmdmsg end if end end diff --git a/src/stdlib_io_zip.f90 b/src/stdlib_io_zip.f90 index c6df96a78..23629f058 100644 --- a/src/stdlib_io_zip.f90 +++ b/src/stdlib_io_zip.f90 @@ -18,6 +18,7 @@ module stdlib_io_zip !> Version: experimental !> !> Create a zip file from a list of files. + !> [Specification](../page/specs/stdlib_io.html#zip) subroutine zip(output_file, files, stat, msg, compressed) !> Name of the zip file to create. character(*), intent(in) :: output_file @@ -68,6 +69,7 @@ subroutine zip(output_file, files, stat, msg, compressed) !> Version: experimental !> !> Extract a zip file to a directory. + !> [Specification](../page/specs/stdlib_io.html#unzip) subroutine unzip(filename, outputdir, stat, msg) !> Name of the zip file to extract. character(len=*), intent(in) :: filename From b4e7c3a7229ef5ca030a28c26f181e566b84f8a5 Mon Sep 17 00:00:00 2001 From: minhqdao Date: Fri, 23 Aug 2024 20:16:44 +0530 Subject: [PATCH 146/146] Change stat to iostat --- test/io/test_filesystem.f90 | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/test/io/test_filesystem.f90 b/test/io/test_filesystem.f90 index 73bb17263..fca2ecb02 100644 --- a/test/io/test_filesystem.f90 +++ b/test/io/test_filesystem.f90 @@ -67,7 +67,7 @@ subroutine fs_run_invalid_command(error) integer :: stat - call run("invalid_command", stat=stat) + call run("invalid_command", iostat=stat) call check(error, stat, "Running an invalid command should fail.") end @@ -76,7 +76,7 @@ subroutine fs_run_with_invalid_option(error) integer :: stat - call run("whoami -X", stat=stat) + call run("whoami -X", iostat=stat) call check(error, stat, "Running a valid command with an invalid option should fail.") end @@ -85,7 +85,7 @@ subroutine fs_run_valid_command(error) integer :: stat - call run("whoami", stat=stat) + call run("whoami", iostat=stat) call check(error, stat, "Running a valid command should not fail.") end @@ -95,12 +95,12 @@ subroutine fs_list_dir_empty(error) integer :: stat type(string_type), allocatable :: files(:) - call run('rm -rf '//temp_list_dir, stat=stat) + call run('rm -rf '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return end if - call run('mkdir '//temp_list_dir, stat=stat) + call run('mkdir '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if @@ -109,7 +109,7 @@ subroutine fs_list_dir_empty(error) call check(error, stat, "Listing the contents of an empty directory shouldn't fail.") call check(error, size(files) == 0, "The directory should be empty.") - call run('rm -rf '//temp_list_dir, stat=stat) + call run('rm -rf '//temp_list_dir, iostat=stat) end subroutine fs_list_dir_one_file(error) @@ -120,17 +120,17 @@ subroutine fs_list_dir_one_file(error) type(string_type), allocatable :: files(:) character(*), parameter :: filename = 'abc.txt' - call run('rm -rf '//temp_list_dir, stat=stat) + call run('rm -rf '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return end if - call run('mkdir '//temp_list_dir, stat=stat) + call run('mkdir '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if - call run('touch '//temp_list_dir//'/'//filename, stat=stat) + call run('touch '//temp_list_dir//'/'//filename, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating file'"//filename//"' in directory '"//temp_list_dir//"' failed."); return end if @@ -140,7 +140,7 @@ subroutine fs_list_dir_one_file(error) call check(error, size(files) == 1, "The directory should contain one file.") call check(error, char(files(1)) == filename, "The file should be '"//filename//"'.") - call run('rm -rf '//temp_list_dir, stat=stat) + call run('rm -rf '//temp_list_dir, iostat=stat) end subroutine fs_list_dir_two_files(error) @@ -152,22 +152,22 @@ subroutine fs_list_dir_two_files(error) character(*), parameter :: filename1 = 'abc.txt' character(*), parameter :: filename2 = 'xyz' - call run('rm -rf '//temp_list_dir, stat=stat) + call run('rm -rf '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Removing directory '"//temp_list_dir//"' failed."); return end if - call run('mkdir '//temp_list_dir, stat=stat) + call run('mkdir '//temp_list_dir, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating directory '"//temp_list_dir//"' failed."); return end if - call run('touch '//temp_list_dir//'/'//filename1, stat=stat) + call run('touch '//temp_list_dir//'/'//filename1, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating file 1 in directory '"//temp_list_dir//"' failed."); return end if - call run('touch '//temp_list_dir//'/'//filename2, stat=stat) + call run('touch '//temp_list_dir//'/'//filename2, iostat=stat) if (stat /= 0) then call test_failed(error, "Creating file 2 in directory '"//temp_list_dir//"' failed."); return end if @@ -178,7 +178,7 @@ subroutine fs_list_dir_two_files(error) call check(error, char(files(1)) == filename1, "The file should be '"//filename1//"'.") call check(error, char(files(2)) == filename2, "The file should be '"//filename2//"'.") - call run('rm -rf '//temp_list_dir, stat=stat) + call run('rm -rf '//temp_list_dir, iostat=stat) end subroutine delete_file(filename)