diff options
| author | jhendersonHDF <jhenderson@hdfgroup.org> | 2023-10-12 16:32:23 (GMT) |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2023-10-12 16:32:23 (GMT) |
| commit | ea3f92605761e1ff17d858df303dc375df7efc1c (patch) | |
| tree | 716311100f8d0f0dc77bca31245878546952aabc /fortran/test | |
| parent | 0feda66ff0dccdf77453b7c881c80be244e0ae12 (diff) | |
| download | hdf5-ea3f92605761e1ff17d858df303dc375df7efc1c.zip hdf5-ea3f92605761e1ff17d858df303dc375df7efc1c.tar.gz hdf5-ea3f92605761e1ff17d858df303dc375df7efc1c.tar.bz2 | |
1.14 sync with develop (#3660)
* Rework tools.cmake and add C flags (#3110)
* Fix gh pages so that the doxygen files are uploaded (#3102)
* Add workspace path
* add debug
* Make one job so workspace files are available
* Put doxygen docs under docs folder in gh-pages
* Fix a misc warning in test/vol.c (#3112)
The compiler complains about using integers instead of size_t
for some sizes.
* Remove H5detect and H5make_libsettings (#3104)
Removes H5detect and H5make_libsettings from the build and replaces
their functionality with things that don't affect cross-compiling.
H5detect --> floating-point types are now detected on library load
H5make_libsettings --> Moved functionality to a new H5build_settings.c template file
* clang-tidy clang-analyzer-core issues addressed (#3113)
src/H5system.c:1293:13: warning: Dereference of null pointer
[clang-analyzer-core.NullDereference]
src/H5trace.c:4048:17: warning: Passed-by-value struct argument contains
uninitialized data (e.g., via the field chain: 'initial.user')
[clang-analyzer-core.CallAndMessage]
* Add note for issue 3056 (#3117)
* Use 1.14 toolchain (#3116)
* Remove the checkposix script (#3122)
This script was used to ensure that all non-HDF5 calls were prefixed
with 'HD'. We are removing this scheme so this script is no longer
needed.
* Remove unused HD macros (#3120)
* Remove unused HD macros
The library prefixes most C and POSIX API calls with 'HD'. We are
going to start removing these so the code looks like normal C.
This PR removes most of the unused HD markup macros.
* Replace ntohl/ntohs
* Adds an optional version arg to bin/format_source (#3119)
* Clean up mirror VFD code in utils dir (#3121)
* Remove dead code
* Replace mybzero with memset
* Replace hbool_t/TRUE/FALSE with bool/true/false
* Fix spelling issues flagged by codespell (#3130)
* Make autogen.sh output message consistent (#3128)
* Add Python for HDF-EOS zoo description (#3129)
* Fix function name in comment in ros3 VFD (#3131)
* Revert long double checks (#3133)
* Revert "Remove long double conversion work-arounds (#3097)"
This reverts commit 1e1dac1dac58fa18f6b7788346d1ba7d3315b0f9.
* Update comments to reflect newer systems
* Add java options to build scripts (#3127)
* Add java options to build scripts
Previously, cmakehdf5 turned on compiling of the java interface
by default due to a value set in cacheinit.cmake.
Now, consistent with how Fortran and CPP interfaces are handled,
the script overwrites this default value to disable the libraries,
fixing #2958.
I also implemented the --enable-java/--disable java options for
cmakehdf5, and -java for buildhdf5.
Allen said these scripts should mention that
compilers are to be specified in environment variables, but missing
compilers causes errors at the CMake level, and
CMake's error messages are already pretty informative (See the one
in #2958 about JAVA_COMPILER).
* Removed .lnt linter files (#3143)
These were last usefully modified in 2004
* Fix path to libhdf5.settings in cmakehdf5 (#3140)
* Many clang -Wextra-semi-stmt fixes (#2537)
* Adds semicolons to function-like macros
* Adds a do..while(0) loop to some macros
* Removes semicolons when inappropriate, especially H5E_TRY_BEGIN/END
* Remove HD prefix from network calls (#3142)
HDsocket(), etc. Only affects the mirror VFD and its test code.
* Remove hbool_t/TRUE/FALSE from java (#3145)
Replaces with bool/true/false
* CMake: (feature) ROS3 and cmake config file. (#3146)
- Added a cmake variable to the hdf5-config.cmake file which
indicate if the library has been build with or without the
read-only S3 functionality.
* Define minimal permissions for new GitHub workflows (#3147)
* Track s3 i/o when S3COMMS_DEBUG enabled (#3139)
* Track s3 i/o when S3COMMS_DEBUG enabled
* Fix the snapshots workflow (#3148)
* Add upload url as artifact
* Change doxygen path and comment log-url upload
* zip doxygen files for upload
* add workspace var
* chore: fix grammar (#3150)
* chore: fix grammar
* Removes the HD prefix from java C99 calls (#3149)
POSIX calls (HDstrndup, etc.) are unchanged
* Correct the zip usage (#3153)
* Many fixes to various compiler warnings (#3124)
* Fixed various -Wmissing-variable-declarations by adding static keyword
* In a few cases, renamed the variable suffix from _g to _s.
* Fixed some -Wmissing-variable-declarations by using different declaration macros
* Fixed various -Wconditional-uninitialized warnings by just initializing variable to zero
* Fixed various -Wcomma warnings
* Fixed clang -Wstrict-prototypes warnings
* Fixed various -Wunused-variable warnings
* Updated some casts to fix the only 3 -Wcast-qual warnings
* Fixed the only -Wsometimes-uninitialized warning
* Create Security Policy (#3152)
* Fix #1978 h5vers usage message. (#3162)
Update Platforms Tested in RELEASE.txt.
* speed-up building HDF5 (#3087)
Disables building the tests when building the netCDF, etc.
* Remove dead code behind #ifdef OLD_WAY (#3163)
* Remove H5F_evict_tagged_metadata() (#3165)
The rest of the library just calls H5AC_evict_tagged_metadata()
directly.
* Add missing space in zip command (#3167)
* Fixed check for a VOL's async compatibility (#3164)
* cap flag fix in test
* added async comp. output
* Update Linux workflows (#3173)
* Consolidate environment setup
* Turn on ros3 VFD in CMake (Linux only)
* Add gh-pages doxygen link (#3175)
* Fix the doxygen to gh pages and artifact creation (#3176)
* Tidy the list of options in main.yml (#3181)
* Remove HD/hbool_t from fortran (#3182)
* Remove HD/hbool_t from high-level lib (#3183)
* Remove HDva_(arg|copy|end|start) (#3184)
* Drop HD prefix & hbool_t from H5TS (#3180)
* Remove HD from fork/exec*/wait* (#3190)
These are not C99 but are hidden behind ifdefs and are highly
unlikely to ever have non-POSIX equivalents.
* Fix assertion failure when attempting to use IOC VFD directly (#3187)
* Rename HDqsort() to qsort() (#3193)
* Rename HDqsort() to qsort()
* Committing clang-format changes
---------
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
* Rename HDpipe() to pipe() (#3192)
Pipe is POSIX but implemented in Microsoft's CRT
* Rename HDassert() to assert() (#3191)
* Change HDassert to assert
* Fix bin/make_err
* Rename HD(f)printf() to (f)printf() (#3194)
* Add note about HDF5_VOL_CONNECTOR to tools usage (#3159)
* Rename HDsystem() to system() (#3197)
system() is only used in the iopipe test and the things it calls
(which are POSIX-y) are protected by an ifdef.
* Remove HD from HDposix_memalign() (#3196)
The posix_memalign call is only used in the direct VFD, which can only
be built if posix_memalign() is available.
* Remove HD from memory allocate/free calls (#3195)
* HDcalloc
* HDfree
* HDmalloc
* HDrealloc
* chore: fix grammar (#3207)
* docs: remove redundancy in Data Transfer section of user guide (#3208)
* Remove checks for setsysinfo, which is unused (#3205)
* Autotools
* CMake
* Remove HD from protected POSIX calls (#3203)
These calls are non-C99 but protected by ifdefs and have no Windows
equivalents:
* HDalarm
* HDasprintf
* HDclock_gettime
* HDfcntl
* HDgethostname
* HDgetrusage
* HDsymlink
* Rename HDato*() to ato*() (#3201)
* Remove some "Programmer" comments (#3209)
These are meaningless noise.
Removes the "Programmer" lines on comment start lines:
/* Programmer: John Smith
These complicate my sed script that will rip out the rest of
the comments.
* Rename HDexit() and related to exit(), etc. (#3202)
* HDatexit
* HDexit
* HD_exit
* Remove HD from strto* calls (#3204)
* HDstrtod
* HDstrtol
* HDstrtoll
* HDstrtoul
* HDstrtoull
* HDstrtoumax
* Remove HD from C std lib file ops (#3206)
* HDfclose
* HDferror
* HDfeof
* HDfflush
* HDfopen
* HDfread
* HDfwrite
* Remove programmer/date from comments (#3210)
* Removes Programmer: and Date: fields
* Fixes a few Modifications: fields leftover from previous work
* Remove HD from HDmem* calls (#3211)
* Remove HD from HDis* (e.g., isalpha) (#3212)
* HDisalnum
* HDisalpha
* HDiscntrl
* HDisdigit
* HDisgraph
* HDislower
* HDisprint
* HDispunct
* HDisspace
* HDisupper
* HDisxdigit
* Update actions for release option, fix branch for daily build (#3185)
* Update actions for release option, fix branch for daily build
* Scheduled workflows run on latest commit on the develop
* Add snapshots location
* docs: improve consistency in verb form (#3076) (#3188)
* fix gh action if statements (#3213)
* Adjust presets timeout and fix build script VS versions (#3215)
* Several ros3vfd logging improvements
* Committing clang-format changes
* Update COPYING (#3231)
Fixed old support URL.
* addresses compilation fortran warnings on Frontier (#3236)
* Fix doc for H5allocate_memory (#3240)
* merge bbrelease to release (#3232)
* merge bbrelease to release
* Fix pre-req workflow
* Replace support.hdfgroup.org URLs for alternative COPYING file (#3228)
* Replace support.hdfgroup.org URLs for alternative COPYING file
locations in copyright headers with https://www.hdfgroup.org/licenses.
Replace support.hdfgroup.org URL for alternative COPYING_LBNL_HDF5
with github URL.
Tweak chkcopyright script for change from UICOPYRIGHTSTR to
THGCOPYRIGHTSTR.
* Replace 1_10 reference with develop branch (#3227)
* Switch CI to use release script (#3242)
* Subfiling VFD source cleanup (#3241)
* Subfiling VFD source cleanup
Modularize Subfiling CMake code into separate CMakeLists.txt file
Update Mercury util code to latest version and update Copyright
Generate mercury_util_config.h header file instead of using
pre-generated file
Remove unnecessary Mercury functionality
Fix minor warning in Subfiling VFD code
* Remove Mercury headers from Autotools publicly-distributed header list
* install h5fuse.sh in bin dir. (#3244)
* Disable h5py until fixed properly without spack (#3243)
* ROS3: (feature) Temporary security credentials (#3030)
- Implemented support for AWS temporary security credentials.
For this kind of credentials also a session/security token
should be included in the request by adding the
x-amz-security-token header.
Co-authored-by: Larry Knox <lrknox@hdfgroup.org>
Co-authored-by: Jordan Henderson <jhenderson@hdfgroup.org>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
* Avoid truncating at null byte when copying to std::string (#3083)
---------
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
* Fix CMake builds when Subfiling VFD isn't enabled (#3250)
* Fix CMake builds when Subfiling VFD isn't enabled
* Add Subfiling VFD entry to hdf5-config.cmake.in
* Fix some warnings in developer builds (#3247)
* Fix some warnings in developer builds
* Switch approach to Winline flag
* Fixed more warnings about extra semicolons (#3249)
* Require semi-colon after H5_CHECK_OVERFLOW calls
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
* Fix warning in H5C__UPDATE_STATS_FOR_DIRTY_PIN macro (#3259)
Add braces to H5C__UPDATE_STATS_FOR_DIRTY_PIN macro to fix warning
causing Werror Release builds to fail
* Update DEFAULT_API_VERSION documentation for CMake (#3255)
* Update DEFAULT_API_VERSION documentation for CMake
* Fix hint
---------
Co-authored-by: Larry Knox <lrknox@hdfgroup.org>
* changed the scope of #ifdef DOXYGEN to now include H5D multi-functions (#3254)
* Option changed but not all references (#3252)
* Option changed but not all references
* remove quotes from binary var
* Move 1.12.3 release to October (#3263)
* Fixed some -Wunused-variable warnings and one Wsometimes-uninitialized warning (#3260)
* removed the use of encoded single apostrophe (#3261)
* removed the use of encoded single apostrophe, and fix H5Dread_chunk from write to read
* updated sanitizer paragraph
* fixed brief description for H5Fget_info
* ROS3: (fix) Replaced HDfprintf (#3266)
- Replaced the HDfprintf() functions by fprintf() to be consistent
with other parts of the library.
* chore: make VRFY output consistent (#3268)
* CMake: (fix) Threads dependency (#3267)
- If the HDF5 library has been build with either thread-safety or
subfiling VFD feature on it will have an additional dependency
on a threading library. This dependency has been added to the
hdf-config.cmake.in file.
* chore: fix grammar - get hang -> get hung (#3272)
* Another round of fixing -Wextra-semi-stmt warnings (#3264)
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
* chore: fix typo - persent -> present (#3273)
* Remove py-pip from h5py action (#3265)
* Update release schedule (#3317)
* Move 1.12.3 to November
* Add 1.14.3 in October
* Update README.md w/ 1.4.3 info (#3318)
* Switch parallel compression to use vector I/O (#3245)
Updates parallel compression feature to use vector I/O instead of
creating and passing down MPI derived types to VFD
* Fix incorrect error check in H5Ofill.c for undefined fill values (#3312)
* Fix H5Otoken_to_str call in h5dump and other minor cleanup (#3314)
* Fix loading plugin fails with missing directory GH issue #3248 (#3315)
* Made HGOTO_ERROR a do-while loop (#3308)
* Made HGOTO_ERROR a do-while loop
* Update files to skip list and ignore_words_list (#3321)
* Update files to skip list and ignore_words_list for codespell to not
check files generated by autotools. Autotools generate misspellings
that can't be fixed in HDF5 code.
* Windows runtime items go into the bin folder (#3320)
* A couple of documentation items to fix (#3332)
* Fix h5repack for variable-length datatyped datasets (#3331)
* Fix CVE-2018-11202 (#3330)
A malformed file could result in chunk index memory leaks. Under most
conditions (i.e., when the --enable-using-memchecker option is NOT
used), this would result in a small memory leak and and infinite loop
and abort when shutting down the library. The infinite loop would be
due to the "free list" package not being able to clear its resources
so the library couldn't shut down. When the "using a memory checker"
option is used, the free lists are disabled so there is just a memory
leak with no abort on library shutdown.
The chunk index resources are now correctly cleaned up when reading
misparsed files and valgrind confirms no memory leaks.
* Fix CVE-2018-13867 (#3336)
* Fixes the last of the -Wextra-semi-stmt warnings (#3326)
* Fixed extra semi warning by adjusting alternative macro definitions
* Find-replace H5E_END_TRY; -> H5E_END_TRY
* Made H5Epush_goto a do-while loop, fixed indentation
* Made GOTOERROR and ERRMSG do-while loops
* Made Hgoto_error and Hgoto_done do-while loops
* Made vrfy_cint_type and vrfy_ctype do-while loops
* Made TEST_TYPE_CONTIG and others do-while loops
* Removed extraneous semi-colons
* Committing clang-format changes
---------
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
* Fix a typo in RELEASE.txt
* Fix assertion failure in H5D__mpio_collective_filtered_vec_io (#3340)
* Make h5dump spacing consistent when printing VLEN datatype (#3351)
* Fix for the bug exposed from running test/set_extent.c when selection… (#3319)
* Fix for the bug exposed from running test/set_extent.c when selection I/O is enabled.
This is a fix from Neil.
The test/set_extent.c is modified to test for selection I/O enabled.
* Add Fortran ES module to deploy list (#3341)
* Add Fortran ES module to deploy list
* Change fortran mod file export to use a list of names
* test(parallel): verify FALSE case (#3356)
* Implementation of the mpio driver with selection I/O. (#3222)
* This changes the default selection I/O to on for MPIO.
* Work around a testphdf5 failure on Cray MPICH machines (#3361)
* set H5_PAC_C_MAX_REAL_PRECISION default to 0 when cross sompiling with (#3364)
CMake to fix Fortran build failures.
* Add RELEASE.txt notes for recent selection I/O work. (#3374)
* Fix possible performance regression introduced with in-place type conversion in 1.14.2 (#3376)
* Correct script (#3377)
* Correct CI settings (#3384)
* Correct CI settings
* Correct plugin file name
* restore CI tarball name prefix to match bin/release (#3385)
* Fix assertion failure during file close on error (#3387)
* Fix compile failures with H5C_DO_MEMORY_SANITY_CHECKS enabled (#3388)
* Fix valgrind warning about write of uninitialized bytes (#3389)
* Fix valgrind warning about write of uninitialized bytes in ScaleOffset filter (#3390)
* Update presets, examples uncompress, szip cache (#3391)
* Fix serial to parallel chunked dataset file space allocation bug (#3394)
* chore: fix typo (#3405)
* Fix for CVE-2016-4332 (#3406)
This CVE issue was previously listed as fixed (via HDFFV-9950) back in
2016, but with no confirmation test. Now that test files exist for
the 2016 Talos CVE issues, we found that CVE-2016-4332 can raise an
assert in debug builds.
This fix replaces the assert with pointer checks that don't raise
errors or asserts. Since the function is in cleanup code, we do our
best to close and free things, even when presented with partially-
initialized structs.
Fixes CVE-2016-4332 and HDFFV-9950 (confirmed via the cve_hdf5 repo)
* Fix ph5diff tests for MPIEXEC_MAX_NUMPROCS=1 (#3407)
* Enable szip by default in Autotools (#3412)
Since libaec is so prevalent and BSD-licensed for both encode and
decode, we build the szip filter by default when the szip or aec
libraries are found.
* Re-enable SZIP default to ON in CMake (#3414)
The Autotools were handled in a separate commit
* Fix Heap-buffer-overflow WRITE in H5MM_memcpy (#3368)
* Add Intel oneAPI actions (#2949) (#2977)
* ci: add Intel oneAPI actions (#2949)
* ci: fix CMake installation
* ci: use absolute paths for libtool installation
* ci(oneAPI): update compiler versions and use cron
* Add RELEASE.txt entry for compound performance regression fix (#3376) (#3416)
* chore: remove gubbins comment (#3420)
* Add other types and full type to enum/str/vlen dataformat for structblock[begin/end] (#3353)
* Avoid H5Ocopy in h5repack for variable-length string types (#3419)
* Skip atomicity tests for OpenMPI major versions < 5 (#3421)
* Fix an issue with use of uninitialized memory in trefer_deprec.c test (#3422)
* Add parallel examples in doxygen (#3413)
* Fix use of uninitialized value in testpar/t_dset.c test (#3423)
* Remove extraneous "33" in RELEASE.txt (#3425)
* Revise file close assertion failure fix (#3418)
* Remove intel oneapi warning (#3426)
* Fix for CVE-2018-15671. h5stat -S $POC will result in a crash with segmenetation fault. (#3427)
It is because the object in the testfile points back to the root group.
When the tool tries to traverse the object, it goes back to the root group and then back again.
* chore: match function call and VRFY() output (#3428)
* Fix the Fortran extension used in example links (#3430)
* Put H5T_CONV_ab macros in do..while loops (#3432)
Ever since a recent round of macro cleanup, bin/trace and clang-format
have been bickering over what H5Tconv.c should look like and neither
produces readable code.
This change puts the top-level H5T_CONV_ab macros in do..while loops,
adds appropriate semicolons, and adds the missing H5_CLANG_DIAG_ON|OFF
and H5_GCC_CLANG_DIAG_ON|OFF macros to the list of statement macros
clang-format recognizes. H5Tconv.c is now readable and both bin/trace
and clang-format are happy.
* Convert some H5MM calls to standard C equivalents (#2382)
* H5MM_calloc and malloc are now mapped to stdlib C calls
* H5MM_memcpy now maps directly to memcpy in release builds
* H5MM_memcpy is still implemented as a separate function that
checks for buffer overlap when H5MM_DEBUG is defined
(default w/ debug builds)
* Switches many library memcpy calls to use H5MM_memcpy
* Fixes a possible zero allocation in H5Olayout.c
* Add 1.14.4 to the release schedule (#3434)
* Output stderr file in CMake testing on failure (#3431)
* Add Intel oneAPI badges (#3433)
* Add a CVE regression test action (#3445)
*
* Disable SZIP for Intel oneAPI Action (#3449)
* Disable SZIP for Intel oneAPI Action
* Disable Fortran and parallel
* Update VOL CMake for REST VOL (#3450)
* Update VOL CMake for REST VOL
* Prevent linking static libs to VOLs
* Add an h5py badge to README.md (#3477)
* Removed all the ranks printing out testing information (#3457)
* Fix Subfiling VFD IOC assignment bug (#3456)
* Correct java test dimension (#3482)
* Support CMake VOL builds with FetchContent from local directory (#3455)
* Update VOL CMake for REST VOL
* Prevent linking static libs to VOLs
* index on fetch_local: 5c5c3f1505 Prevent linking static libs to VOLs
* index on (no branch): 9a36d3e7b1 On fetch_local: WIP:add source dir fetch option for vols
* Allow building of VOL from local source
* Move LOCAL_DIR option to HDF5_VOL_ALLOW_EXTERNAL
* Fix the Fortran include dir in install config files (#3454)
* Convert hbool_t --> bool in examples (#3492)
* Fix some minor formatting for consistency (#3499)
* Create scorecard.yml (#3508)
Bring in OSSF Scorecard code scanner as a GitHub action
* Convert hbool_t --> bool in testpar (#3495)
* hbool_t/TRUE/FALSE --> bool/true/false in tools (#3491)
* Convert hbool_t --> bool in test (#3494)
* Convert hbool_t --> bool in src (#3496)
* hbool_t --> bool in src
* Does not remove TRUE/FALSE
* Public header files are unchanged
* Public API calls are unchanged
* TRUE/FALSE --> true/false in src
* Add deprecation notice for hbool_t
* Added new Fortran API wrappers (#3511)
* Added new wrappers for
h5get_free_list_sizes_f
H5Sselect_intersect_block_f
H5Sselect_shape_same_f
h5pget_no_selection_io_cause_f
h5pget_mpio_no_collective_cause_f
H5Lvisit_by_name_f
H5Lvisit_f
H5Fget_info_f
h5dwrite_chunk_f
h5dread_chunk_f
* added h5pget_file_space_page_size_f, h5pset_file_space_page_size_f, h5pget_file_space_strategy_f, h5pset_file_space_strategy_f, h5info tests
* added fortran tests
* Update tH5F.F90
* misc. fortran fixes for failing CI dailty tests (#3523)
* fixed H5Lvisit* interface
* changed integer type for direct write
* Consistent initialization of hid_t in the tests (#3521)
* Fix windows cpack with debug (#3525)
* Add missing row for the ROS3 VFD in table #3415 (#3517)
* fixed nvidia compiler issue (#3527)
* Identify functions in a subgroup (#3530)
* quiet warning on sunspot (gcc 11.2.0) (#3534)
* Add API examples doxygen page (#3500)
* removed C_INT32_T from Fortran APIs (#3537)
* Add NVHPC 23.7 GitHub Actions (#3509)
* Add NVHPC 27.3 GitHub Actions
* Address @derobins review
* Remove HD prefix from math functions (#3538)
* Remove HD prefix from HDlog10 calls (#3539)
Was missed in a previous commit and causes building subfiling to
fail.
* fixed arg to C H5Dwrite_chunk (#3541)
* Strip HD prefix from string/char C API calls (#3540)
* Strip HD prefix from string/char C API calls
* HD(f)(put|get)(s|c)
* HDstr*
* HDv*printf
* HD(s)(print|scan)f
* HDperror
But NOT:
* HDstrcase*
* HDvasprintf
* HDstrtok_r
* HDstrndup
As those are not C99 and have portability work-around
implementations. They will be handled later.
* Fix th5_system.c screwup
* Convert main.yml CI into callable workflows (#3529)
* Fix broken URL. (#3546)
* Fix grammar (#3545)
* Update oneAPI-C/A badge yml links. (#3564)
* Check return values from HDF5 API calls. (#3556)
* Adds link to h5fuse.sh in testpar for autotools (#3557)
* Make the h5fuse.sh utility available to parallel subfiling tests so h5fuse testing is not skipped.
* Some minor formatting and text changes (#3563)
* Fix typos and grammar in t_pread. (#3565)
* Fix typo (givin->given) in test/testframe.c. (#3567)
* Fix ifx unused variable hdferr warning. (#3568)
* Correct comments about H5Z_FILTER_NONE (#3572)
* Update release script. (#3577)
* fixed function declaration (#3579)
* Fixed GH-3554 (#3584)
Removed the extra condition
* Remove h5dwalk.1 man page. (#3589)
* Removed the use of -commons linking option on Darwin (#3581)
Removed the use of -commons linking option on Darwin as COMMON and EQUIVALENCE is no long used
* Fix docs for H5Pset_dxpl_mpio_collective_opt() (#3594)
* Fix typo: arange->arrange in src/H5Cmpio.c. (#3597)
* Fix docs for H5Acreate2 and H5Acreate_by_name (#3598)
* Use HDoff_t with lseek consistently (#3600)
lseek on Windows uses __int64 for both the offset and return type
instead of off_t like most POSIX systems. This changes ensures we
use HDoff_t (which is typdef'd correctly on Windows) w/ lseek.
* Replaces HDgetenv with getenv (#3599)
* Develop tools move (#3580)
Reorganizes the tools files to support the VOL tests
* Clean up Subfiling VFD header doxygen formatting (#3601)
* Remove `sh` to run bash script. (#3590)
* Correct path name of ddl file to be changed (#3607)
* Fix potential uninitialized variable (#3602)
Moves a union initialization up a bit so it's performed before code
that can jump to the cleanup target, where file descriptors could
be checked without being initialized.
This could only happen in test code and only in an out-of-memory
situation.
Fixes Coverity 1542254
* Remove unnecessary assignment in test generator (#3603)
Fixes what looks like a copy/paste/modify error in the format convert
test file generator, where an array element is assigned one value
and them immediately overwritten by another value.
Fixes Coverity issue 1542285
* Remove useless define TRUE/FALSE statements. (#3604)
* Fix typo behaviour and dependes. (#3605)
* Fix typos (#3609)
* Fixed unused variable in H5CS.c (#3552) (#3612)
* Fixed #3552
* Fix grammar (#3614)
* Cleanup unused statements (#3553) (#3617)
Removed unnecessary assert statements and noise comments.
* Fix Intel oneAPI icc warning (#3619)
* Fix several spelling/grammar issues (#3621)
* Add HPC CDash to README.md (#3623)
* Disable static + thread-safe on Windows w/ CMake (#3622)
The thread-safety feature on Windows requires a hook in DllMain() and
thus is only available when HDF5 is built as a shared library.
This was previously a warning, but has now been elevated to a fatal
error that cannot be overridden with ALLOW_UNSUPPORTED.
Fixes GitHub #3613
* Remove unused member from H5D_shared_t struct. (#3628)
* Remove old EXTERNALPROJECT_ADD in favor of FETCH_CONTENT (#3624)
* Fix grammar (#3635)
* Disambiguate error output messages. (#3634)
* Disambiguate error output messages.
* Address @brtnfld review.
* Fail CMake on Windows when sub-filing VFD is enabled (#3636)
* Improve consistency in past tense usage (#3638)
* Split out test logic to separate file (#3639)
* Drop MPI-2 support (#3643)
* Switch IEEE flags for NAG Fortran (#3644)
Default is -ieee=stop, which causes problems when the H5T
module performs floating-point type introspection.
The new mode is -ieee=full
* Remove 1.10.11 info from README.md (#3646)
* Fixes GH#1027 compilation error (#3654)
* Remove 1.10 badge (#3650)
* Use real URLs and updated names for plugins (#3651)
* synchronize TGZ naming convention/usage
* Update parallel compression feature to support multi-dataset I/O (#3591)
* Add more tests for selection I/O. (#3528)
* Adjust 1.14 files after merging
---------
Diffstat (limited to 'fortran/test')
| -rw-r--r-- | fortran/test/CMakeLists.txt | 1 | ||||
| -rw-r--r-- | fortran/test/Makefile.am | 2 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test.F90 | 13 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_1_8.F90 | 6 | ||||
| -rw-r--r-- | fortran/test/fortranlib_test_F03.F90 | 10 | ||||
| -rw-r--r-- | fortran/test/tH5D.F90 | 170 | ||||
| -rw-r--r-- | fortran/test/tH5F.F90 | 2244 | ||||
| -rw-r--r-- | fortran/test/tH5F_F03.F90 | 177 | ||||
| -rw-r--r-- | fortran/test/tH5L_F03.F90 | 289 | ||||
| -rw-r--r-- | fortran/test/tH5MISC_1_8.F90 | 64 | ||||
| -rw-r--r-- | fortran/test/tH5P_F03.F90 | 2 | ||||
| -rw-r--r-- | fortran/test/tH5Sselect.F90 | 53 | ||||
| -rw-r--r-- | fortran/test/tHDF5_F03.F90 | 1 |
13 files changed, 1866 insertions, 1166 deletions
diff --git a/fortran/test/CMakeLists.txt b/fortran/test/CMakeLists.txt index 67c8b75..ff27943 100644 --- a/fortran/test/CMakeLists.txt +++ b/fortran/test/CMakeLists.txt @@ -285,7 +285,6 @@ endif () add_executable (fortranlib_test_F03 fortranlib_test_F03.F90 tH5E_F03.F90 - tH5F_F03.F90 tH5L_F03.F90 tH5O_F03.F90 tH5P_F03.F90 diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am index 6ceddd6..6d11dcc 100644 --- a/fortran/test/Makefile.am +++ b/fortran/test/Makefile.am @@ -46,7 +46,7 @@ fortranlib_test_SOURCES = tH5F.F90 tH5D.F90 tH5R.F90 tH5S.F90 tH5T.F90 tH5VL.F90 fortranlib_test_1_8_SOURCES = tH5O.F90 tH5A_1_8.F90 tH5G_1_8.F90 tH5MISC_1_8.F90 tHDF5_1_8.F90 \ fortranlib_test_1_8.F90 -fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5F_F03.F90 tH5L_F03.F90 \ +fortranlib_test_F03_SOURCES = tH5E_F03.F90 tH5L_F03.F90 \ tH5O_F03.F90 tH5P_F03.F90 tH5T_F03.F90 tHDF5_F03.F90 fortranlib_test_F03.F90 vol_connector_SOURCES=vol_connector.F90 diff --git a/fortran/test/fortranlib_test.F90 b/fortran/test/fortranlib_test.F90 index eb587a9..e0a837a 100644 --- a/fortran/test/fortranlib_test.F90 +++ b/fortran/test/fortranlib_test.F90 @@ -92,6 +92,14 @@ PROGRAM fortranlibtest CALL file_space("file_space",cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' File free space test', total_error) + ret_total_error = 0 + CALL test_file_info("file_info",cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' File information test', total_error) + + ret_total_error = 0 + CALL test_get_file_image(ret_total_error) + CALL write_test_status(ret_total_error, ' Testing get file image ', total_error) + ! ! '=========================================' ! 'Testing DATASET Interface ' @@ -114,6 +122,11 @@ PROGRAM fortranlibtest CALL test_dset_fill(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Filling dataspace elements', total_error) + ! Direct chunk IO + ret_total_error = 0 + CALL test_direct_chunk_io(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Direct chunk IO', total_error) + ! ! '=========================================' ! 'Testing DATASPACE Interface ' diff --git a/fortran/test/fortranlib_test_1_8.F90 b/fortran/test/fortranlib_test_1_8.F90 index fde3faa..6b3e7fa 100644 --- a/fortran/test/fortranlib_test_1_8.F90 +++ b/fortran/test/fortranlib_test_1_8.F90 @@ -103,6 +103,12 @@ PROGRAM fortranlibtest ' Testing basic generic property list class creation functionality', & total_error) + ret_total_error = 0 + CALL test_freelist(ret_total_error) + CALL write_test_status(ret_total_error, & + ' Testing free list', & + total_error) + WRITE(*,*) WRITE(*,*) ' ============================================ ' diff --git a/fortran/test/fortranlib_test_F03.F90 b/fortran/test/fortranlib_test_F03.F90 index 6c53cc0..85ab744 100644 --- a/fortran/test/fortranlib_test_F03.F90 +++ b/fortran/test/fortranlib_test_F03.F90 @@ -135,10 +135,14 @@ PROGRAM fortranlibtest_F03 CALL write_test_status(ret_total_error, ' Test basic generic property list callback functionality', total_error) ret_total_error = 0 - CALL test_iter_group(ret_total_error) + CALL test_iter_group(cleanup, ret_total_error) CALL write_test_status(ret_total_error, ' Testing group iteration functionality', total_error) ret_total_error = 0 + CALL test_visit(cleanup, ret_total_error) + CALL write_test_status(ret_total_error, ' Testing link visit functionality', total_error) + + ret_total_error = 0 CALL test_nbit(ret_total_error) CALL write_test_status(ret_total_error, ' Testing nbit filter', total_error) @@ -171,10 +175,6 @@ PROGRAM fortranlibtest_F03 CALL test_obj_info(ret_total_error) CALL write_test_status(ret_total_error, ' Testing object info functions ', total_error) - ret_total_error = 0 - CALL test_get_file_image(ret_total_error) - CALL write_test_status(ret_total_error, ' Testing get file image ', total_error) - ! write(*,*) ! write(*,*) '=========================================' ! write(*,*) 'Testing VDS ' diff --git a/fortran/test/tH5D.F90 b/fortran/test/tH5D.F90 index b5ad6e8..8c1484f 100644 --- a/fortran/test/tH5D.F90 +++ b/fortran/test/tH5D.F90 @@ -990,8 +990,176 @@ CONTAINS ENDIF ENDDO - END SUBROUTINE test_dset_fill + SUBROUTINE test_direct_chunk_io(cleanup, total_error) + + USE ISO_C_BINDING + + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(OUT) :: total_error + CHARACTER(LEN=4), PARAMETER :: filename = "doIO" + CHARACTER(LEN=80) :: fix_filename + + CHARACTER(LEN=15), PARAMETER :: dsetname = "dset" + + INTEGER :: RANK = 2 + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: dset_id ! Dataset identifier + INTEGER(HID_T) :: dataspace ! Dataspace identifier + INTEGER(HID_T) :: dcpl ! dataset creation property identifier + + ! + !dataset dimensions at creation time + ! + INTEGER, PARAMETER :: DIM0 = 4 + INTEGER, PARAMETER :: DIM1 = 32 + INTEGER(SIZE_T), PARAMETER :: CHUNK0 = DIM0 + INTEGER(SIZE_T), PARAMETER :: CHUNK1 = DIM1/2 + INTEGER(HSIZE_T), DIMENSION(2) :: offset + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/DIM0,DIM1/) + INTEGER, DIMENSION(CHUNK0,CHUNK1), TARGET :: wdata1, rdata1, wdata2, rdata2 + INTEGER(HSIZE_T), DIMENSION(2) :: chunk = (/CHUNK0, CHUNK1/) + INTEGER :: i, j, n + INTEGER :: error + TYPE(C_PTR) :: f_ptr + INTEGER :: filters + INTEGER(SIZE_T) :: sizeINT + INTEGER(HID_T) :: dxpl + + ! + !Create a new file using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + + CALL h5pcreate_f(H5P_DATASET_XFER_F, dxpl, error) + CALL check("h5pcreate_f",error,total_error) + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! Dataset Fortran + + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + CALL h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, error) + CALL check("h5pcreate_f",error,total_error) + + CALL h5pset_chunk_f(dcpl, RANK, chunk, error) + CALL check("h5pset_chunk_f",error,total_error) + + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, dset_id, error, dcpl ) + CALL check("h5dcreate_f",error,total_error) + + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + CALL h5pclose_f(dcpl, error) + CALL check("h5pclose_f",error,total_error) + + n = 0 + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + n = n + 1 + wdata1(i,j) = n + wdata2(i,j) = n*10 + END DO + END DO + +#ifdef H5_FORTRAN_HAVE_STORAGE_SIZE + sizeINT = storage_size(i, KIND=size_t)/storage_size(c_char_'a',c_size_t) +#else + sizeINT = SIZEOF(i) +#endif + + f_ptr = C_LOC(wdata1) + offset(1:2) = (/0, 0/) + CALL H5Dwrite_chunk_f(dset_id, 0, offset, CHUNK0 * CHUNK1 * sizeINT, f_ptr, error) + CALL check("h5dwrite_f",error,total_error) + + f_ptr = C_LOC(wdata2) + offset(1:2) = (/0, 16/) + CALL H5Dwrite_chunk_f(dset_id, 0, offset, CHUNK0 * CHUNK1 * sizeINT, f_ptr, error, dxpl) + CALL check("h5dwrite_f",error,total_error) + + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !read the data back + ! + !Open the file. + ! + CALL h5fopen_f(fix_filename, H5F_ACC_RDONLY_F, file_id, error) + CALL check("hfopen_f",error,total_error) + + ! + !Open the dataset. + ! + CALL h5dopen_f(file_id, dsetname, dset_id, error) + CALL check("h5dopen_f",error,total_error) + + f_ptr = C_LOC(rdata1) + filters = 99 + offset(1:2) = (/0, 0/) + CALL H5Dread_chunk_f(dset_id, offset, filters, f_ptr, error) + CALL check("H5Dread_chunk_f",error,total_error) + + ! Verify that the data read was correct. + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + CALL VERIFY("H5Dread_chunk_f", rdata1(i,j), wdata1(i,j), total_error) + IF(total_error.NE.0) EXIT + ENDDO + ENDDO + + CALL VERIFY("H5Dread_chunk_f",filters, 0, total_error) + + f_ptr = C_LOC(rdata2) + offset(1:2) = (/0, 16/) + CALL H5Dread_chunk_f(dset_id, offset, filters, f_ptr, error, dxpl) + CALL check("H5Dread_chunk_f",error,total_error) + + ! Verify that the data read was correct. + DO i = 1, CHUNK0 + DO j = 1, CHUNK1 + CALL VERIFY("H5Dread_chunk_f", rdata2(i,j), wdata2(i,j), total_error) + IF(total_error.NE.0) EXIT + ENDDO + ENDDO + + CALL VERIFY("H5Dread_chunk_f",filters, 0, total_error) + + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5pclose_f(dxpl, error) + CALL check("h5pclose_f",error,total_error) + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + + RETURN + END SUBROUTINE test_direct_chunk_io + END MODULE TH5D diff --git a/fortran/test/tH5F.F90 b/fortran/test/tH5F.F90 index c255755..a5b67ac 100644 --- a/fortran/test/tH5F.F90 +++ b/fortran/test/tH5F.F90 @@ -21,7 +21,7 @@ ! ! CONTAINS SUBROUTINES ! mountingtest, reopentest, get_name_test, plisttest, -! file_close, file_space, h5openclose +! file_close, file_space, h5openclose, test_get_file_image ! !***** ! @@ -30,8 +30,17 @@ ! access the dataset from the second file as a member of a group ! in the first file. +! ***************************************** +! *** H 5 F T E S T S +! ***************************************** + MODULE TH5F + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + USE ISO_C_BINDING + CONTAINS SUBROUTINE h5openclose(total_error) @@ -131,1008 +140,1311 @@ CONTAINS RETURN END SUBROUTINE h5openclose - SUBROUTINE mountingtest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - !the respective filename is "mount1.h5" and "mount2.h5" - ! - CHARACTER(LEN=6) :: filename1 - CHARACTER(LEN=6) :: filename2 - CHARACTER(LEN=80) :: fix_filename1 - CHARACTER(LEN=80) :: fix_filename2 - - ! - !data space rank and dimensions - ! - INTEGER, PARAMETER :: RANK = 2 - INTEGER, PARAMETER :: NX = 4 - INTEGER, PARAMETER :: NY = 5 - - ! - ! File identifiers - ! - INTEGER(HID_T) :: file1_id, file2_id - - ! - ! Group identifier - ! - INTEGER(HID_T) :: gid - - ! - ! dataset identifier - ! - INTEGER(HID_T) :: dset_id - - ! - ! data space identifier - ! - INTEGER(HID_T) :: dataspace - - ! - ! data type identifier - ! - INTEGER(HID_T) :: dtype_id - - ! - !The dimensions for the dataset. - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - - ! - !return value for testing whether a file is in hdf5 format - ! - LOGICAL :: status - - ! - !flag to check operation success - ! - INTEGER :: error - - ! - !general purpose integer - ! - INTEGER :: i, j - - !number of objects - INTEGER(SIZE_T) :: obj_count - INTEGER(HID_T) :: t1, t2, t3, t4 - - ! File numbers - INTEGER :: file_num1 - INTEGER :: file_num2 - - ! - !data buffers - ! - INTEGER, DIMENSION(NX,NY) :: data_in, data_out - - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - filename1 = "mount1" - filename2 = "mount2" - - do i = 1,80 - fix_filename1(i:i) = " " - fix_filename2(i:i) = " " - enddo - ! - !Initialize data_in buffer - ! - do j = 1, NY - do i = 1, NX - data_in(i,j) = (i-1) + (j-1) - end do - end do - - ! - ! Fix names of the files - ! - CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) - if(error .ne. 0) stop - CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) - if(error .ne. 0) stop - - ! Test object counts - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t1, error) - CALL check(" h5tcopy_f",error,total_error) - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t2, error) - CALL check(" h5tcopy_f",error,total_error) - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t3, error) - CALL check(" h5tcopy_f",error,total_error) - CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t4, error) - CALL check(" h5tcopy_f",error,total_error) - - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) - - IF(obj_count.NE.4)THEN - total_error = total_error + 1 - ENDIF + SUBROUTINE mountingtest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error - ! - !Create first file "mount1.h5" using default properties. - ! - CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) - CALL check("h5fcreate_f",error,total_error) + ! + ! the respective filenames are "mount1.h5" and "mount2.h5" + ! + CHARACTER(LEN=6) :: filename1 + CHARACTER(LEN=6) :: filename2 + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=80) :: fix_filename2 - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + ! + ! data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 5 - IF(obj_count.NE.5)THEN - total_error = total_error + 1 - ENDIF + ! + ! File identifiers + ! + INTEGER(HID_T) :: file1_id, file2_id - CALL h5tclose_f(t1, error) - CALL check("h5tclose_f",error,total_error) - CALL h5tclose_f(t2, error) - CALL check("h5tclose_f",error,total_error) - CALL h5tclose_f(t3, error) - CALL check("h5tclose_f",error,total_error) - CALL h5tclose_f(t4, error) - CALL check("h5tclose_f",error,total_error) + ! + ! Group identifier + ! + INTEGER(HID_T) :: gid - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + ! + ! dataset identifier + ! + INTEGER(HID_T) :: dset_id - IF(obj_count.NE.1)THEN - total_error = total_error + 1 - ENDIF + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace - ! - !Create group "/G" inside file "mount1.h5". - ! - CALL h5gcreate_f(file1_id, "/G", gid, error) - CALL check("h5gcreate_f",error,total_error) - ! - !close file and group identifiers. - ! - CALL h5gclose_f(gid, error) - CALL check("h5gclose_f",error,total_error) - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !Create second file "mount2.h5" using default properties. - ! - CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Create data space for the dataset. - ! - CALL h5screate_simple_f(RANK, dims, dataspace, error) - CALL check("h5screate_simple_f",error,total_error) - - ! - !Create dataset "/D" inside file "mount2.h5". - ! - CALL h5dcreate_f(file2_id, "/D", H5T_NATIVE_INTEGER, dataspace, & - dset_id, error) - CALL check("h5dcreate_f",error,total_error) - - ! - ! Write data_in to the dataset - ! - data_dims(1) = NX - data_dims(2) = NY - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) - CALL check("h5dwrite_f",error,total_error) - - ! - !close file, dataset and dataspace identifiers. - ! - CALL h5sclose_f(dataspace, error) - CALL check("h5sclose_f",error,total_error) - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5fclose_f(file2_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !test whether files are accessible as HDF5 (new, VOL-safe, way) - ! - CALL h5fis_accessible_f(fix_filename1, status, error) - CALL check("h5fis_accessible_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename1, " is not accessible as hdf5" - stop - END IF + ! + ! data type identifier + ! + INTEGER(HID_T) :: dtype_id - CALL h5fis_accessible_f(fix_filename2, status, error) - CALL check("h5fis_accessible_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename2, " is not accessible as hdf5" - stop - END IF + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - ! - !test whether files are in hdf5 format (old way) - ! - CALL h5fis_hdf5_f(fix_filename1, status, error) - CALL check("h5fis_hdf5_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename1, " is not in hdf5 format" - stop - END IF + ! + !return value for testing whether a file is in hdf5 format + ! + LOGICAL :: status - CALL h5fis_hdf5_f(fix_filename2, status, error) - CALL check("h5fis_hdf5_f",error,total_error) - IF ( .NOT. status ) THEN - write(*,*) "File ", fix_filename2, " is not in hdf5 format" - stop - END IF + ! + !flag to check operation success + ! + INTEGER :: error - ! - !reopen both files. - ! - CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) - CALL check("hfopen_f",error,total_error) + ! + !general purpose integer + ! + INTEGER :: i, j - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + !number of objects + INTEGER(SIZE_T) :: obj_count + INTEGER(HID_T) :: t1, t2, t3, t4 - IF(obj_count.NE.1)THEN - total_error = total_error + 1 - ENDIF + ! File numbers + INTEGER :: file_num1 + INTEGER :: file_num2 - CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) - CALL check("h5fopen_f",error,total_error) + ! + !data buffers + ! + INTEGER, DIMENSION(NX,NY) :: data_in, data_out - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + filename1 = "mount1" + filename2 = "mount2" - IF(obj_count.NE.2)THEN - total_error = total_error + 1 - ENDIF + do i = 1,80 + fix_filename1(i:i) = " " + fix_filename2(i:i) = " " + enddo + ! + !Initialize data_in buffer + ! + do j = 1, NY + do i = 1, NX + data_in(i,j) = (i-1) + (j-1) + end do + end do - ! - !Check file numbers - ! - CALL h5fget_fileno_f(file1_id, file_num1, error) - CALL check("h5fget_fileno_f",error,total_error) - CALL h5fget_fileno_f(file2_id, file_num2, error) - CALL check("h5fget_fileno_f",error,total_error) - IF(file_num1 .EQ. file_num2) THEN - write(*,*) "file numbers aren't supposed to match" - END IF + ! + ! Fix names of the files + ! + CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) + if(error .ne. 0) stop + CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) + if(error .ne. 0) stop + + ! Test object counts + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t1, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t2, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t3, error) + CALL check(" h5tcopy_f",error,total_error) + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, t4, error) + CALL check(" h5tcopy_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.4)THEN + total_error = total_error + 1 + ENDIF - ! - !mount the second file under the first file's "/G" group. - ! - CALL h5fmount_f (file1_id, "/G", file2_id, error) - CALL check("h5fmount_f",error,total_error) - - - ! - !Access dataset D in the first file under /G/D name. - ! - CALL h5dopen_f(file1_id, "/G/D", dset_id, error) - CALL check("h5dopen_f",error,total_error) - - ! - !Get dataset's data type. - ! - CALL h5dget_type_f(dset_id, dtype_id, error) - CALL check("h5dget_type_f",error,total_error) - - ! - !Read the dataset. - ! - CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error) - CALL check("h5dread_f",error,total_error) - - ! - !Compare the data. - ! - do i = 1, NX - do j = 1, NY - IF (data_out(i,j) .NE. data_in(i, j)) THEN - total_error = total_error + 1 - END IF - end do - end do - - - ! - !Close dset_id and dtype_id. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - CALL h5tclose_f(dtype_id, error) - CALL check("h5tclose_f",error,total_error) - - ! - !unmount the second file. - ! - CALL h5funmount_f(file1_id, "/G", error); - CALL check("h5funmount_f",error,total_error) - - ! - !Close both files. - ! - - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) - - IF(obj_count.NE.2)THEN - total_error = total_error + 1 - ENDIF + ! + !Create first file "mount1.h5" using default properties. + ! + CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f",error,total_error) - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - CALL h5fclose_f(file2_id, error) - CALL check("h5fclose_f",error,total_error) + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) - CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) - CALL check(" h5fget_obj_count_f",error,total_error) + IF(obj_count.NE.5)THEN + total_error = total_error + 1 + ENDIF - IF(obj_count.NE.0)THEN - total_error = total_error + 1 - ENDIF + CALL h5tclose_f(t1, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t2, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t3, error) + CALL check("h5tclose_f",error,total_error) + CALL h5tclose_f(t4, error) + CALL check("h5tclose_f",error,total_error) - if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - END SUBROUTINE mountingtest + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) -! -! The following subroutine tests h5freopen_f. -! It creates the file which has name "reopen.h5" and -! the "/dset" dataset inside the file. -! writes the data to the file, close the dataset. -! Reopen the file based upon the file_id, open the -! dataset use the reopen_id then reads the -! dataset back to memory to test whether the data -! read is identical to the data written -! + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + ENDIF - SUBROUTINE reopentest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - CHARACTER(LEN=6), PARAMETER :: filename = "reopen" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: file_id, reopen_id ! File identifiers - INTEGER(HID_T) :: dset_id ! Dataset identifier - - ! - !dataset name is "dset" - ! - CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" - - ! - !data space rank and dimensions - ! - INTEGER, PARAMETER :: RANK = 2 - INTEGER, PARAMETER :: NX = 4 - INTEGER, PARAMETER :: NY = 6 - - ! - ! data space identifier - ! - INTEGER(HID_T) :: dataspace - - ! - !The dimensions for the dataset. - ! - INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) - - ! - !flag to check operation success - ! - INTEGER :: error - - ! - !general purpose integer - ! - INTEGER :: i, j - - ! - !array to store data - ! - INTEGER, DIMENSION(4,6) :: dset_data, data_out - INTEGER(HSIZE_T), DIMENSION(2) :: data_dims - INTEGER(HSIZE_T) :: file_size - INTEGER :: file_num1 - INTEGER :: file_num2 - CHARACTER(LEN=80) :: file_name - INTEGER(SIZE_T) :: name_size - - ! - !initialize the dset_data array which will be written to the "/dset" - ! - do j = 1, NY - do i = 1, NX - dset_data(i,j) = (i-1)*6 + j; - end do - end do - - ! - !Create file "reopen.h5" using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Create data space for the dataset. - ! - CALL h5screate_simple_f(RANK, dims, dataspace, error) - CALL check("h5screate_simple_f",error,total_error) - - ! - !Create dataset "/dset" inside the file . - ! - CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & - dset_id, error) - CALL check("h5dcreate_f",error,total_error) - - ! - !Write the dataset. - ! - data_dims(1) = NX - data_dims(2) = NY - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) - CALL check("h5dwrite_f",error,total_error) - - ! - !close the dataset. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - - ! - !close the dataspace. - ! - CALL h5sclose_f(dataspace, error) - CALL check("h5sclose_f",error,total_error) - - ! - !Reopen file dsetf.h5. - ! - CALL h5freopen_f(file_id, reopen_id, error) - CALL check("h5freopen_f",error,total_error) - ! - !Check file size - ! - CALL h5fget_filesize_f(file_id, file_size, error) - CALL check("h5fget_filesize_f",error,total_error) - - ! - !Check file numbers - ! - CALL h5fget_fileno_f(file_id, file_num1, error) - CALL check("h5fget_fileno_f",error,total_error) - CALL h5fget_fileno_f(reopen_id, file_num2, error) - CALL check("h5fget_fileno_f",error,total_error) - IF(file_num1 .NE. file_num2) THEN - write(*,*) "file numbers don't match" - END IF - - ! - !Open the dataset based on the reopen_id. - ! - CALL h5dopen_f(reopen_id, dsetname, dset_id, error) - CALL check("h5dopen_f",error,total_error) - ! - !Get file name from the dataset identifier - ! - CALL h5fget_name_f(dset_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(file_name(1:name_size) .NE. fix_filename(1:name_size)) THEN - write(*,*) "file name obtained from the dataset id is incorrect" - END IF - - ! - !Read the dataset. - ! - CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) - CALL check("h5dread_f",error,total_error) - - ! - !Compare the data. - ! - do i = 1, NX - do j = 1, NY - IF (data_out(i,j) .NE. dset_data(i, j)) THEN - write(*, *) "reopen test error occurred" - END IF - end do - end do - - - ! - !Close the dataset. - ! - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f",error,total_error) - - ! - !Close the file identifiers. - ! - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f",error,total_error) - CALL h5fclose_f(reopen_id, error) - CALL check("h5fclose_f",error,total_error) - - - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - - END SUBROUTINE reopentest - -! The following subroutine checks that h5fget_name_f produces -! correct output for a given obj_id and filename. -! - SUBROUTINE check_get_name(obj_id, fix_filename, len_filename, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - INTEGER(HID_T) :: obj_id ! Object identifier - CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename - INTEGER, INTENT(IN) :: len_filename ! The length of the filename - INTEGER, INTENT(INOUT) :: total_error ! Error count - - CHARACTER(LEN=80):: file_name ! Filename buffer - INTEGER:: error ! HDF5 error code - INTEGER(SIZE_T):: name_size ! Filename length - - INTEGER, PARAMETER :: sm_len = 2 - CHARACTER(LEN=len_filename) :: filename_exact - CHARACTER(LEN=len_filename-sm_len) :: filename_sm - - ! - !Get file name from the dataset identifier - ! - - ! Use an uninitialized buffer - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" + ! + !Create group "/G" inside file "mount1.h5". + ! + CALL h5gcreate_f(file1_id, "/G", gid, error) + CALL check("h5gcreate_f",error,total_error) + ! + !close file and group identifiers. + ! + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f",error,total_error) + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Create second file "mount2.h5" using default properties. + ! + CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/D" inside file "mount2.h5". + ! + CALL h5dcreate_f(file2_id, "/D", H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + ! Write data_in to the dataset + ! + data_dims(1) = NX + data_dims(2) = NY + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data_in, data_dims, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close file, dataset and dataspace identifiers. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !test whether files are accessible as HDF5 (new, VOL-safe, way) + ! + CALL h5fis_accessible_f(fix_filename1, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename1, " is not accessible as hdf5" + stop + END IF + + CALL h5fis_accessible_f(fix_filename2, status, error) + CALL check("h5fis_accessible_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename2, " is not accessible as hdf5" + stop + END IF + + ! + !test whether files are in hdf5 format (old way) + ! + CALL h5fis_hdf5_f(fix_filename1, status, error) + CALL check("h5fis_hdf5_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename1, " is not in hdf5 format" + stop + END IF + + CALL h5fis_hdf5_f(fix_filename2, status, error) + CALL check("h5fis_hdf5_f",error,total_error) + IF ( .NOT. status ) THEN + write(*,*) "File ", fix_filename2, " is not in hdf5 format" + stop + END IF + + ! + !reopen both files. + ! + CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("hfopen_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.1)THEN + total_error = total_error + 1 + ENDIF + + CALL h5fopen_f (fix_filename2, H5F_ACC_RDWR_F, file2_id, error) + CALL check("h5fopen_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.2)THEN + total_error = total_error + 1 + ENDIF + + ! + !Check file numbers + ! + CALL h5fget_fileno_f(file1_id, file_num1, error) + CALL check("h5fget_fileno_f",error,total_error) + CALL h5fget_fileno_f(file2_id, file_num2, error) + CALL check("h5fget_fileno_f",error,total_error) + IF(file_num1 .EQ. file_num2) THEN + write(*,*) "file numbers aren't supposed to match" + END IF + + ! + !mount the second file under the first file's "/G" group. + ! + CALL h5fmount_f (file1_id, "/G", file2_id, error) + CALL check("h5fmount_f",error,total_error) + + + ! + !Access dataset D in the first file under /G/D name. + ! + CALL h5dopen_f(file1_id, "/G/D", dset_id, error) + CALL check("h5dopen_f",error,total_error) + + ! + !Get dataset's data type. + ! + CALL h5dget_type_f(dset_id, dtype_id, error) + CALL check("h5dget_type_f",error,total_error) + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, dtype_id, data_out, data_dims, error) + CALL check("h5dread_f",error,total_error) + + ! + !Compare the data. + ! + do i = 1, NX + do j = 1, NY + IF (data_out(i,j) .NE. data_in(i, j)) THEN total_error = total_error + 1 END IF + end do + end do - ! Use a buffer initialized with spaces - file_name(:) = " " - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer initialized with non-whitespace characters - file_name(:) = "a" - CALL h5fget_name_f(obj_id, file_name, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. LEN_TRIM(fix_filename))THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer which is the exact size needed to hold the filename - CALL h5fget_name_f(obj_id, filename_exact, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. len_filename)THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(filename_exact .NE. TRIM(fix_filename)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - ! Use a buffer which is smaller than needed to hold the filename - CALL h5fget_name_f(obj_id, filename_sm, name_size, error) - CALL check("h5fget_name_f",error,total_error) - IF(name_size .NE. len_filename)THEN - WRITE(*,*) " file name size obtained from the object id is incorrect" - total_error = total_error + 1 - ENDIF - IF(filename_sm(1:len_filename-sm_len) .NE. fix_filename(1:len_filename-sm_len)) THEN - WRITE(*,*) " file name obtained from the object id is incorrect" - total_error = total_error + 1 - END IF - - END SUBROUTINE check_get_name - -! The following subroutine tests h5fget_name_f. -! It creates the file which has name "filename.h5" and -! tests that h5fget_name_f also returns the name "filename.h5" -! - SUBROUTINE get_name_test(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - CHARACTER(LEN=*), PARAMETER :: filename = "filename" - CHARACTER(LEN=80) :: fix_filename - INTEGER :: len_filename - - INTEGER(HID_T) :: file_id ! File identifier - INTEGER(HID_T) :: g_id ! Group identifier - - ! - ! Flag to check operation success - ! - INTEGER :: error - - ! - ! Create file "filename.h5" using default properties. - ! - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - IF (error .NE. 0) THEN - WRITE(*,*) "Cannot modify filename" - STOP - ENDIF - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - ! Create group. - ! - CALL h5gopen_f(file_id,"/",g_id, error) - CALL check("h5gopen_f",error,total_error) - - len_filename = LEN_TRIM(fix_filename) - CALL check_get_name(file_id, fix_filename, len_filename, total_error) - CALL check_get_name(g_id, fix_filename, len_filename, total_error) - - ! Close the group. - ! - CALL h5gclose_f(g_id, error) - CALL check("h5gclose_f",error,total_error) - - ! - ! Close the file identifiers. - ! - CALL h5fclose_f(file_id, error) + ! + !Close dset_id and dtype_id. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + CALL h5tclose_f(dtype_id, error) + CALL check("h5tclose_f",error,total_error) + + ! + !unmount the second file. + ! + CALL h5funmount_f(file1_id, "/G", error); + CALL check("h5funmount_f",error,total_error) + + ! + !Close both files. + ! + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.2)THEN + total_error = total_error + 1 + ENDIF + + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5fget_obj_count_f(INT(H5F_OBJ_ALL_F,HID_T), H5F_OBJ_ALL_F, obj_count, error) + CALL check(" h5fget_obj_count_f",error,total_error) + + IF(obj_count.NE.0)THEN + total_error = total_error + 1 + ENDIF + + if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + END SUBROUTINE mountingtest + + ! + ! The following subroutine tests h5freopen_f. + ! It creates the file which has name "reopen.h5" and + ! the "/dset" dataset inside the file. + ! writes the data to the file, close the dataset. + ! Reopen the file based upon the file_id, open the + ! dataset use the reopen_id then reads the + ! dataset back to memory to test whether the data + ! read is identical to the data written + ! + + SUBROUTINE reopentest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + ! + CHARACTER(LEN=6), PARAMETER :: filename = "reopen" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: file_id, reopen_id ! File identifiers + INTEGER(HID_T) :: dset_id ! Dataset identifier + + ! + !dataset name is "dset" + ! + CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" + + ! + !data space rank and dimensions + ! + INTEGER, PARAMETER :: RANK = 2 + INTEGER, PARAMETER :: NX = 4 + INTEGER, PARAMETER :: NY = 6 + + ! + ! data space identifier + ! + INTEGER(HID_T) :: dataspace + + ! + !The dimensions for the dataset. + ! + INTEGER(HSIZE_T), DIMENSION(2) :: dims = (/NX,NY/) + + ! + !flag to check operation success + ! + INTEGER :: error + + ! + !general purpose integer + ! + INTEGER :: i, j + + ! + !array to store data + ! + INTEGER, DIMENSION(4,6) :: dset_data, data_out + INTEGER(HSIZE_T), DIMENSION(2) :: data_dims + INTEGER(HSIZE_T) :: file_size + INTEGER :: file_num1 + INTEGER :: file_num2 + CHARACTER(LEN=80) :: file_name + INTEGER(SIZE_T) :: name_size + + ! + !initialize the dset_data array which will be written to the "/dset" + ! + do j = 1, NY + do i = 1, NX + dset_data(i,j) = (i-1)*6 + j; + end do + end do + + ! + !Create file "reopen.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Create data space for the dataset. + ! + CALL h5screate_simple_f(RANK, dims, dataspace, error) + CALL check("h5screate_simple_f",error,total_error) + + ! + !Create dataset "/dset" inside the file . + ! + CALL h5dcreate_f(file_id, dsetname, H5T_NATIVE_INTEGER, dataspace, & + dset_id, error) + CALL check("h5dcreate_f",error,total_error) + + ! + !Write the dataset. + ! + data_dims(1) = NX + data_dims(2) = NY + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, dset_data, data_dims, error) + CALL check("h5dwrite_f",error,total_error) + + ! + !close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !close the dataspace. + ! + CALL h5sclose_f(dataspace, error) + CALL check("h5sclose_f",error,total_error) + + ! + !Reopen file dsetf.h5. + ! + CALL h5freopen_f(file_id, reopen_id, error) + CALL check("h5freopen_f",error,total_error) + ! + !Check file size + ! + CALL h5fget_filesize_f(file_id, file_size, error) + CALL check("h5fget_filesize_f",error,total_error) + + ! + !Check file numbers + ! + CALL h5fget_fileno_f(file_id, file_num1, error) + CALL check("h5fget_fileno_f",error,total_error) + CALL h5fget_fileno_f(reopen_id, file_num2, error) + CALL check("h5fget_fileno_f",error,total_error) + IF(file_num1 .NE. file_num2) THEN + write(*,*) "file numbers don't match" + END IF + + ! + !Open the dataset based on the reopen_id. + ! + CALL h5dopen_f(reopen_id, dsetname, dset_id, error) + CALL check("h5dopen_f",error,total_error) + ! + !Get file name from the dataset identifier + ! + CALL h5fget_name_f(dset_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(file_name(1:name_size) .NE. fix_filename(1:name_size)) THEN + write(*,*) "file name obtained from the dataset id is incorrect" + END IF + + ! + !Read the dataset. + ! + CALL h5dread_f(dset_id, H5T_NATIVE_INTEGER, data_out, data_dims, error) + CALL check("h5dread_f",error,total_error) + + ! + !Compare the data. + ! + do i = 1, NX + do j = 1, NY + IF (data_out(i,j) .NE. dset_data(i, j)) THEN + write(*, *) "reopen test error occurred" + END IF + end do + end do + + + ! + !Close the dataset. + ! + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f",error,total_error) + + ! + !Close the file identifiers. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + CALL h5fclose_f(reopen_id, error) + CALL check("h5fclose_f",error,total_error) + + + if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + + END SUBROUTINE reopentest + + ! The following subroutine checks that h5fget_name_f produces + ! correct output for a given obj_id and filename. + ! + SUBROUTINE check_get_name(obj_id, fix_filename, len_filename, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + INTEGER(HID_T) :: obj_id ! Object identifier + CHARACTER(LEN=80), INTENT(IN) :: fix_filename ! Expected filename + INTEGER, INTENT(IN) :: len_filename ! The length of the filename + INTEGER, INTENT(INOUT) :: total_error ! Error count + + CHARACTER(LEN=80):: file_name ! Filename buffer + INTEGER:: error ! HDF5 error code + INTEGER(SIZE_T):: name_size ! Filename length + + INTEGER, PARAMETER :: sm_len = 2 + CHARACTER(LEN=len_filename) :: filename_exact + CHARACTER(LEN=len_filename-sm_len) :: filename_sm + + ! + !Get file name from the dataset identifier + ! + + ! Use an uninitialized buffer + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer initialized with spaces + file_name(:) = " " + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer initialized with non-whitespace characters + file_name(:) = "a" + CALL h5fget_name_f(obj_id, file_name, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. LEN_TRIM(fix_filename))THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(file_name(1:name_size) .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer which is the exact size needed to hold the filename + CALL h5fget_name_f(obj_id, filename_exact, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. len_filename)THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(filename_exact .NE. TRIM(fix_filename)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + ! Use a buffer which is smaller than needed to hold the filename + CALL h5fget_name_f(obj_id, filename_sm, name_size, error) + CALL check("h5fget_name_f",error,total_error) + IF(name_size .NE. len_filename)THEN + WRITE(*,*) " file name size obtained from the object id is incorrect" + total_error = total_error + 1 + ENDIF + IF(filename_sm(1:len_filename-sm_len) .NE. fix_filename(1:len_filename-sm_len)) THEN + WRITE(*,*) " file name obtained from the object id is incorrect" + total_error = total_error + 1 + END IF + + END SUBROUTINE check_get_name + + ! The following subroutine tests h5fget_name_f. + ! It creates the file which has name "filename.h5" and + ! tests that h5fget_name_f also returns the name "filename.h5" + ! + + SUBROUTINE get_name_test(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + CHARACTER(LEN=*), PARAMETER :: filename = "filename" + CHARACTER(LEN=80) :: fix_filename + INTEGER :: len_filename + + INTEGER(HID_T) :: file_id ! File identifier + INTEGER(HID_T) :: g_id ! Group identifier + + ! + ! Flag to check operation success + ! + INTEGER :: error + + ! + ! Create file "filename.h5" using default properties. + ! + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + IF (error .NE. 0) THEN + WRITE(*,*) "Cannot modify filename" + STOP + ENDIF + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + ! Create group. + ! + CALL h5gopen_f(file_id,"/",g_id, error) + CALL check("h5gopen_f",error,total_error) + + len_filename = LEN_TRIM(fix_filename) + CALL check_get_name(file_id, fix_filename, len_filename, total_error) + CALL check_get_name(g_id, fix_filename, len_filename, total_error) + + ! Close the group. + ! + CALL h5gclose_f(g_id, error) + CALL check("h5gclose_f",error,total_error) + + ! + ! Close the file identifiers. + ! + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error,total_error) + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + + END SUBROUTINE get_name_test + + + ! + ! The following example demonstrates how to get creation property list, + ! and access property list. + ! We first create a file using the default creation and access property + ! list. Then, the file was closed and reopened. We then get the + ! creation and access property lists of the first file. The second file is + ! created using the got property lists + + SUBROUTINE plisttest(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + + ! + !file names are "plist1.h5" and "plist2.h5" + ! + CHARACTER(LEN=6), PARAMETER :: filename1 = "plist1" + CHARACTER(LEN=80) :: fix_filename1 + CHARACTER(LEN=6), PARAMETER :: filename2 = "plist2" + CHARACTER(LEN=80) :: fix_filename2 + + INTEGER(HID_T) :: file1_id, file2_id ! File identifiers + INTEGER(HID_T) :: prop_id ! File creation property list identifier + INTEGER(HID_T) :: access_id ! File Access property list identifier + + !flag to check operation success + INTEGER :: error + + ! + !Create a file1 using default properties. + ! + CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify file name" + stop + endif + CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) + CALL check("h5fcreate_f",error,total_error) + + ! + !Terminate access to the file. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + ! + !Open an existing file. + ! + CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) + CALL check("h5fopen_f",error,total_error) + + ! + !get the creation property list. + ! + CALL h5fget_create_plist_f(file1_id, prop_id, error) + CALL check("h5fget_create_plist_f",error,total_error) + + ! + !get the access property list. + ! + CALL h5fget_access_plist_f(file1_id, access_id, error) + CALL check("h5fget_access_plist_f",error,total_error) + + ! + !based on the creation property list id and access property list id + !create a new file + ! + CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify file name" + stop + endif + CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error, & + prop_id, access_id) + CALL check("h5create_f",error,total_error) + + ! + !Close all the property lists. + ! + CALL h5pclose_f(prop_id, error) + CALL check("h5pclose_f",error,total_error) + CALL h5pclose_f(access_id, error) + CALL check("h5pclose_f",error,total_error) + + ! + !Terminate access to the files. + ! + CALL h5fclose_f(file1_id, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5fclose_f(file2_id, error) + CALL check("h5fclose_f",error,total_error) + + if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN + + END SUBROUTINE plisttest + + + ! + ! The following subroutine tests h5pget(set)_fclose_degree_f + ! + + SUBROUTINE file_close(cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + + ! + CHARACTER(LEN=10), PARAMETER :: filename = "file_close" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers + INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers + INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers + LOGICAL :: flag + INTEGER(SIZE_T) :: obj_count, obj_countf + INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids + INTEGER(SIZE_T) :: i + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error) + CALL check("h5pcreate_f",error,total_error) + CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error) + CALL check("h5pset_fclose_degree_f",error,total_error) + + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1) + CALL check("h5fopen_f",error,total_error) + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl) + CALL check("h5fopen_f",error,total_error) + CALL h5fget_access_plist_f(fid1, fid1_fapl, error) + CALL check("h5fget_access_plist_f",error,total_error) + CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error) + CALL check("h5fget_access_plist_f",error,total_error) + + CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error) + CALL check("h5pequal_f",error,total_error) + if (.NOT. flag) then + write(*,*) " File access lists should be equal, error " + total_error=total_error + 1 + endif + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) + if( error .ne. -1) then + total_error = total_error + 1 + write(*,*) " Open with H5F_CLOSE_SEMI should fail " + endif + CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3) + if( error .ne. -1) then + total_error = total_error + 1 + write(*,*) " Open with H5F_CLOSE_STRONG should fail " + endif + + CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error) + CALL check("h5fget_obj_count_f",error,total_error) + if(error .eq.0 .and. obj_count .ne. 3) then + total_error = total_error + 1 + write(*,*) "Wrong number of open objects reported, error" + endif + CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error) + CALL check("h5fget_obj_count_f",error,total_error) + if(error .eq.0 .and. obj_countf .ne. 3) then + total_error = total_error + 1 + write(*,*) "Wrong number of open objects reported, error" + endif + allocate(obj_ids(obj_countf), stat = error) + CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_countf, obj_ids, error) + CALL check("h5fget_obj_ids_f",error,total_error) + if(error .eq. 0) then + do i = 1, obj_countf + CALL h5fclose_f(obj_ids(i), error) CALL check("h5fclose_f",error,total_error) + enddo + endif + + CALL h5fclose_f(fid, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + CALL h5fclose_f(fid1, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + CALL h5fclose_f(fid_d, error) + if(error .eq. 0) then + total_error = total_error + 1 + write(*,*) "File should be closed at this point, error" + endif + + if(cleanup) then + CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + endif + deallocate(obj_ids) + RETURN - IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN + END SUBROUTINE file_close - END SUBROUTINE get_name_test + ! + ! The following subroutine tests h5fget_freespace_f + ! + SUBROUTINE file_space(filename, cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + CHARACTER(*), INTENT(IN) :: filename + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + ! + CHARACTER(LEN=3), PARAMETER :: grpname = "grp" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid ! File identifiers + INTEGER(HSSIZE_T) :: free_space + INTEGER(HID_T) :: group_id ! Group identifier + + INTEGER(HID_T) :: fcpl + INTEGER(HSIZE_T), PARAMETER :: set_usrblck_size = 512 + INTEGER(HSIZE_T) :: usrblck_size + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + + CALL h5pcreate_f(H5P_FILE_CREATE_F, fcpl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL H5Pset_userblock_f(fcpl, set_usrblck_size, error ) + CALL check("h5pset_userblock_f", error, total_error) + + CALL H5Pget_userblock_f(fcpl, usrblck_size, error ) + CALL check("h5pget_userblock_f", error, total_error) + + IF(usrblck_size .NE. set_usrblck_size) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong size of a user block, ", usrblck_size + ENDIF + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, creation_prp=fcpl ) + CALL check("h5fcreate_f",error,total_error) + + CALL h5pclose_f(fcpl, error) + CALL check("H5Pclose_f", error, total_error) + + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 1248) THEN + total_error = total_error + 1 + WRITE(*,*) "1: Wrong amount of free space reported, ", free_space + ENDIF + + ! Create group in the file. + CALL h5gcreate_f(fid, grpname, group_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! Close group + CALL h5gclose_f(group_id, error) + CALL check("h5gclose_f", error, total_error) + + ! Check the free space now + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 216) THEN + total_error = total_error + 1 + WRITE(*,*) "2: Wrong amount of free space reported, ", free_space + ENDIF + + !Unlink the group + CALL h5gunlink_f(fid, grpname, error) + CALL check("h5gunlink_f", error, total_error) + + ! Check the free space now + CALL h5fget_freespace_f(fid, free_space, error) + CALL check("h5fget_freespace_f",error,total_error) + IF(error .EQ.0 .AND. free_space .NE. 1248) THEN + total_error = total_error + 1 + WRITE(*,*) "3: Wrong amount of free space reported, ", free_space + ENDIF + + IF(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN -! -! The following example demonstrates how to get creation property list, -! and access property list. -! We first create a file using the default creation and access property -! list. Then, the file was closed and reopened. We then get the -! creation and access property lists of the first file. The second file is -! created using the got property lists - - SUBROUTINE plisttest(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - - ! - !file names are "plist1.h5" and "plist2.h5" - ! - CHARACTER(LEN=6), PARAMETER :: filename1 = "plist1" - CHARACTER(LEN=80) :: fix_filename1 - CHARACTER(LEN=6), PARAMETER :: filename2 = "plist2" - CHARACTER(LEN=80) :: fix_filename2 - - INTEGER(HID_T) :: file1_id, file2_id ! File identifiers - INTEGER(HID_T) :: prop_id ! File creation property list identifier - INTEGER(HID_T) :: access_id ! File Access property list identifier - - !flag to check operation success - INTEGER :: error - - ! - !Create a file1 using default properties. - ! - CALL h5_fixname_f(filename1, fix_filename1, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif - CALL h5fcreate_f(fix_filename1, H5F_ACC_TRUNC_F, file1_id, error) - CALL check("h5fcreate_f",error,total_error) - - ! - !Terminate access to the file. - ! - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - ! - !Open an existing file. - ! - CALL h5fopen_f (fix_filename1, H5F_ACC_RDWR_F, file1_id, error) - CALL check("h5fopen_f",error,total_error) - - ! - !get the creation property list. - ! - CALL h5fget_create_plist_f(file1_id, prop_id, error) - CALL check("h5fget_create_plist_f",error,total_error) - - ! - !get the access property list. - ! - CALL h5fget_access_plist_f(file1_id, access_id, error) - CALL check("h5fget_access_plist_f",error,total_error) - - ! - !based on the creation property list id and access property list id - !create a new file - ! - CALL h5_fixname_f(filename2, fix_filename2, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify file name" - stop - endif - CALL h5fcreate_f(fix_filename2, H5F_ACC_TRUNC_F, file2_id, error, & - prop_id, access_id) - CALL check("h5create_f",error,total_error) - - ! - !Close all the property lists. - ! - CALL h5pclose_f(prop_id, error) - CALL check("h5pclose_f",error,total_error) - CALL h5pclose_f(access_id, error) - CALL check("h5pclose_f",error,total_error) - - ! - !Terminate access to the files. - ! - CALL h5fclose_f(file1_id, error) - CALL check("h5fclose_f",error,total_error) - - CALL h5fclose_f(file2_id, error) - CALL check("h5fclose_f",error,total_error) - - if(cleanup) CALL h5_cleanup_f(filename1, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - if(cleanup) CALL h5_cleanup_f(filename2, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - - END SUBROUTINE plisttest + END SUBROUTINE file_space + ! + ! The following subroutine tests h5fget_info_f + ! -! -! The following subroutine tests h5pget(set)_fclose_degree_f -! + SUBROUTINE test_file_info(filename, cleanup, total_error) + USE HDF5 ! This module contains all necessary modules + USE TH5_MISC + IMPLICIT NONE + CHARACTER(*), INTENT(IN) :: filename + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER :: error + ! + CHARACTER(LEN=3), PARAMETER :: grpname = "grp" + CHARACTER(LEN=80) :: fix_filename + + INTEGER(HID_T) :: fid ! File identifiers + INTEGER(HID_T) :: group_id ! Group identifier + + TYPE(H5F_INFO_T) :: file_info + INTEGER(HID_T) :: fapl, fcpl + INTEGER :: strategy + LOGICAL :: persist + INTEGER(HSIZE_T) :: threshold, fsp_size + + CALL h5eset_auto_f(0, error) + + CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) + if (error .ne. 0) then + write(*,*) "Cannot modify filename" + stop + endif + + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL h5pcreate_f(H5P_FILE_CREATE_F, fcpl, error) + CALL check("h5pcreate_f",error, total_error) + + CALL h5pset_libver_bounds_f(fapl, H5F_LIBVER_V114_F, H5F_LIBVER_V114_F, error) + CALL check("h5pset_libver_bounds_f",error, total_error) + CALL h5pset_file_space_strategy_f(fcpl, H5F_FSPACE_STRATEGY_PAGE_F, .TRUE., 4_HSIZE_T, error) + CALL check("h5pset_file_space_strategy_f",error, total_error) + + CALL h5pget_file_space_strategy_f(fcpl, strategy, persist, threshold, error) + CALL check("h5pget_file_space_strategy_f",error, total_error) + + IF(strategy .NE. H5F_FSPACE_STRATEGY_PAGE_F) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong strategy, ",strategy + ENDIF + IF(persist .NEQV. .TRUE.) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong persist, ",persist + ENDIF + IF(threshold .NE. 4_HSIZE_T) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_strategy_f: wrong threshold, ",threshold + ENDIF + + CALL h5pset_file_space_page_size_f(fcpl, 512_HSIZE_T, error) + CALL check("H5Pset_file_space_page_size_f",error, total_error) + + CALL h5pget_file_space_page_size_f(fcpl, fsp_size, error) + CALL check("H5Pset_file_space_page_size_f",error, total_error) + + IF(fsp_size .NE. 512_HSIZE_T) THEN + total_error = total_error + 1 + WRITE(*,*) "h5pget_file_space_page_size_f: wrong size, ",fsp_size + ENDIF + + CALL h5pset_alignment_f(fapl, 1_HSIZE_T, 1024_HSIZE_T, error) + CALL check("h5pset_alignment_f",error, total_error) + + CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error, access_prp=fapl, creation_prp=fcpl) + CALL check("h5fcreate_f",error,total_error) + + ! Create group in the file. + CALL h5gcreate_f(fid, grpname, group_id, error) + CALL check("h5gcreate_f",error,total_error) + + ! Close group + CALL h5gclose_f(group_id, error) + CALL check("h5gclose_f", error, total_error) + + !Unlink the group + CALL h5gunlink_f(fid, grpname, error) + CALL check("h5gunlink_f", error, total_error) + + ! Check H5Fget_info_f + CALL h5fget_info_f(fid, file_info, error) + CALL check("h5fget_info_f", error, total_error) + + IF(file_info%super%version .NE. 3) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%version, ",file_info%free%tot_space + ENDIF + + IF(file_info%super%super_size .NE. 48) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%super_size, ",file_info%free%tot_space + ENDIF + + IF(file_info%super%super_ext_size .NE. 156) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong super%super_ext_size, ",file_info%super%super_ext_size + ENDIF + + IF(file_info%free%version .NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong free%version, ",file_info%free%version + ENDIF + + IF(file_info%free%tot_space .NE. 161) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong free%tot_space, ",file_info%free%tot_space + ENDIF + + IF(file_info%sohm%version.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%version ",file_info%sohm%version + ENDIF + + IF(file_info%sohm%hdr_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%hdr_size ",file_info%sohm%hdr_size + ENDIF + + IF(file_info%sohm%msgs_info%heap_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%msgs_info%heap_size ",file_info%sohm%msgs_info%heap_size + ENDIF + + IF(file_info%sohm%msgs_info%index_size.NE. 0) THEN + total_error = total_error + 1 + WRITE(*,*) "Wrong sohm%msgs_info%heap_size ",file_info%sohm%msgs_info%index_size + ENDIF + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f",error,total_error) + + CALL h5pclose_f(fapl, error) + CALL check("H5Pclose_f", error, total_error) + CALL h5pclose_f(fcpl, error) + CALL check("H5Pclose_f", error, total_error) + + if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + RETURN - SUBROUTINE file_close(cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER :: error - - ! - CHARACTER(LEN=10), PARAMETER :: filename = "file_close" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: fid, fid_d, fid1, fid2, fid3 ! File identifiers - INTEGER(HID_T) :: fapl, fapl1, fapl2, fapl3 ! File access identifiers - INTEGER(HID_T) :: fid_d_fapl, fid1_fapl ! File access identifiers - LOGICAL :: flag - INTEGER(SIZE_T) :: obj_count, obj_countf - INTEGER(HID_T), ALLOCATABLE, DIMENSION(:) :: obj_ids - INTEGER(SIZE_T) :: i - - CALL h5eset_auto_f(0, error) - - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) - CALL check("h5fcreate_f",error,total_error) - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl, H5F_CLOSE_DEFAULT_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl1, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl1, H5F_CLOSE_WEAK_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl2, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl2, H5F_CLOSE_SEMI_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl3, error) - CALL check("h5pcreate_f",error,total_error) - CALL h5pset_fclose_degree_f(fapl3, H5F_CLOSE_STRONG_F, error) - CALL check("h5pset_fclose_degree_f",error,total_error) - - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid1, error, access_prp=fapl1) - CALL check("h5fopen_f",error,total_error) - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid_d, error, access_prp=fapl) - CALL check("h5fopen_f",error,total_error) - CALL h5fget_access_plist_f(fid1, fid1_fapl, error) - CALL check("h5fget_access_plist_f",error,total_error) - CALL h5fget_access_plist_f(fid_d, fid_d_fapl, error) - CALL check("h5fget_access_plist_f",error,total_error) - - CALL h5pequal_f(fid_d_fapl, fid1_fapl, flag, error) - CALL check("h5pequal_f",error,total_error) - if (.NOT. flag) then - write(*,*) " File access lists should be equal, error " - total_error=total_error + 1 - endif - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid2, error, access_prp=fapl2) - if( error .ne. -1) then - total_error = total_error + 1 - write(*,*) " Open with H5F_CLOSE_SEMI should fail " - endif - CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, fid3, error, access_prp=fapl3) - if( error .ne. -1) then - total_error = total_error + 1 - write(*,*) " Open with H5F_CLOSE_STRONG should fail " - endif - - CALL h5fget_obj_count_f(fid1, H5F_OBJ_ALL_F, obj_count, error) - CALL check("h5fget_obj_count_f",error,total_error) - if(error .eq.0 .and. obj_count .ne. 3) then - total_error = total_error + 1 - write(*,*) "Wrong number of open objects reported, error" - endif - CALL h5fget_obj_count_f(fid1, H5F_OBJ_FILE_F, obj_countf, error) - CALL check("h5fget_obj_count_f",error,total_error) - if(error .eq.0 .and. obj_countf .ne. 3) then - total_error = total_error + 1 - write(*,*) "Wrong number of open objects reported, error" - endif - allocate(obj_ids(obj_countf), stat = error) - CALL h5fget_obj_ids_f(fid, H5F_OBJ_FILE_F, obj_countf, obj_ids, error) - CALL check("h5fget_obj_ids_f",error,total_error) - if(error .eq. 0) then - do i = 1, obj_countf - CALL h5fclose_f(obj_ids(i), error) - CALL check("h5fclose_f",error,total_error) - enddo - endif - - CALL h5fclose_f(fid, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - CALL h5fclose_f(fid1, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - CALL h5fclose_f(fid_d, error) - if(error .eq. 0) then - total_error = total_error + 1 - write(*,*) "File should be closed at this point, error" - endif - - if(cleanup) then - CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - endif - deallocate(obj_ids) - RETURN - - END SUBROUTINE file_close + END SUBROUTINE test_file_info -! -! The following subroutine tests h5fget_freespace_f -! + SUBROUTINE test_get_file_image(total_error) + ! + ! Tests the wrapper for h5fget_file_image + ! + IMPLICIT NONE + + INTEGER, INTENT(INOUT) :: total_error ! returns error + + CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: file_image_ptr ! Image from file + CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: image_ptr ! Image from h5fget_file_image_f + + INTEGER, DIMENSION(1:100), TARGET :: data ! Write data + INTEGER :: file_sz + INTEGER(size_t) :: i + INTEGER(hid_t) :: file_id = -1 ! File identifier + INTEGER(hid_t) :: dset_id = -1 ! Dataset identifier + INTEGER(hid_t) :: space_id = -1 ! Dataspace identifier + INTEGER(hsize_t), DIMENSION(1:2) :: dims ! Dataset dimensions + INTEGER(size_t) :: itmp_a ! General purpose integer + INTEGER(size_t) :: image_size ! Size of image + TYPE(C_PTR) :: f_ptr ! Pointer + INTEGER(hid_t) :: fapl ! File access property + INTEGER :: error ! Error flag + + ! Create new properties for file access + CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + + ! Set standard I/O driver + CALL h5pset_fapl_stdio_f(fapl, error) + CALL check("h5pset_fapl_stdio_f", error, total_error) + + ! Create the file + CALL h5fcreate_f("tget_file_image.h5", H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f", error, total_error) + + ! Set up data space for new data set + dims(1:2) = (/10,10/) + + CALL h5screate_simple_f(2, dims, space_id, error) + CALL check("h5screate_simple_f", error, total_error) + + ! Create a dataset + CALL h5dcreate_f(file_id, "dset 0", H5T_NATIVE_INTEGER, space_id, dset_id, error) + CALL check("h5dcreate_f", error, total_error) + + ! Write some data to the data set + DO i = 1, 100 + data(i) = INT(i) + ENDDO + + f_ptr = C_LOC(data(1)) + CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error) + CALL check("h5dwrite_f",error, total_error) + + ! Flush the file + CALL h5fflush_f(file_id, H5F_SCOPE_GLOBAL_F, error) + CALL check("h5fflush_f",error, total_error) + + ! Open the test file using standard I/O calls + OPEN(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') + ! Get the size of the test file + ! + ! Since we use the eoa to calculate the image size, the file size + ! may be larger. This is OK, as long as (in this specialized instance) + ! the remainder of the file is all '\0's. + ! + ! With latest mods to truncate call in core file drive, + ! file size should match image size; get the file size + INQUIRE(UNIT=10, SIZE=file_sz) + CLOSE(UNIT=10) + + ! I. Get buffer size needed to hold the buffer + + ! A. Preferred way to get the size + f_ptr = C_NULL_PTR + CALL h5fget_file_image_f(file_id, f_ptr, INT(0, size_t), error, image_size) + CALL check("h5fget_file_image_f",error, total_error) + CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) + + ! B. f_ptr set to point to an incorrect buffer, should pass anyway + f_ptr = C_LOC(data(1)) + itmp_a = 1 + CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size) + CALL check("h5fget_file_image_f",error, total_error) + CALL verify("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value + CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) + + ! Allocate a buffer of the appropriate size + ALLOCATE(image_ptr(1:image_size)) + + ! Load the image of the file into the buffer + f_ptr = C_LOC(image_ptr(1)(1:1)) + CALL h5fget_file_image_f(file_id, f_ptr, image_size, error) + CALL check("h5fget_file_image_f",error, total_error) + + ! Close dset and space + CALL h5dclose_f(dset_id, error) + CALL check("h5dclose_f", error, total_error) + CALL h5sclose_f(space_id, error) + CALL check("h5sclose_f", error, total_error) + ! Close the test file + CALL h5fclose_f(file_id, error) + CALL check("h5fclose_f",error, total_error) + + ! Allocate a buffer for the test file image + ALLOCATE(file_image_ptr(1:image_size)) + + ! Open the test file using standard I/O calls + OPEN(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') + + ! Read the test file from disk into the buffer + DO i = 1, image_size + READ(10) file_image_ptr(i) + ENDDO + + CLOSE(10) + + ! verify the file and the image contain the same data + DO i = 1, image_size + ! convert one byte to an unsigned integer + IF( ICHAR(file_image_ptr(i)) .NE. ICHAR(image_ptr(i)))THEN + total_error = total_error + 1 + EXIT + ENDIF + ENDDO + + ! release resources + DEALLOCATE(file_image_ptr,image_ptr) - SUBROUTINE file_space(filename, cleanup, total_error) - USE HDF5 ! This module contains all necessary modules - USE TH5_MISC - IMPLICIT NONE - CHARACTER(*), INTENT(IN) :: filename - LOGICAL, INTENT(IN) :: cleanup - INTEGER, INTENT(INOUT) :: total_error - INTEGER :: error - ! - CHARACTER(LEN=3), PARAMETER :: grpname = "grp" - CHARACTER(LEN=80) :: fix_filename - - INTEGER(HID_T) :: fid ! File identifiers - INTEGER(HSSIZE_T) :: free_space - INTEGER(HID_T) :: group_id ! Group identifier - - CALL h5eset_auto_f(0, error) - - CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error) - if (error .ne. 0) then - write(*,*) "Cannot modify filename" - stop - endif - CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, fid, error) - CALL check("h5fcreate_f",error,total_error) - - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 1248) then - total_error = total_error + 1 - write(*,*) "1: Wrong amount of free space reported, ", free_space - endif - - ! Create group in the file. - CALL h5gcreate_f(fid, grpname, group_id, error) - CALL check("h5gcreate_f",error,total_error) - - ! Close group - CALL h5gclose_f(group_id, error) - CALL check("h5gclose_f", error, total_error) - - ! Check the free space now - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 216) then - total_error = total_error + 1 - write(*,*) "2: Wrong amount of free space reported, ", free_space - endif - - !Unlink the group - CALL h5gunlink_f(fid, grpname, error) - CALL check("h5gunlink_f", error, total_error) - - ! Check the free space now - CALL h5fget_freespace_f(fid, free_space, error) - CALL check("h5fget_freespace_f",error,total_error) - if(error .eq.0 .and. free_space .ne. 1248) then - total_error = total_error + 1 - write(*,*) "3: Wrong amount of free space reported, ", free_space - endif - - CALL h5fclose_f(fid, error) - CALL check("h5fclose_f",error,total_error) - - if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error) - CALL check("h5_cleanup_f", error, total_error) - RETURN - - END SUBROUTINE file_space + END SUBROUTINE test_get_file_image END MODULE TH5F diff --git a/fortran/test/tH5F_F03.F90 b/fortran/test/tH5F_F03.F90 deleted file mode 100644 index 27bd30e..0000000 --- a/fortran/test/tH5F_F03.F90 +++ /dev/null @@ -1,177 +0,0 @@ -!****h* root/fortran/test/tH5F_F03 -! -! NAME -! tH5F_F03.F90 -! -! FUNCTION -! Test FORTRAN HDF5 H5F APIs which are dependent on FORTRAN 2003 -! features. -! -! COPYRIGHT -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! Copyright by The HDF Group. * -! All rights reserved. * -! * -! This file is part of HDF5. The full HDF5 copyright notice, including * -! terms governing use, modification, and redistribution, is contained in * -! the COPYING file, which can be found at the root of the source code * -! distribution tree, or in https://www.hdfgroup.org/licenses. * -! If you do not have access to either file, you may request a copy from * -! help@hdfgroup.org. * -! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -! -! NOTES -! Tests the H5F APIs functionalities of: -! h5fget_file_image_f -! -! CONTAINS SUBROUTINES -! test_get_file_image -! -!***** - -! ***************************************** -! *** H 5 F T E S T S -! ***************************************** - -MODULE TH5F_F03 - - USE HDF5 - USE TH5_MISC - USE TH5_MISC_GEN - USE ISO_C_BINDING - -CONTAINS - -SUBROUTINE test_get_file_image(total_error) - ! - ! Tests the wrapper for h5fget_file_image - ! - IMPLICIT NONE - - INTEGER, INTENT(INOUT) :: total_error ! returns error - - CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: file_image_ptr ! Image from file - CHARACTER(kind=c_char), ALLOCATABLE, DIMENSION(:), TARGET :: image_ptr ! Image from h5fget_file_image_f - - INTEGER, DIMENSION(1:100), TARGET :: data ! Write data - INTEGER :: file_sz - INTEGER(size_t) :: i - INTEGER(hid_t) :: file_id = -1 ! File identifier - INTEGER(hid_t) :: dset_id = -1 ! Dataset identifier - INTEGER(hid_t) :: space_id = -1 ! Dataspace identifier - INTEGER(hsize_t), DIMENSION(1:2) :: dims ! Dataset dimensions - INTEGER(size_t) :: itmp_a ! General purpose integer - INTEGER(size_t) :: image_size ! Size of image - TYPE(C_PTR) :: f_ptr ! Pointer - INTEGER(hid_t) :: fapl ! File access property - INTEGER :: error ! Error flag - - ! Create new properties for file access - CALL h5pcreate_f(H5P_FILE_ACCESS_F, fapl, error) - CALL check("h5pcreate_f", error, total_error) - - ! Set standard I/O driver - CALL h5pset_fapl_stdio_f(fapl, error) - CALL check("h5pset_fapl_stdio_f", error, total_error) - - ! Create the file - CALL h5fcreate_f("tget_file_image.h5", H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl) - CALL check("h5fcreate_f", error, total_error) - - ! Set up data space for new data set - dims(1:2) = (/10,10/) - - CALL h5screate_simple_f(2, dims, space_id, error) - CALL check("h5screate_simple_f", error, total_error) - - ! Create a dataset - CALL h5dcreate_f(file_id, "dset 0", H5T_NATIVE_INTEGER, space_id, dset_id, error) - CALL check("h5dcreate_f", error, total_error) - - ! Write some data to the data set - DO i = 1, 100 - data(i) = INT(i) - ENDDO - - f_ptr = C_LOC(data(1)) - CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, f_ptr, error) - CALL check("h5dwrite_f",error, total_error) - - ! Flush the file - CALL h5fflush_f(file_id, H5F_SCOPE_GLOBAL_F, error) - CALL check("h5fflush_f",error, total_error) - - ! Open the test file using standard I/O calls - OPEN(UNIT=10,FILE='tget_file_image.h5', ACCESS='STREAM') - ! Get the size of the test file - ! - ! Since we use the eoa to calculate the image size, the file size - ! may be larger. This is OK, as long as (in this specialized instance) - ! the remainder of the file is all '\0's. - ! - ! With latest mods to truncate call in core file drive, - ! file size should match image size; get the file size - INQUIRE(UNIT=10, SIZE=file_sz) - CLOSE(UNIT=10) - - ! I. Get buffer size needed to hold the buffer - - ! A. Preferred way to get the size - f_ptr = C_NULL_PTR - CALL h5fget_file_image_f(file_id, f_ptr, INT(0, size_t), error, image_size) - CALL check("h5fget_file_image_f",error, total_error) - CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) - - ! B. f_ptr set to point to an incorrect buffer, should pass anyway - f_ptr = C_LOC(data(1)) - itmp_a = 1 - CALL h5fget_file_image_f(file_id, f_ptr, itmp_a, error, image_size) - CALL check("h5fget_file_image_f",error, total_error) - CALL verify("h5fget_file_image_f", INT(itmp_a), 1, total_error) ! Routine should not change the value - CALL verify("h5fget_file_image_f", file_sz, INT(image_size), total_error) - - ! Allocate a buffer of the appropriate size - ALLOCATE(image_ptr(1:image_size)) - - ! Load the image of the file into the buffer - f_ptr = C_LOC(image_ptr(1)(1:1)) - CALL h5fget_file_image_f(file_id, f_ptr, image_size, error) - CALL check("h5fget_file_image_f",error, total_error) - - ! Close dset and space - CALL h5dclose_f(dset_id, error) - CALL check("h5dclose_f", error, total_error) - CALL h5sclose_f(space_id, error) - CALL check("h5sclose_f", error, total_error) - ! Close the test file - CALL h5fclose_f(file_id, error) - CALL check("h5fclose_f",error, total_error) - - ! Allocate a buffer for the test file image - ALLOCATE(file_image_ptr(1:image_size)) - - ! Open the test file using standard I/O calls - OPEN(UNIT=10,FILE='tget_file_image.h5', FORM='UNFORMATTED', ACCESS='STREAM') - - ! Read the test file from disk into the buffer - DO i = 1, image_size - READ(10) file_image_ptr(i) - ENDDO - - CLOSE(10) - - ! verify the file and the image contain the same data - DO i = 1, image_size - ! convert one byte to an unsigned integer - IF( ICHAR(file_image_ptr(i)) .NE. ICHAR(image_ptr(i)))THEN - total_error = total_error + 1 - EXIT - ENDIF - ENDDO - - ! release resources - DEALLOCATE(file_image_ptr,image_ptr) - -END SUBROUTINE test_get_file_image - -END MODULE TH5F_F03 diff --git a/fortran/test/tH5L_F03.F90 b/fortran/test/tH5L_F03.F90 index e09ad5e..a8345c3 100644 --- a/fortran/test/tH5L_F03.F90 +++ b/fortran/test/tH5L_F03.F90 @@ -27,11 +27,21 @@ ! test_iter_group ! !***** + +MODULE EXTENTS + + IMPLICIT NONE + + INTEGER, PARAMETER :: MAX_CHAR_LEN = 30 + +END MODULE EXTENTS + MODULE liter_cb_mod USE HDF5 USE TH5_MISC USE TH5_MISC_GEN + USE EXTENTS USE, INTRINSIC :: ISO_C_BINDING IMPLICIT NONE @@ -44,7 +54,7 @@ MODULE liter_cb_mod ! Custom group iteration callback data TYPE, bind(c) :: iter_info - CHARACTER(KIND=C_CHAR), DIMENSION(1:10) :: name ! The name of the object + CHARACTER(KIND=C_CHAR), DIMENSION(1:MAX_CHAR_LEN) :: name ! The name of the object INTEGER(c_int) :: TYPE ! The TYPE of the object INTEGER(c_int) :: command ! The TYPE of RETURN value END TYPE iter_info @@ -62,7 +72,7 @@ CONTAINS IMPLICIT NONE INTEGER(HID_T), VALUE :: group - CHARACTER(LEN=1), DIMENSION(1:10) :: name + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name TYPE (H5L_info_t) :: link_info @@ -72,13 +82,23 @@ CONTAINS INTEGER, SAVE :: count INTEGER, SAVE :: count2 + INTEGER :: nlen, i + liter_cb = 0 !!$ iter_info *info = (iter_info *)op_data; !!$ static int count = 0; !!$ static int count2 = 0; - - op_data%name(1:10) = name(1:10) + nlen = 0 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + op_data%name(1:nlen) = name(1:nlen) + ENDIF SELECT CASE (op_data%command) @@ -105,6 +125,63 @@ CONTAINS END FUNCTION liter_cb END MODULE liter_cb_mod +MODULE lvisit_cb_mod + + USE HDF5 + USE TH5_MISC + USE TH5_MISC_GEN + USE EXTENTS + USE, INTRINSIC :: ISO_C_BINDING + IMPLICIT NONE + + ! Custom group iteration callback data + TYPE, bind(c) :: visit_info + CHARACTER(KIND=C_CHAR), DIMENSION(1:11*MAX_CHAR_LEN) :: name ! The name of the object + INTEGER(c_int) :: TYPE ! The TYPE of the object + INTEGER(c_int) :: command ! The TYPE of RETURN value + INTEGER(c_int) :: n_obj ! The TYPE of RETURN value + END TYPE visit_info + +CONTAINS + +!*************************************************************** +!** +!** lvisit_cb(): Custom link visit callback routine. +!** +!*************************************************************** + + INTEGER(KIND=C_INT) FUNCTION lvisit_cb(group, name, link_info, op_data) bind(C) + + IMPLICIT NONE + + INTEGER(HID_T), VALUE :: group + CHARACTER(LEN=1), DIMENSION(1:MAX_CHAR_LEN) :: name + + TYPE(H5L_info_t) :: link_info + TYPE(visit_info) :: op_data + + INTEGER :: nlen, i, istart, iend + + op_data%n_obj = op_data%n_obj + 1 + + nlen = 1 + DO i = 1, MAX_CHAR_LEN + IF( name(i) .EQ. CHAR(0) )THEN + nlen = i - 1 + EXIT + ENDIF + ENDDO + IF(nlen.NE.0)THEN + istart = (op_data%n_obj-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + op_data%name(istart:istart+nlen-1) = name(1:nlen) + ENDIF + + lvisit_cb = 0 + + END FUNCTION lvisit_cb +END MODULE lvisit_cb_mod + MODULE TH5L_F03 CONTAINS @@ -119,18 +196,20 @@ CONTAINS !** test_iter_group(): Test group iteration functionality !** !*************************************************************** -SUBROUTINE test_iter_group(total_error) +SUBROUTINE test_iter_group(cleanup, total_error) USE liter_cb_mod IMPLICIT NONE + LOGICAL, INTENT(IN) :: cleanup INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: fapl INTEGER(HID_T) :: file ! File ID - INTEGER(hid_t) :: dataset ! Dataset ID - INTEGER(hid_t) :: datatype ! Common datatype ID - INTEGER(hid_t) :: filespace ! Common dataspace ID - INTEGER(hid_t) :: grp ! Group ID + INTEGER(HID_T) :: dataset ! Dataset ID + INTEGER(HID_T) :: datatype ! Common datatype ID + INTEGER(HID_T) :: filespace ! Common dataspace ID + INTEGER(HID_T) :: grp ! Group ID INTEGER i,j ! counting variable INTEGER(hsize_t) idx ! Index in the group CHARACTER(LEN=11) :: DATAFILE = "titerate.h5" @@ -165,7 +244,6 @@ SUBROUTINE test_iter_group(total_error) f1 = C_FUNLOC(liter_cb) f2 = C_LOC(info) - CALL H5Literate_f(file, H5_INDEX_NAME_F, H5_ITER_INC_F, idx, f1, f2, ret_value, error) CALL check("H5Literate_f", error, total_error) @@ -198,7 +276,7 @@ SUBROUTINE test_iter_group(total_error) lnames(ndatasets+2) = "grp0000000" !!$ -!!$ lnames[NDATASETS] = HDstrdup("grp"); +!!$ lnames[NDATASETS] = strdup("grp"); !!$ CHECK(lnames[NDATASETS], NULL, "strdup"); !!$ @@ -311,6 +389,195 @@ SUBROUTINE test_iter_group(total_error) CALL H5Fclose_f(file, error) CALL check("H5Fclose_f", error, total_error) + IF(cleanup) CALL h5_cleanup_f("titerate", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + END SUBROUTINE test_iter_group +!*************************************************************** +!** +!** Test HL visit functionality +!** +!*************************************************************** +SUBROUTINE test_visit(cleanup, total_error) + + USE lvisit_cb_mod + IMPLICIT NONE + + LOGICAL, INTENT(IN) :: cleanup + INTEGER, INTENT(INOUT) :: total_error + INTEGER(HID_T) :: fapl + INTEGER(HID_T) :: fid + INTEGER(HID_T) :: gid, gid2 ! Group IDs + INTEGER(HID_T) :: sid ! Dataspace ID + INTEGER(HID_T) :: did ! Dataset ID + CHARACTER(LEN=11) :: DATAFILE = "tvisit.h5" + + TYPE(C_FUNPTR) :: f1 + TYPE(C_PTR) :: f2 + TYPE(visit_info), TARGET :: udata + + CHARACTER(LEN=MAX_CHAR_LEN), DIMENSION(1:11) :: obj_list + CHARACTER(LEN=MAX_CHAR_LEN) :: tmp + INTEGER :: error + INTEGER :: istart, iend, i, j + INTEGER :: ret_val + + obj_list(1) = "Dataset_zero" + obj_list(2) = "Group1" + obj_list(3) = "Group1/Dataset_one" + obj_list(4) = "Group1/Group2" + obj_list(5) = "Group1/Group2/Dataset_two" + obj_list(6) = "hard_one" + obj_list(7) = "hard_two" + obj_list(8) = "hard_zero" + obj_list(9) = "soft_dangle" + obj_list(10) = "soft_one" + obj_list(11) = "soft_two" + + fid = H5I_INVALID_HID_F + gid = H5I_INVALID_HID_F + gid2 = H5I_INVALID_HID_F + sid = H5I_INVALID_HID_F + did = H5I_INVALID_HID_F + + ! Get the default FAPL + CALL H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, error) + CALL check("h5pcreate_f", error, total_error) + + ! Set the "use the latest version of the format" bounds for creating objects in the file + CALL H5Pset_libver_bounds_f(fapl, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error) + CALL check("H5Pset_libver_bounds_f",error, total_error) + + ! Create the test file with the datasets + CALL h5fcreate_f(DATAFILE, H5F_ACC_TRUNC_F, fid, error, H5P_DEFAULT_F, fapl) + CALL check("h5fcreate_f", error, total_error) + + ! Create group + CALL h5gcreate_f(fid, "/Group1", gid, error) + CALL check("h5gcreate_f", error, total_error) + + ! Create nested group + CALL h5gcreate_f(gid, "Group2", gid2, error) + CALL check("h5gcreate_f", error, total_error) + + ! Close groups + CALL h5gclose_f(gid2, error) + CALL check("h5gclose_f", error, total_error) + CALL h5gclose_f(gid, error) + CALL check("h5gclose_f", error, total_error) + + ! Create soft links to groups created + CALL h5lcreate_soft_f("/Group1", fid, "/soft_one", error) + CALL check("h5lcreate_soft_f", error, total_error) + + CALL h5lcreate_soft_f("/Group1/Group2", fid, "/soft_two", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create dangling soft link + CALL h5lcreate_soft_f("nowhere", fid, "/soft_dangle", error) + CALL check("h5lcreate_soft_f", error, total_error) + + ! Create hard links to all groups + CALL h5lcreate_hard_f(fid, "/", fid, "hard_zero", error) + CALL check("h5lcreate_hard_f1", error, total_error) + + CALL h5lcreate_hard_f(fid, "/Group1", fid, "hard_one", error) + CALL check("h5lcreate_hard_f2", error, total_error) + CALL h5lcreate_hard_f(fid, "/Group1/Group2", fid, "hard_two", error) + CALL check("h5lcreate_hard_f3", error, total_error) + + ! Create dataset in each group + CALL h5screate_f(H5S_SCALAR_F, sid, error) + CALL check("h5screate_f", error, total_error) + + CALL h5dcreate_f(fid, "/Dataset_zero", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dcreate_f(fid, "/Group1/Dataset_one", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5dcreate_f(fid, "/Group1/Group2/Dataset_two", H5T_NATIVE_INTEGER, sid, did, error) + CALL check("h5dcreate_f3", error, total_error) + CALL h5dclose_f(did, error) + CALL check("h5dclose_f", error, total_error) + + CALL h5sclose_f(sid, error) + CALL check("h5sclose_f", error, total_error) + + ! Test visit functions + + f1 = C_FUNLOC(lvisit_cb) + f2 = C_LOC(udata) + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, ret_val, error) + CALL check("h5lvisit_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5lvisit_f", -1, total_error) + ENDIF + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)) )THEN + CALL check("h5lvisit_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + udata%n_obj = 0 + udata%name(:) = " " + CALL h5lvisit_by_name_f(fid, "/", H5_INDEX_NAME_F, H5_ITER_INC_F, f1, f2, ret_val, error) + CALL check("h5lvisit_by_name_f", error, total_error) + IF(ret_val.LT.0)THEN + CALL check("h5ovisit_f", -1, total_error) + ENDIF + + IF(udata%n_obj.NE.11)THEN + CALL check("h5lvisit_by_name_f: Wrong number of objects visited", -1, total_error) + ENDIF + + DO i = 1, udata%n_obj + istart = (i-1)*MAX_CHAR_LEN + 1 + iend = istart + MAX_CHAR_LEN - 1 + tmp = " " + DO j = 1, MAX_CHAR_LEN + IF(udata%name(istart+j-1) .NE. " ")THEN + tmp(j:j) = udata%name(istart+j-1) + ELSE + EXIT + ENDIF + ENDDO + IF( TRIM(tmp) .NE. TRIM(obj_list(i)) )THEN + CALL check("h5lvisit_by_name_f: Wrong object list from visit", -1, total_error) + EXIT + ENDIF + ENDDO + + CALL h5fclose_f(fid, error) + CALL check("h5fclose_f", error, total_error) + + IF(cleanup) CALL h5_cleanup_f("tvisit", H5P_DEFAULT_F, error) + CALL check("h5_cleanup_f", error, total_error) + +END SUBROUTINE test_visit + END MODULE TH5L_F03 diff --git a/fortran/test/tH5MISC_1_8.F90 b/fortran/test/tH5MISC_1_8.F90 index 85f9634..bd3ce3f 100644 --- a/fortran/test/tH5MISC_1_8.F90 +++ b/fortran/test/tH5MISC_1_8.F90 @@ -476,4 +476,68 @@ SUBROUTINE test_scaleoffset(cleanup, total_error ) END SUBROUTINE test_scaleoffset +SUBROUTINE test_freelist(total_error) + + IMPLICIT NONE + INTEGER, INTENT(INOUT) :: total_error + + INTEGER(hid_t) :: sid + INTEGER(hsize_t), DIMENSION(1:1) :: dims = (/8/) + INTEGER(hsize_t), DIMENSION(1:1,1:4) :: coord + INTEGER(size_t) :: reg_size_start ! Initial amount of regular memory allocated + INTEGER(size_t) :: arr_size_start ! Initial amount of array memory allocated + INTEGER(size_t) :: blk_size_start ! Initial amount of block memory allocated + INTEGER(size_t) :: fac_size_start ! Initial amount of factory memory allocated + INTEGER(size_t) :: reg_size_final ! Final amount of regular memory allocated + INTEGER(size_t) :: arr_size_final ! Final amount of array memory allocated + INTEGER(size_t) :: blk_size_final ! Final amount of BLOCK memory allocated + INTEGER(size_t) :: fac_size_final ! Final amount of factory memory allocated + INTEGER :: error + + coord(1,1:4) = (/3,4,5,6/) + + ! Create dataspace + ! (Allocates array free-list nodes) + CALL h5screate_simple_f(1, dims, sid, error) + CALL CHECK("h5screate_simple_f", error, total_error) + + ! Select sequence of 4 points + CALL h5sselect_elements_f(sid, H5S_SELECT_SET_F, 1, 4_size_t, coord, error) + CALL CHECK("h5sselect_elements_f", error, total_error) + + ! Close dataspace + CALL h5sclose_f(sid, error) + CALL CHECK("h5sclose_f", error, total_error) + + ! Retrieve initial free list values + CALL h5get_free_list_sizes_f(reg_size_start, arr_size_start, blk_size_start, fac_size_start, error) + CALL check("h5get_free_list_sizes_f", error, total_error) + + IF(reg_size_start.LT.0 .OR. & + arr_size_start.LT.0 .OR. & + blk_size_start.LT.0 .OR. & + fac_size_start.LT.0 & + )THEN + CALL check("h5get_free_list_sizes_f", -1, total_error) + ENDIF + + CALL h5garbage_collect_f(error) + CALL check("h5garbage_collect_f", error, total_error) + + ! Retrieve initial free list values + CALL h5get_free_list_sizes_f(reg_size_final, arr_size_final, blk_size_final, fac_size_final, error) + CALL check("h5get_free_list_sizes_f", error, total_error) + + ! All the free list values should be <= previous values + IF( reg_size_final .GT. reg_size_start) & + CALL check("h5get_free_list_sizes_f: reg_size_final > reg_size_start", -1, total_error) + IF( arr_size_final .GT. arr_size_start) & + CALL check("h5get_free_list_sizes_f: arr_size_final > arr_size_start", -1, total_error) + IF( blk_size_final .GT. blk_size_start) & + CALL check("h5get_free_list_sizes_f: blk_size_final > blk_size_start", -1, total_error) + IF( fac_size_final .GT. fac_size_start) & + CALL check("h5get_free_list_sizes_f: fac_size_final > fac_size_start", -1, total_error) + +END SUBROUTINE test_freelist + END MODULE TH5MISC_1_8 diff --git a/fortran/test/tH5P_F03.F90 b/fortran/test/tH5P_F03.F90 index 606a9cd..4f390d5 100644 --- a/fortran/test/tH5P_F03.F90 +++ b/fortran/test/tH5P_F03.F90 @@ -155,8 +155,6 @@ SUBROUTINE test_create(total_error) fill_ctype%a = 5555. fill_ctype%x = 55 - f_ptr = C_LOC(fill_ctype) - ! Test various fill values CALL H5Pset_fill_value_f(dcpl, H5T_NATIVE_CHARACTER, 'X', error) CALL check("H5Pset_fill_value_f",error, total_error) diff --git a/fortran/test/tH5Sselect.F90 b/fortran/test/tH5Sselect.F90 index bf1658c..6dfd7e6 100644 --- a/fortran/test/tH5Sselect.F90 +++ b/fortran/test/tH5Sselect.F90 @@ -126,7 +126,6 @@ CONTAINS INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims - ! !This writes data to the HDF5 file. ! @@ -807,6 +806,12 @@ CONTAINS INTEGER :: error INTEGER(HSIZE_T), DIMENSION(3) :: data_dims + LOGICAL :: same, intersects + INTEGER(HID_T) :: scalar_all_sid + + INTEGER(hsize_t), DIMENSION(1:2) :: block_start = (/0, 0/) ! Start offset for BLOCK + INTEGER(hsize_t), DIMENSION(1:2) :: block_end = (/2, 3/) ! END offset for BLOCK + ! !initialize the coord array to give the selected points' position ! @@ -848,6 +853,22 @@ CONTAINS CALL h5screate_simple_f(RANK, dimsf, dataspace, error) CALL check("h5screate_simple_f", error, total_error) + ! Check shape same API + CALL h5sselect_shape_same_f(dataspace, dataspace, same, error) + CALL check("h5sselect_shape_same_f", error, total_error) + CALL VERIFY("h5sselect_shape_same_f", same, .TRUE., total_error) + + CALL h5screate_f(H5S_SCALAR_F, scalar_all_sid, error) + CALL check("h5screate_f", error, total_error) + + same = .TRUE. + CALL h5sselect_shape_same_f(dataspace, scalar_all_sid, same, error) + CALL check("h5sselect_shape_same_f", error, total_error) + CALL VERIFY("h5sselect_shape_same_f", same, .FALSE., total_error) + + CALL h5sclose_f(scalar_all_sid,error) + CALL check("h5sclose_f", error, total_error) + ! ! Create the dataset with default properties ! @@ -863,6 +884,33 @@ CONTAINS CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, data, data_dims, error) CALL check("h5dwrite_f", error, total_error) + ! Set selection to 'all' + CALL h5sselect_all_f(dataspace, error) + CALL check("h5sselect_all_f", error, total_error) + + ! Test block intersection with 'all' selection (always true) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) + + ! Select 2x2 region of the dataset + CALL h5sselect_hyperslab_f(dataspace, H5S_SELECT_SET_F, offset, count, error) + CALL check("h5sselect_hyperslab_f", error, total_error) + + ! Check an intersecting region + block_start(1:2) = (/1,0/) + block_end(1:2) = (/2,2/) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f", intersects, .TRUE., total_error) + + ! Check a non-intersecting region + block_start(1:2) = (/2,1/) + block_end(1:2) = (/4,5/) + CALL h5sselect_intersect_block_f(dataspace, block_start, block_end, intersects, error) + CALL check("h5sselect_intersect_block_f", error, total_error) + CALL verify("h5sselect_intersect_block_f2", intersects, .FALSE., total_error) + ! !Close the dataspace for the dataset. ! @@ -998,6 +1046,9 @@ CONTAINS ! DEALLOCATE(pointlist) + + + ! !Close the dataspace for the dataset. ! diff --git a/fortran/test/tHDF5_F03.F90 b/fortran/test/tHDF5_F03.F90 index dc4da31..1ef7626 100644 --- a/fortran/test/tHDF5_F03.F90 +++ b/fortran/test/tHDF5_F03.F90 @@ -28,7 +28,6 @@ MODULE THDF5_F03 USE TH5_MISC USE TH5E_F03 - USE TH5F_F03 USE TH5L_F03 USE TH5O_F03 USE TH5P_F03 |