summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
authorScot Breitenfeld <brtnfld@hdfgroup.org>2012-09-27 19:43:48 (GMT)
committerScot Breitenfeld <brtnfld@hdfgroup.org>2012-09-27 19:43:48 (GMT)
commit0878e52087a3d782ced8200a2e0091d853e50026 (patch)
treee27198b9e866b89c4d80bbc837a45406c6e2c8d1 /fortran
parent393852a414d631e70191d1a9178db2ddbbb76d1e (diff)
downloadhdf5-0878e52087a3d782ced8200a2e0091d853e50026.zip
hdf5-0878e52087a3d782ced8200a2e0091d853e50026.tar.gz
hdf5-0878e52087a3d782ced8200a2e0091d853e50026.tar.bz2
[svn-r22827] HDFFV-8007: Add missing H5O Fortran functions.
Tested: jam(gnu,intel)
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Gff.f902
-rw-r--r--fortran/src/H5Of.c656
-rw-r--r--fortran/src/H5Off.f90468
-rw-r--r--fortran/src/H5Off_F03.f90228
-rw-r--r--fortran/src/H5Pff.f902
-rw-r--r--fortran/src/H5_f.c6
-rw-r--r--fortran/src/H5f90global.f9014
-rw-r--r--fortran/src/hdf5_fortrandll.def17
-rw-r--r--fortran/test/Makefile.am2
-rw-r--r--fortran/test/Makefile.in6
-rw-r--r--fortran/test/fortranlib_test_F03.f9028
-rw-r--r--fortran/test/tH5O.f90255
-rw-r--r--fortran/test/tH5O_F03.f90547
-rw-r--r--fortran/test/tH5T_F03.f905
14 files changed, 2106 insertions, 130 deletions
diff --git a/fortran/src/H5Gff.f90 b/fortran/src/H5Gff.f90
index 6bcee7c..155185a 100644
--- a/fortran/src/H5Gff.f90
+++ b/fortran/src/H5Gff.f90
@@ -927,7 +927,7 @@ CONTAINS
! Buffer to hold a comment
INTEGER, INTENT(OUT) :: hdferr ! Error code
!*****
- INTEGER :: namelen ! Lenghth of the current_name string
+ INTEGER :: namelen ! Length of the current_name string
INTERFACE
INTEGER FUNCTION h5gget_comment_c(loc_id, name, namelen, size, buffer)
diff --git a/fortran/src/H5Of.c b/fortran/src/H5Of.c
index 531f09c..59f9a3d 100644
--- a/fortran/src/H5Of.c
+++ b/fortran/src/H5Of.c
@@ -24,6 +24,84 @@
#include "H5f90.h"
#include "H5Eprivate.h"
+int_f
+fill_h5o_info_t_f(H5O_info_t Oinfo, H5O_info_t_f *object_info) {
+
+ struct tm *ts;
+
+ object_info->fileno = Oinfo.fileno;
+ object_info->addr = (haddr_t_f)Oinfo.addr;
+
+
+ object_info->type = (int_f)Oinfo.type;
+ object_info->rc = (int_f)Oinfo.rc;
+
+ ts = HDgmtime(&Oinfo.atime);
+
+ object_info->atime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
+ object_info->atime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
+ object_info->atime[2] = (int_f)ts->tm_mday;
+ object_info->atime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
+ object_info->atime[4] = (int_f)ts->tm_hour;
+ object_info->atime[5] = (int_f)ts->tm_min;
+ object_info->atime[6] = (int_f)ts->tm_sec;
+ object_info->atime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
+
+ ts = HDgmtime(&Oinfo.btime);
+
+ object_info->btime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
+ object_info->btime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
+ object_info->btime[2] = (int_f)ts->tm_mday;
+ object_info->btime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
+ object_info->btime[4] = (int_f)ts->tm_hour;
+ object_info->btime[5] = (int_f)ts->tm_min;
+ object_info->btime[6] = (int_f)ts->tm_sec;
+ object_info->btime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
+
+ ts = HDgmtime(&Oinfo.ctime);
+
+ object_info->ctime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
+ object_info->ctime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
+ object_info->ctime[2] = (int_f)ts->tm_mday;
+ object_info->ctime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
+ object_info->ctime[4] = (int_f)ts->tm_hour;
+ object_info->ctime[5] = (int_f)ts->tm_min;
+ object_info->ctime[6] = (int_f)ts->tm_sec;
+ object_info->ctime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
+
+ ts = HDgmtime(&Oinfo.mtime);
+
+ object_info->mtime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
+ object_info->mtime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
+ object_info->mtime[2] = (int_f)ts->tm_mday;
+ object_info->mtime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
+ object_info->mtime[4] = (int_f)ts->tm_hour;
+ object_info->mtime[5] = (int_f)ts->tm_min;
+ object_info->mtime[6] = (int_f)ts->tm_sec;
+ object_info->mtime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
+
+ object_info->num_attrs = (hsize_t_f)Oinfo.num_attrs;
+
+ object_info->hdr.version = (int_f)Oinfo.hdr.version;
+ object_info->hdr.nmesgs = (int_f)Oinfo.hdr.nmesgs;
+ object_info->hdr.nchunks = (int_f)Oinfo.hdr.nchunks;
+ object_info->hdr.flags = (int_f)Oinfo.hdr.flags;
+
+ object_info->hdr.space.total = (hsize_t_f)Oinfo.hdr.space.total;
+ object_info->hdr.space.meta = (hsize_t_f)Oinfo.hdr.space.meta;
+ object_info->hdr.space.mesg = (hsize_t_f)Oinfo.hdr.space.mesg;
+ object_info->hdr.space.free = (hsize_t_f)Oinfo.hdr.space.free;
+
+ object_info->hdr.mesg.present = Oinfo.hdr.mesg.present;
+ object_info->hdr.mesg.shared = Oinfo.hdr.mesg.shared;
+
+ object_info->meta_size.obj.index_size = (hsize_t_f)Oinfo.meta_size.obj.index_size;
+ object_info->meta_size.obj.heap_size = (hsize_t_f)Oinfo.meta_size.obj.heap_size;
+
+ return 0;
+
+}
+
/****if* H5Of/h5olink_c
* NAME
* h5olink_c
@@ -215,7 +293,7 @@ nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id)
return ret_value;
}
-/* ***if* H5Of/H5Oget_info_by_name_c
+/****if* H5Of/H5Oget_info_by_name_c
* NAME
* H5Oget_info_by_name_c
* PURPOSE
@@ -226,10 +304,7 @@ nh5oopen_by_addr_c (hid_t_f *loc_id, haddr_t_f *addr, hid_t_f *obj_id)
* namelen - Name length.
* lapl_id - Link access property list.
* OUTPUTS
- * corder_valid - Indicates whether the the creation order data is valid for this attribute.
- * corder - Is a positive integer containing the creation order of the attribute.
- * cset - Indicates the character set used for the attribute’s name.
- * data_size - indicates the size, in the number of characters, of the attribute.
+ * object_info - Buffer in which to return object information.
*
* RETURNS
* 0 on success, -1 on failure
@@ -261,74 +336,100 @@ nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *
&Oinfo, (hid_t)*lapl_id) < 0)
HGOTO_DONE(FAIL);
- object_info->fileno = Oinfo.fileno;
- object_info->addr = (haddr_t_f)Oinfo.addr;
-
-
- object_info->type = (int_f)Oinfo.type;
- object_info->rc = (int_f)Oinfo.rc;
+ ret_value = fill_h5o_info_t_f(Oinfo,object_info);
- ts = HDgmtime(&Oinfo.atime);
-
- object_info->atime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
- object_info->atime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
- object_info->atime[2] = (int_f)ts->tm_mday;
- object_info->atime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
- object_info->atime[4] = (int_f)ts->tm_hour;
- object_info->atime[5] = (int_f)ts->tm_min;
- object_info->atime[6] = (int_f)ts->tm_sec;
- object_info->atime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
-
- ts = HDgmtime(&Oinfo.btime);
-
- object_info->btime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
- object_info->btime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
- object_info->btime[2] = (int_f)ts->tm_mday;
- object_info->btime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
- object_info->btime[4] = (int_f)ts->tm_hour;
- object_info->btime[5] = (int_f)ts->tm_min;
- object_info->btime[6] = (int_f)ts->tm_sec;
- object_info->btime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
-
- ts = HDgmtime(&Oinfo.ctime);
-
- object_info->ctime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
- object_info->ctime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
- object_info->ctime[2] = (int_f)ts->tm_mday;
- object_info->ctime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
- object_info->ctime[4] = (int_f)ts->tm_hour;
- object_info->ctime[5] = (int_f)ts->tm_min;
- object_info->ctime[6] = (int_f)ts->tm_sec;
- object_info->ctime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
+ done:
+ if(c_name)
+ HDfree(c_name);
+ return ret_value;
+}
- ts = HDgmtime(&Oinfo.mtime);
+/****if* H5Of/H5Oget_info_by_idx_c
+ * NAME
+ * H5Oget_info_by_idx_c
+ * PURPOSE
+ * Calls H5Oget_info_by_idx
+ * INPUTS
+ * loc_id - File or group identifier specifying location of group in which object is located.
+ * name - Name of group, relative to loc_id.
+ * namelen - Name length.
+ * lapl_id - Link access property list.
+ * OUTPUTS
+ * object_info - Buffer in which to return object information.
+ *
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * December 1, 2008
+ * SOURCE
+*/
+int_f
+nh5oget_info_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *namelen,
+ int_f *index_field, int_f *order, hsize_t_f *n, hid_t_f *lapl_id, H5O_info_t_f *object_info)
+/******/
+{
+ char *c_group_name = NULL; /* Buffer to hold C string */
+ int_f ret_value = 0; /* Return value */
+ H5O_info_t Oinfo;
+ H5_index_t c_index_field;
+ H5_iter_order_t c_order;
+
+ /*
+ * Convert FORTRAN name to C name
+ */
+ if((c_group_name = HD5f2cstring( group_name, (size_t)*namelen)) == NULL)
+ HGOTO_DONE(FAIL);
- object_info->mtime[0] = (int_f)ts->tm_year+1900; /* year starts at 1900 */
- object_info->mtime[1] = (int_f)ts->tm_mon+1; /* month starts at 0 in C */
- object_info->mtime[2] = (int_f)ts->tm_mday;
- object_info->mtime[3] = 0; /* time is expressed as UTC (or GMT timezone) */
- object_info->mtime[4] = (int_f)ts->tm_hour;
- object_info->mtime[5] = (int_f)ts->tm_min;
- object_info->mtime[6] = (int_f)ts->tm_sec;
- object_info->mtime[7] = -32767; /* millisecond is not available, assign it -HUGE(0) */
+ c_index_field = (H5_index_t)*index_field;
+ c_order = (H5_iter_order_t)*order;
- object_info->num_attrs = (hsize_t_f)Oinfo.num_attrs;
+ /*
+ * Call H5Oinfo_by_idx function.
+ */
+ if(H5Oget_info_by_idx((hid_t)*loc_id, c_group_name, c_index_field, c_order, (hsize_t)*n,
+ &Oinfo, (hid_t)*lapl_id) < 0)
+ HGOTO_DONE(FAIL);
- object_info->hdr.version = (int_f)Oinfo.hdr.version;
- object_info->hdr.nmesgs = (int_f)Oinfo.hdr.nmesgs;
- object_info->hdr.nchunks = (int_f)Oinfo.hdr.nchunks;
- object_info->hdr.flags = (int_f)Oinfo.hdr.flags;
+ ret_value = fill_h5o_info_t_f(Oinfo,object_info);
- object_info->hdr.space.total = (hsize_t_f)Oinfo.hdr.space.total;
- object_info->hdr.space.meta = (hsize_t_f)Oinfo.hdr.space.meta;
- object_info->hdr.space.mesg = (hsize_t_f)Oinfo.hdr.space.mesg;
- object_info->hdr.space.free = (hsize_t_f)Oinfo.hdr.space.free;
+ done:
+ if(c_group_name)
+ HDfree(c_group_name);
+ return ret_value;
+}
- object_info->hdr.mesg.present = Oinfo.hdr.mesg.present;
- object_info->hdr.mesg.shared = Oinfo.hdr.mesg.shared;
+/****if* H5Of/H5Oget_info_c
+ * NAME
+ * H5Oget_info_c
+ * PURPOSE
+ * Calls H5Oget_info
+ * INPUTS
+ * object_id - Identifier for target object.
+ * OUTPUTS
+ * object_info - Buffer in which to return object information.
+ *
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 16, 2012
+ * SOURCE
+*/
+int_f
+nh5oget_info_c (hid_t_f *object_id, H5O_info_t_f *object_info)
+/******/
+{
+ int_f ret_value = 0; /* Return value */
+ H5O_info_t Oinfo;
+
+ /*
+ * Call H5Oinfo_by_name function.
+ */
+ if(H5Oget_info((hid_t)*object_id, &Oinfo) < 0)
+ HGOTO_DONE(FAIL);
- object_info->meta_size.obj.index_size = (hsize_t_f)Oinfo.meta_size.obj.index_size;
- object_info->meta_size.obj.heap_size = (hsize_t_f)Oinfo.meta_size.obj.heap_size;
+ ret_value = fill_h5o_info_t_f(Oinfo,object_info);
done:
return ret_value;
@@ -391,3 +492,428 @@ nh5ocopy_c (hid_t_f *src_loc_id, _fcd src_name, size_t_f *src_name_len,
return ret_value;
}
+
+/****if* H5Of/h5ovisit_by_name_c
+ * NAME
+ * h5ovisit_by_name_c
+ * PURPOSE
+ * Calls H5Ovisit_by_name
+ * INPUTS
+ * object_id - Identifier specifying subject group
+ * index_type - Type of index which determines the order
+ * order - Order within index
+ * idx - Iteration position at which to start
+ * op - Callback function passing data regarding the link to the calling application
+ * op_data - User-defined pointer to data required by the application for its processing of the link
+ *
+ * OUTPUTS
+ * idx - Position at which an interrupted iteration may be restarted
+ *
+ * RETURNS
+ * >0 on success, 0< on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 16, 2012
+ * SOURCE
+*/
+int_f
+nh5ovisit_by_name_c(hid_t_f *loc_id, _fcd object_name, size_t_f *namelen, int_f *index_type, int_f *order,
+ H5O_iterate_t op, void *op_data, hid_t_f *lapl_id )
+/******/
+{
+ int_f ret_value = -1; /* Return value */
+ herr_t func_ret_value; /* H5Linterate return value */
+ char *c_object_name = NULL; /* Buffer to hold C string */
+
+
+ /*
+ * Convert FORTRAN name to C name
+ */
+ if( (c_object_name = HD5f2cstring(object_name, (size_t)*namelen)) == NULL)
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Call H5Ovisit
+ */
+ func_ret_value = H5Ovisit_by_name( (hid_t)*loc_id, c_object_name, (H5_index_t)*index_type, (H5_iter_order_t)*order,
+ op, op_data, (hid_t)*lapl_id);
+ ret_value = (int_f)func_ret_value;
+
+ done:
+ if(c_object_name)
+ HDfree(c_object_name);
+ return ret_value;
+
+}
+
+/****if* H5Of/h5odecr_refcount_c
+ * NAME
+ * h5odecr_refcount_c
+ * PURPOSE
+ * Calls H5Odecr_refcount
+ * INPUTS
+ * object_id - Object identifier.
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 16, 2012
+ * SOURCE
+*/
+int_f
+nh5odecr_refcount_c (hid_t_f *object_id)
+/******/
+{
+ int_f ret_value = 0; /* Return value */
+
+ /*
+ * Call H5Odecr_refcount function.
+ */
+ if((hid_t_f)H5Odecr_refcount((hid_t)*object_id) < 0)
+ HGOTO_DONE(FAIL);
+
+ done:
+ return ret_value;
+}
+
+/****if* H5Of/h5oexists_by_name_c
+ * NAME
+ * h5oexists_by_name_c
+ * PURPOSE
+ * Calls H5Oexists_by_name
+ * INPUTS
+ * loc_id - File or group identifier
+ * name - Attribute access property list
+ * namelen - Size of name
+ * lapl_id - Link access property list
+ *
+ * RETURNS
+ * link status: 0 = false, 1 = true, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 17, 2012
+ * SOURCE
+*/
+int_f
+nh5oexists_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen, hid_t_f *lapl_id)
+/******/
+{
+ char *c_name = NULL; /* Buffer to hold C string */
+ int_f ret_value = 0; /* Return value */
+ htri_t status = 0;
+
+ /*
+ * Convert FORTRAN name to C name
+ */
+ if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL)
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Call H5Oopen function.
+ */
+ if((ret_value = (int_f)H5Oexists_by_name((hid_t)*loc_id, c_name, (hid_t)*lapl_id)) < 0)
+ HGOTO_DONE(FAIL);
+
+ done:
+ if(c_name)
+ HDfree(c_name);
+ return ret_value;
+}
+
+/****if* H5Of/h5oincr_refcount_c
+ * NAME
+ * h5oincr_refcount_c
+ * PURPOSE
+ * Calls H5Oincr_refcount
+ * INPUTS
+ * object_id - Object identifier.
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 16, 2012
+ * SOURCE
+*/
+int_f
+nh5oincr_refcount_c (hid_t_f *object_id)
+/******/
+{
+ int_f ret_value = 0; /* Return value */
+
+ /*
+ * Call H5Oincr_refcount function.
+ */
+ if((hid_t_f)H5Oincr_refcount((hid_t)*object_id) < 0)
+ HGOTO_DONE(FAIL);
+
+ done:
+ return ret_value;
+}
+
+/****if* H5Of/h5oset_comment_c
+ * NAME
+ * h5oset_comment_c
+ * PURPOSE
+ * Calls H5Oset_comment
+ * INPUTS
+ * object_id - Identifier of the target object.
+ * comment - The new comment.
+ * commentlen - Length of the comment.
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 17, 2012
+ * SOURCE
+*/
+int_f
+nh5oset_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentlen)
+/******/
+{
+ char *c_comment = NULL; /* Buffer to hold C string */
+ int_f ret_value = 0; /* Return value */
+
+ /*
+ * Convert FORTRAN string to C string
+ */
+ if((c_comment = HD5f2cstring(comment, (size_t)*commentlen)) == NULL)
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Call H5Oset_comment function.
+ */
+ if((hid_t_f)H5Oset_comment((hid_t)*object_id, c_comment) < 0)
+ HGOTO_DONE(FAIL);
+
+ done:
+ if(c_comment)
+ HDfree(c_comment);
+ return ret_value;
+}
+
+/****if* H5Of/h5oset_comment_by_name_c
+ * NAME
+ * h5oset_comment_by_name_c
+ * PURPOSE
+ * Calls H5Oset_comment_by_name
+ * INPUTS
+ * object_id - Identifier of the target object.
+ * name - Name of the object whose comment is to be set or reset,
+ * specified as a path relative to loc_id.
+ * namelen - Length of the name.
+ * comment - The new comment.
+ * commentlen - Length of the comment.
+ * lapl_id - Link access property list identifier.
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 17, 2012
+ * SOURCE
+*/
+int_f
+nh5oset_comment_by_name_c (hid_t_f *object_id, _fcd name, size_t_f *namelen, _fcd comment, size_t_f *commentlen, hid_t_f *lapl_id)
+/******/
+{
+ char *c_comment = NULL; /* Buffer to hold C string */
+ char *c_name = NULL; /* Buffer to hold C string */
+ int_f ret_value = 0; /* Return value */
+
+ /*
+ * Convert FORTRAN string to C string
+ */
+ if((c_comment = HD5f2cstring(comment, (size_t)*commentlen)) == NULL)
+ HGOTO_DONE(FAIL);
+ /*
+ * Convert FORTRAN string to C string
+ */
+ if((c_name = HD5f2cstring(name, (size_t)*namelen)) == NULL)
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Call H5Oset_comment_by_name function.
+ */
+ if((hid_t_f)H5Oset_comment_by_name((hid_t)*object_id, c_name, c_comment, (hid_t)*lapl_id) < 0)
+ HGOTO_DONE(FAIL);
+
+ done:
+ if(c_name)
+ HDfree(c_name);
+ if(c_comment)
+ HDfree(c_comment);
+ return ret_value;
+}
+/****if* H5Of/h5oopen_by_idx_c
+ * NAME
+ * h5oopen_by_idx_c
+ * PURPOSE
+ * Calls H5Oopen_by_idx_c
+ * INPUTS
+ * loc_id - A file or group identifier.
+ * group_name - Name of group, relative to loc_id, in which object is located.
+ * group_namelen - Length of group_name
+ * index_type - Type of index by which objects are ordered.
+ * order - Order of iteration within index.
+ * n - Object to open.
+ * lapl_id - Link access property list.
+ * OUTPUTS
+ * obj_id - An object identifier for the opened object.
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * May 17, 2012
+ * SOURCE
+*/
+int_f
+nh5oopen_by_idx_c (hid_t_f *loc_id, _fcd group_name, size_t_f *group_namelen,
+ int_f *index_type, int_f *order, hsize_t_f *n, hid_t_f *obj_id, hid_t_f *lapl_id)
+/******/
+{
+ char *c_group_name = NULL; /* Buffer to hold C string */
+ int_f ret_value = 0;
+ H5_index_t c_index_type;
+ H5_iter_order_t c_order;
+
+ /*
+ * Convert FORTRAN string to C string
+ */
+ if((c_group_name = HD5f2cstring( group_name, (size_t)*group_namelen)) == NULL)
+ HGOTO_DONE(FAIL);
+
+ c_index_type = (H5_index_t)*index_type;
+ c_order = (H5_iter_order_t)*order;
+
+ /*
+ * Call H5Oopen_by_idx function.
+ */
+ if((*obj_id =(hid_t_f)H5Oopen_by_idx((hid_t)*loc_id, c_group_name, c_index_type, c_order, (hsize_t)*n, (hid_t)*lapl_id)) < 0)
+ HGOTO_DONE(FAIL);
+
+ done:
+ if(c_group_name)
+ HDfree(c_group_name);
+ return ret_value;
+}
+
+/****if* H5Of/h5oget_comment_c
+ * NAME
+ * h5oget_comment_c
+ * PURPOSE
+ * Calls H5Oget_comment
+ * INPUTS
+ * object_id - Identifier for the target object.
+ * bufsize - Anticipated required size of the comment buffer.
+ * OUTPUTS
+ * comment - The comment.
+ *
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * June 24, 2012
+ * SOURCE
+*/
+int_f
+nh5oget_comment_c (hid_t_f *object_id, _fcd comment, size_t_f *commentsize, hssize_t_f *bufsize)
+/******/
+{
+ char *c_comment = NULL; /* Buffer to hold C string */
+ int_f ret_value = 0; /* Return value */
+ size_t c_commentsize;
+
+ c_commentsize = (size_t)*commentsize + 1;
+
+ /*
+ * Allocate buffer to hold comment name
+ */
+
+ if(NULL == (c_comment = (char *)HDmalloc(c_commentsize)))
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Call H5Oget_comment function.
+ */
+
+ if((*bufsize = (hssize_t_f)H5Oget_comment((hid_t)*object_id, c_comment, (size_t)*commentsize)) < 0)
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Convert C name to FORTRAN and place it in the given buffer
+ */
+ if(c_comment)
+ HD5packFstring(c_comment, _fcdtocp(comment), c_commentsize - 1);
+ return ret_value;
+
+ done:
+ if(c_comment)
+ HDfree(c_comment);
+
+ return ret_value;
+}
+
+/****if* H5Of/h5oget_comment_by_name_c
+ * NAME
+ * h5oget_comment_by_name_c
+ * PURPOSE
+ * Calls H5Oget_comment_by_name
+ * INPUTS
+ * object_id - Identifier for the target object.
+ * bufsize - Anticipated required size of the comment buffer.
+ * OUTPUTS
+ * comment - The comment.
+ *
+ * RETURNS
+ * 0 on success, -1 on failure
+ * AUTHOR
+ * M. Scot Breitenfeld
+ * July 6, 2012
+ * SOURCE
+*/
+int_f
+nh5oget_comment_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *name_size,
+ _fcd comment, size_t_f *commentsize, size_t_f *bufsize, hid_t_f *lapl_id)
+/******/
+{
+ char *c_comment = NULL; /* Buffer to hold C string */
+ char *c_name = NULL; /* Buffer to hold C string */
+ int_f ret_value = 0; /* Return value */
+ size_t c_commentsize;
+
+ /*
+ * Convert FORTRAN string to C string
+ */
+ if((c_name = HD5f2cstring(name, (size_t)*name_size)) == NULL)
+ HGOTO_DONE(FAIL);
+
+ c_commentsize = (size_t)*commentsize + 1;
+
+ /*
+ * Allocate buffer to hold comment name
+ */
+
+ if(NULL == (c_comment = (char *)HDmalloc(c_commentsize)))
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Call H5Oget_comment_by_name function.
+ */
+
+ if((*bufsize = (size_t_f)H5Oget_comment_by_name((hid_t)*loc_id, c_name, c_comment, (size_t)*commentsize,(hid_t)*lapl_id )) < 0)
+ HGOTO_DONE(FAIL);
+
+ /*
+ * Convert C name to FORTRAN and place it in the given buffer
+ */
+ if(c_comment)
+ HD5packFstring(c_comment, _fcdtocp(comment), c_commentsize - 1);
+ return ret_value;
+
+ done:
+ if(c_comment)
+ HDfree(c_comment);
+ if(c_name)
+ HDfree(c_name);
+
+ return ret_value;
+}
diff --git a/fortran/src/H5Off.f90 b/fortran/src/H5Off.f90
index 4f1ea18..2d8509f 100644
--- a/fortran/src/H5Off.f90
+++ b/fortran/src/H5Off.f90
@@ -119,15 +119,15 @@ CONTAINS
! Opens an object in an HDF5 file by location identifier and path name.
!
! Inputs:
-! loc_id - File or group identifier.
-! name - Path to the object, relative to loc_id.
+! loc_id - File or group identifier.
+! name - Path to the object, relative to loc_id.
!
! Outputs:
-! obj_id - Object identifier for the opened object.
-! hdferr - Returns 0 if successful and -1 if fails.
+! obj_id - Object identifier for the opened object.
+! hdferr - Returns 0 if successful and -1 if fails.
!
! Optional parameters:
-! lapl_id - Access property list identifier for the link pointing to the object.
+! lapl_id - Access property list identifier for the link pointing to the object.
!
! AUTHOR
! M. Scot Breitenfeld
@@ -215,12 +215,12 @@ CONTAINS
! Opens an object using its address within an HDF5 file.
!
! Inputs:
-! loc_id - File or group identifier.
-! addr - Object’s address in the file.
+! loc_id - File or group identifier.
+! addr - Object’s address in the file.
!
! Outputs:
-! obj_id - Object identifier for the opened object.
-! hdferr - Returns 0 if successful and -1 if fails.
+! obj_id - Object identifier for the opened object.
+! hdferr - Returns 0 if successful and -1 if fails.
!
! AUTHOR
! M. Scot Breitenfeld
@@ -321,5 +321,455 @@ CONTAINS
END SUBROUTINE h5ocopy_f
+!****s* H5O/h5odecr_refcount_f
+! NAME
+! h5odecr_refcount_f
+!
+! PURPOSE
+! Decrements an object reference count.
+!
+! Inputs:
+! object_id - Object identifier.
+!
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 11, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5odecr_refcount_f(object_id, hdferr)
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: object_id
+ INTEGER , INTENT(OUT) :: hdferr
+!*****
+
+ INTERFACE
+ INTEGER FUNCTION h5odecr_refcount_c(object_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5ODECR_REFCOUNT_C'::h5odecr_refcount_c
+ !DEC$ENDIF
+ INTEGER(HID_T) , INTENT(IN) :: object_id
+ END FUNCTION h5odecr_refcount_c
+ END INTERFACE
+
+ hdferr = h5odecr_refcount_c(object_id)
+
+ END SUBROUTINE h5odecr_refcount_f
+
+!****s* H5O/h5oexists_by_name_f
+! NAME
+! h5oexists_by_name_f
+!
+! PURPOSE
+! Determines whether a link resolves to an actual object.
+!
+! Inputs:
+! loc_id - Identifier of the file or group to query.
+! name - The name of the link to check.
+!
+!
+! Optional parameters:
+! lapl_id - Link access property list identifier.
+!
+! Outputs:
+! link_exists - Existing link resolves to an object.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 11, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5oexists_by_name_f(loc_id, name, link_exists, hdferr, lapl_id)
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ LOGICAL , INTENT(OUT) :: link_exists
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id
+!*****
+
+ INTEGER(size_t) :: namelen
+ INTEGER :: status
+ INTEGER(HID_T) :: lapl_id_default
+
+ INTERFACE
+ INTEGER FUNCTION h5oexists_by_name_c(loc_id, name, namelen, lapl_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OEXISTS_BY_NAME_C'::h5oexists_by_name_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: name
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER(SIZE_T) , INTENT(IN) :: namelen
+ INTEGER(HID_T) , INTENT(IN) :: lapl_id
+
+ END FUNCTION h5oexists_by_name_c
+ END INTERFACE
+
+ namelen = LEN(name)
+
+ lapl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
+
+ status = h5oexists_by_name_c(loc_id, name, namelen, lapl_id_default)
+
+ link_exists = .FALSE.
+ IF(status.EQ.1)THEN
+ link_exists = .TRUE.
+ ENDIF
+
+ hdferr = 0
+ IF(status.LT.0)THEN
+ hdferr = -1
+ ENDIF
+
+ END SUBROUTINE h5oexists_by_name_f
+
+!****s* H5O/h5oget_comment_f
+! NAME
+! h5oget_comment_f
+!
+! PURPOSE
+! Retrieves comment for specified object.
+!
+! Inputs:
+! obj_id - Identifier for the target object.
+!
+! Optional parameters:
+! bufsize - Size of the comment buffer.
+!
+! Outputs:
+! comment - The comment.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 11, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5oget_comment_f(obj_id, comment, hdferr, bufsize)
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: obj_id
+ CHARACTER(LEN=*) , INTENT(OUT) :: comment
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HSSIZE_T), INTENT(OUT), OPTIONAL :: bufsize
+!*****
+
+ INTEGER(SIZE_T) :: commentsize_default
+ INTEGER(HSSIZE_T) :: bufsize_default
+
+ INTERFACE
+ INTEGER FUNCTION h5oget_comment_c(obj_id, comment, commentsize_default, bufsize)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_COMMENT_C'::h5oget_comment_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: comment
+ INTEGER(HID_T) , INTENT(IN) :: obj_id
+ CHARACTER(LEN=*), INTENT(OUT) :: comment
+ INTEGER(SIZE_T) , INTENT(IN) :: commentsize_default
+ INTEGER(HSSIZE_T) , INTENT(OUT) :: bufsize
+ END FUNCTION h5oget_comment_c
+ END INTERFACE
+
+ commentsize_default = LEN(comment)
+
+ hdferr = h5oget_comment_c(obj_id, comment, commentsize_default, bufsize_default)
+
+ IF(PRESENT(bufsize)) bufsize = bufsize_default
+
+ END SUBROUTINE h5oget_comment_f
+
+!****s* H5O/h5oget_comment_by_name_f
+! NAME
+! h5oget_comment_by_name_f
+!
+! PURPOSE
+! Retrieves comment for specified object.
+!
+! Inputs:
+! loc_id - Identifier of a file, group, dataset, or named datatype.
+! name - Name of the object whose comment is to be retrieved,
+! specified as a path relative to loc_id.
+!
+! Optional parameters:
+! bufsize - Size of the comment buffer.
+!
+! Outputs:
+! comment - The comment.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! July 6, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5oget_comment_by_name_f(loc_id, name, comment, hdferr, bufsize, lapl_id)
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ CHARACTER(LEN=*), INTENT(OUT) :: comment
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(SIZE_T) , INTENT(OUT), OPTIONAL :: bufsize
+ INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id
+!*****
+
+ INTEGER(SIZE_T) :: commentsize_default
+ INTEGER(SIZE_T) :: name_size
+ INTEGER(SIZE_T) :: bufsize_default
+ INTEGER(HID_T) :: lapl_id_default
+ INTERFACE
+ INTEGER FUNCTION h5oget_comment_by_name_c(loc_id, name, name_size, &
+ comment, commentsize_default, bufsize_default, lapl_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_COMMENT_BY_NAME_C'::h5oget_comment_by_name_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: comment, name
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER(SIZE_T) , INTENT(IN) :: name_size
+ CHARACTER(LEN=*), INTENT(OUT) :: comment
+ INTEGER(SIZE_T) , INTENT(IN) :: commentsize_default
+ INTEGER(SIZE_T) , INTENT(OUT) :: bufsize_default
+ INTEGER(HID_T) , INTENT(IN) :: lapl_id
+ END FUNCTION h5oget_comment_by_name_c
+ END INTERFACE
+
+ commentsize_default = LEN(comment)
+ name_size = LEN(name)
+
+ lapl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
+
+ hdferr = h5oget_comment_by_name_c(loc_id, name, name_size, &
+ comment, commentsize_default, bufsize_default, lapl_id_default)
+
+ IF(PRESENT(bufsize)) bufsize = bufsize_default
+
+ END SUBROUTINE h5oget_comment_by_name_f
+
+!****s* H5O/h5oincr_refcount_f
+! NAME
+! h5oincr_refcount_f
+!
+! PURPOSE
+! Increments an object reference count.
+!
+! Inputs:
+! obj_id - Object identifier.
+!
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 15, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5oincr_refcount_f(obj_id, hdferr)
+ IMPLICIT NONE
+ INTEGER(HID_T), INTENT(IN) :: obj_id
+ INTEGER , INTENT(OUT) :: hdferr
+!*****
+
+ INTERFACE
+ INTEGER FUNCTION h5oincr_refcount_c(obj_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OINCR_REFCOUNT_C'::h5oincr_refcount_c
+ !DEC$ENDIF
+ INTEGER(HID_T) , INTENT(IN) :: obj_id
+ END FUNCTION h5oincr_refcount_c
+ END INTERFACE
+
+ hdferr = h5oincr_refcount_c(obj_id)
+
+ END SUBROUTINE h5oincr_refcount_f
+
+!****s* H5O/h5oopen_by_idx_f
+!
+! NAME
+! h5oopen_by_idx_f
+!
+! PURPOSE
+! Open the nth object in a group.
+!
+! Inputs:
+! loc_id - A file or group identifier.
+! group_name - Name of group, relative to loc_id, in which object is located.
+! index_type - Type of index by which objects are ordered.
+! order - Order of iteration within index, NOTE: zero-based.
+! n - Object to open.
+!
+! Outputs:
+! obj_id - An object identifier for the opened object.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! Optional parameters:
+! lapl_id - Link access property list.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 17, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5oopen_by_idx_f(loc_id, group_name, index_type, order, n, obj_id, &
+ hdferr, lapl_id)
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: group_name
+ INTEGER , INTENT(IN) :: index_type
+ INTEGER , INTENT(IN) :: order
+ INTEGER(HSIZE_T), INTENT(IN) :: n
+ INTEGER(HID_T) , INTENT(OUT) :: obj_id
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id
+!*****
+ INTEGER(SIZE_T) :: group_namelen
+ INTEGER(HID_T) :: lapl_id_default
+
+ INTERFACE
+ INTEGER FUNCTION h5oopen_by_idx_c(loc_id, group_name, group_namelen, index_type, order, n, obj_id, lapl_id_default)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OOPEN_BY_IDX_C'::h5oopen_by_idx_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: group_name
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: group_name
+ INTEGER(SIZE_T) , INTENT(IN) :: group_namelen
+ INTEGER , INTENT(IN) :: index_type
+ INTEGER , INTENT(IN) :: order
+ INTEGER(HSIZE_T), INTENT(IN) :: n
+ INTEGER(HID_T) , INTENT(IN) :: obj_id
+ INTEGER(HID_T) , INTENT(IN) :: lapl_id_default
+
+ END FUNCTION h5oopen_by_idx_c
+ END INTERFACE
+
+ group_namelen = LEN(group_name)
+
+ lapl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
+
+ hdferr = h5oopen_by_idx_c(loc_id, group_name, group_namelen, index_type, order, n, obj_id, lapl_id_default)
+
+ END SUBROUTINE H5Oopen_by_idx_f
+
+!****s* H5O/h5oset_comment_f
+! NAME
+! h5oset_comment_f
+!
+! PURPOSE
+! Sets comment for specified object.
+!
+! Inputs:
+! obj_id - Identifier of the target object.
+! comment - The new comment.
+!
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 15, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5oset_comment_f(obj_id, comment, hdferr)
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: obj_id
+ CHARACTER(LEN=*), INTENT(IN) :: comment
+ INTEGER , INTENT(OUT) :: hdferr
+!*****
+ INTEGER(SIZE_T) :: commentlen
+
+ INTERFACE
+ INTEGER FUNCTION h5oset_comment_c(obj_id, comment, commentlen)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OSET_COMMENT_C'::h5oset_comment_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: comment
+ INTEGER(HID_T) , INTENT(IN) :: obj_id
+ CHARACTER(LEN=*), INTENT(IN) :: comment
+ INTEGER(SIZE_T) , INTENT(IN) :: commentlen
+
+ END FUNCTION h5oset_comment_c
+ END INTERFACE
+
+ commentlen = LEN(comment)
+
+ hdferr = h5oset_comment_c(obj_id, comment, commentlen)
+
+ END SUBROUTINE h5oset_comment_f
+
+!****s* H5O/h5oset_comment_by_name_f
+! NAME
+! h5oset_comment_by_name_f
+!
+! PURPOSE
+! Sets comment for specified object.
+!
+! Inputs:
+! loc_id - Identifier of a file, group, dataset, or named datatype.
+! name - Name of the object whose comment is to be set or reset,
+! specified as a path relative to loc_id.
+! comment - The new comment.
+!
+! Outputs:
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! Optional parameters:
+! lapl_id - Link access property list identifier.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 15, 2012
+!
+! Fortran90 Interface:
+ SUBROUTINE h5oset_comment_by_name_f(loc_id, name, comment, hdferr, lapl_id)
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ CHARACTER(LEN=*), INTENT(IN) :: comment
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN), OPTIONAL :: lapl_id
+!*****
+ INTEGER(SIZE_T) :: commentlen
+ INTEGER(SIZE_T) :: namelen
+ INTEGER(HID_T) :: lapl_id_default
+
+ INTERFACE
+ INTEGER FUNCTION h5oset_comment_by_name_c(loc_id, name, namelen, comment, commentlen, lapl_id)
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OSET_COMMENT_BY_NAME_C'::h5oset_comment_by_name_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: name, comment
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: comment
+ INTEGER(SIZE_T) , INTENT(IN) :: commentlen
+ CHARACTER(LEN=*), INTENT(IN) :: name
+ INTEGER(SIZE_T) , INTENT(IN) :: namelen
+ INTEGER(HID_T) , INTENT(IN) :: lapl_id
+ END FUNCTION h5oset_comment_by_name_c
+ END INTERFACE
+
+ commentlen = LEN(comment)
+ namelen = LEN(name)
+
+ lapl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
+
+ hdferr = h5oset_comment_by_name_c(loc_id, name, namelen, comment, commentlen, lapl_id_default)
+
+ END SUBROUTINE h5oset_comment_by_name_f
+
END MODULE H5O
diff --git a/fortran/src/H5Off_F03.f90 b/fortran/src/H5Off_F03.f90
index 8eb7a4b..dbd674a 100644
--- a/fortran/src/H5Off_F03.f90
+++ b/fortran/src/H5Off_F03.f90
@@ -181,14 +181,14 @@ CONTAINS
! Inputs:
! loc_id - File or group identifier specifying location of group
! in which object is located.
-! name - Name of group, relative to loc_id
+! name - Name of group, relative to loc_id.
!
! Outputs:
-! object_info - Buffer in which to return object information
-! hdferr - Returns 0 if successful and -1 if fails
+! object_info - Buffer in which to return object information.
+! hdferr - Returns 0 if successful and -1 if fails.
!
! Optional parameters:
-! lapl_id - Link access property list
+! lapl_id - Link access property list.
!
! AUTHOR
! M. Scot Breitenfeld
@@ -218,11 +218,12 @@ CONTAINS
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_INFO_BY_NAME_C'::h5oget_info_by_name_c
!DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: name
INTEGER(HID_T) , INTENT(IN) :: loc_id
CHARACTER(LEN=*), INTENT(IN) :: name
INTEGER(SIZE_T) , INTENT(IN) :: namelen
INTEGER(HID_T) , INTENT(IN) :: lapl_id_default
- TYPE(C_PTR),value :: object_info
+ TYPE(C_PTR),VALUE :: object_info
END FUNCTION h5oget_info_by_name_c
END INTERFACE
@@ -238,5 +239,222 @@ CONTAINS
END SUBROUTINE H5Oget_info_by_name_f
+!****s* H5O (F03)/h5oget_info_f_F03
+!
+! NAME
+! h5oget_info_f
+!
+! PURPOSE
+! Retrieves the metadata for an object specified by an identifier.
+!
+! Inputs:
+! object_id - Identifier for target object.
+!
+! Outputs:
+! object_info - Buffer in which to return object information.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 11, 2012
+!
+! Fortran2003 Interface:
+ SUBROUTINE h5oget_info_f(object_id, object_info, hdferr)
+
+ USE, INTRINSIC :: ISO_C_BINDING
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: object_id
+ TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info
+ INTEGER , INTENT(OUT) :: hdferr
+!*****
+ TYPE(C_PTR) :: ptr
+
+ INTERFACE
+ INTEGER FUNCTION h5oget_info_c(object_id, object_info)
+ USE H5GLOBAL
+ USE, INTRINSIC :: ISO_C_BINDING
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_INFO_C'::h5oget_info_c
+ !DEC$ENDIF
+ INTEGER(HID_T), INTENT(IN) :: object_id
+ TYPE(C_PTR), VALUE :: object_info
+
+ END FUNCTION h5oget_info_c
+ END INTERFACE
+
+ ptr = C_LOC(object_info)
+ hdferr = H5Oget_info_c(object_id, ptr)
+
+ END SUBROUTINE H5Oget_info_f
+
+!****s* H5O (F03)/h5oget_info_by_idx_f_F03
+!
+! NAME
+! h5oget_info_by_idx_f
+!
+! PURPOSE
+! Retrieves the metadata for an object, identifying the object by an index position.
+!
+! Inputs:
+! loc_id - File or group identifier specifying location of group
+! in which object is located.
+! group_name - Name of group in which object is located.
+! index_field - Index or field that determines the order.
+! order - Order within field or index.
+! n - Object for which information is to be returned
+!
+! Outputs:
+! object_info - Buffer in which to return object information.
+! hdferr - Returns 0 if successful and -1 if fails.
+!
+! Optional parameters:
+! lapl_id - Link access property list. (Not currently used.)
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! May 11, 2012
+!
+! Fortran2003 Interface:
+ SUBROUTINE h5oget_info_by_idx_f(loc_id, group_name, index_field, order, n, &
+ object_info, hdferr, lapl_id)
+
+ USE, INTRINSIC :: ISO_C_BINDING
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: group_name
+ INTEGER , INTENT(IN) :: index_field
+ INTEGER , INTENT(IN) :: order
+ INTEGER(HSIZE_T), INTENT(IN) :: n
+ TYPE(h5o_info_t), INTENT(OUT), TARGET :: object_info
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id
+!*****
+ INTEGER :: corder_valid
+ INTEGER(SIZE_T) :: namelen
+ INTEGER(HID_T) :: lapl_id_default
+ TYPE(C_PTR) :: ptr
+
+ INTERFACE
+ INTEGER FUNCTION h5oget_info_by_idx_c(loc_id, group_name, namelen, &
+ index_field, order, n, lapl_id_default, object_info)
+ USE H5GLOBAL
+ USE, INTRINSIC :: ISO_C_BINDING
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OGET_INFO_BY_IDX_C'::h5oget_info_by_idx_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: group_name
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: group_name
+ INTEGER(SIZE_T) , INTENT(IN) :: namelen
+ INTEGER , INTENT(IN) :: index_field
+ INTEGER , INTENT(IN) :: order
+ INTEGER(HSIZE_T), INTENT(IN) :: n
+ INTEGER(HID_T) , INTENT(IN) :: lapl_id_default
+ TYPE(C_PTR), VALUE :: object_info
+
+ END FUNCTION h5oget_info_by_idx_c
+ END INTERFACE
+
+ namelen = LEN(group_name)
+
+ lapl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
+
+ ptr = C_LOC(object_info)
+ hdferr = H5Oget_info_by_idx_c(loc_id, group_name, namelen, index_field, order, n, lapl_id_default, ptr)
+
+ END SUBROUTINE H5Oget_info_by_idx_f
+
+
+!****s* H5O (F03)/h5ovisit_by_name_f_F03
+!
+! NAME
+! h5ovisit_by_name_f
+!
+! PURPOSE
+! Recursively visits all objects starting from a specified object.
+!
+! Inputs:
+! loc_id - Identifier of a file or group.
+! object_name - Name of the object, generally relative to loc_id, that will serve as root of the iteration
+! index_type - Type of index; valid values include:
+! H5_INDEX_NAME_F
+! H5_INDEX_CRT_ORDER_F
+! order - Order in which index is traversed; valid values include:
+! H5_ITER_DEC_F
+! H5_ITER_INC_F
+! H5_ITER_NATIVE_F
+! op - Callback function passing data regarding the group to the calling application
+! op_data - User-defined pointer to data required by the application for its processing of the group
+!
+! Outputs:
+! return_value - Returns the return value of the first operator that returns a positive value, or
+! zero if all members were processed with no operator returning non-zero.
+! hdferr - Returns 0 if successful and -1 if fails
+!
+! Optional parameters:
+! lapl_id - Link access property list identifier.
+!
+! AUTHOR
+! M. Scot Breitenfeld
+! November 19, 2008
+!
+! Fortran2003 Interface:
+ SUBROUTINE h5ovisit_by_name_f(loc_id, object_name, index_type, order, op, op_data, &
+ return_value, hdferr, lapl_id)
+ USE, INTRINSIC :: ISO_C_BINDING
+ IMPLICIT NONE
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: object_name
+ INTEGER , INTENT(IN) :: index_type
+ INTEGER , INTENT(IN) :: order
+
+ TYPE(C_FUNPTR) :: op
+ TYPE(C_PTR) :: op_data
+ INTEGER , INTENT(OUT) :: return_value
+ INTEGER , INTENT(OUT) :: hdferr
+ INTEGER(HID_T) , INTENT(IN) , OPTIONAL :: lapl_id
+!*****
+
+ INTEGER(SIZE_T) :: namelen
+ INTEGER(HID_T) :: lapl_id_default
+ TYPE(C_PTR) :: ptr
+
+ INTERFACE
+ INTEGER FUNCTION h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, &
+ op, op_data, lapl_id)
+ USE, INTRINSIC :: ISO_C_BINDING
+ USE H5GLOBAL
+ !DEC$IF DEFINED(HDF5F90_WINDOWS)
+ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5OVISIT_BY_NAME_C'::h5ovisit_by_name_c
+ !DEC$ENDIF
+ !DEC$ATTRIBUTES reference :: object_name
+ INTEGER(HID_T) , INTENT(IN) :: loc_id
+ CHARACTER(LEN=*), INTENT(IN) :: object_name
+ INTEGER(SIZE_T) :: namelen
+ INTEGER , INTENT(IN) :: index_type
+ INTEGER , INTENT(IN) :: order
+ TYPE(C_FUNPTR) , VALUE :: op
+ TYPE(C_PTR) , VALUE :: op_data
+ INTEGER(HID_T) , INTENT(IN) :: lapl_id
+ END FUNCTION h5ovisit_by_name_c
+ END INTERFACE
+
+ namelen = LEN(object_name)
+
+ lapl_id_default = H5P_DEFAULT_F
+ IF(PRESENT(lapl_id)) lapl_id_default = lapl_id
+
+ return_value = h5ovisit_by_name_c(loc_id, object_name, namelen, index_type, order, &
+ op, op_data, lapl_id_default)
+
+ IF(return_value.GE.0)THEN
+ hdferr = 0
+ ELSE
+ hdferr = -1
+ END IF
+
+ END SUBROUTINE h5ovisit_by_name_f
+
END MODULE H5O_PROVISIONAL
diff --git a/fortran/src/H5Pff.f90 b/fortran/src/H5Pff.f90
index d50e3b9..4254b7f 100644
--- a/fortran/src/H5Pff.f90
+++ b/fortran/src/H5Pff.f90
@@ -6419,3 +6419,5 @@ SUBROUTINE h5pset_attr_phase_change_f(ocpl_id, max_compact, min_dense, hdferr)
END MODULE H5P
+
+
diff --git a/fortran/src/H5_f.c b/fortran/src/H5_f.c
index 7b55384..4c85df2 100644
--- a/fortran/src/H5_f.c
+++ b/fortran/src/H5_f.c
@@ -398,7 +398,11 @@ nh5init_flags_c( int_f *h5d_flags, int_f *h5e_flags, hid_t_f *h5e_hid_flags, int
h5d_flags[19] = (int_f)H5D_CHUNK_CACHE_NSLOTS_DEFAULT;
h5d_flags[20] = (int_f)H5D_CHUNK_CACHE_NBYTES_DEFAULT;
h5d_flags[21] = (int_f)H5D_CHUNK_CACHE_W0_DEFAULT;
-
+ h5d_flags[22] = (int_f)H5D_MPIO_NO_COLLECTIVE;
+ h5d_flags[23] = (int_f)H5D_MPIO_CHUNK_INDEPENDENT;
+ h5d_flags[24] = (int_f)H5D_MPIO_CHUNK_COLLECTIVE;
+ h5d_flags[25] = (int_f)H5D_MPIO_CHUNK_MIXED;
+ h5d_flags[26] = (int_f)H5D_MPIO_CONTIGUOUS_COLLECTIVE;
/*
* H5E flags
*/
diff --git a/fortran/src/H5f90global.f90 b/fortran/src/H5f90global.f90
index 3d4f7f8..2ee0edf 100644
--- a/fortran/src/H5f90global.f90
+++ b/fortran/src/H5f90global.f90
@@ -354,7 +354,7 @@ MODULE H5GLOBAL
! H5D flags declaration
!
- INTEGER, PARAMETER :: H5D_FLAGS_LEN = 22
+ INTEGER, PARAMETER :: H5D_FLAGS_LEN = 27
INTEGER H5D_flags(H5D_FLAGS_LEN)
!DEC$if defined(BUILD_HDF5_DLL)
!DEC$ATTRIBUTES DLLEXPORT :: /H5D_FLAGS/
@@ -387,10 +387,17 @@ MODULE H5GLOBAL
! shortened "_DEFAULT" to "_DFLT" to satisfy the limit of 31
! characters for variable names in Fortran.
+! shortened "_CONTIGUOUS" to "_CONTIG" to satisfy the limit of 31
+! characters for variable names in Fortran.
INTEGER :: H5D_CHUNK_CACHE_NSLOTS_DFLT_F
INTEGER :: H5D_CHUNK_CACHE_NBYTES_DFLT_F
INTEGER :: H5D_CHUNK_CACHE_W0_DFLT_F
+ INTEGER :: H5D_MPIO_NO_COLLECTIVE_F
+ INTEGER :: H5D_MPIO_CHUNK_INDEPENDENT_F
+ INTEGER :: H5D_MPIO_CHUNK_COLLECTIVE_F
+ INTEGER :: H5D_MPIO_CHUNK_MIXED_F
+ INTEGER :: H5D_MPIO_CONTIG_COLLECTIVE_F
EQUIVALENCE(H5D_flags(1), H5D_COMPACT_F)
EQUIVALENCE(H5D_flags(2), H5D_CONTIGUOUS_F)
@@ -419,6 +426,11 @@ MODULE H5GLOBAL
EQUIVALENCE(H5D_flags(20), H5D_CHUNK_CACHE_NSLOTS_DFLT_F)
EQUIVALENCE(H5D_flags(21), H5D_CHUNK_CACHE_NBYTES_DFLT_F)
EQUIVALENCE(H5D_flags(22), H5D_CHUNK_CACHE_W0_DFLT_F)
+ EQUIVALENCE(H5D_flags(23), H5D_MPIO_NO_COLLECTIVE_IO_F)
+ EQUIVALENCE(H5D_flags(24), H5D_MPIO_CHUNK_INDEPENDENT_F)
+ EQUIVALENCE(H5D_flags(25), H5D_MPIO_CHUNK_COLLECTIVE_F)
+ EQUIVALENCE(H5D_flags(26), H5D_MPIO_CHUNK_MIXED_F)
+ EQUIVALENCE(H5D_flags(27), H5D_MPIO_CONTIG_COLLECTIVE_F)
!
! H5E flags declaration
diff --git a/fortran/src/hdf5_fortrandll.def b/fortran/src/hdf5_fortrandll.def
index 735189a..9a687f2 100644
--- a/fortran/src/hdf5_fortrandll.def
+++ b/fortran/src/hdf5_fortrandll.def
@@ -284,10 +284,25 @@ H5L_mp_H5LIS_REGISTERED_F
H5L_mp_H5LMOVE_F
H5L_mp_H5LGET_NAME_BY_IDX_F
; H5O
+H5O_mp_H5OCLOSE_F
H5O_mp_H5OCOPY_F
+H5O_mp_H5ODECR_REFCOUNT_F
+H5O_mp_H5OEXISTS_BY_NAME_F
+H5O_mp_H5OGET_COMMENT_F
+H5O_mp_H5OGET_COMMENT_BY_NAME_F
+H5O_mp_H5OGET_INFO_BY_IDX_F
+H5O_mp_H5OGET_INFO_BY_NAME_F
+H5O_mp_H5OGET_INFO_F
+H5O_mp_H5OINCR_REFCOUNT_F
H5O_mp_H5OLINK_F
-H5O_mp_H5OOPEN_F
H5O_mp_H5OOPEN_BY_ADDR_F
+H5O_mp_H5OOPEN_BY_IDX_F
+H5O_mp_H5OOPEN_F
+H5O_mp_H5OSET_COMMENT_F
+H5O_mp_H5OSET_COMMENT_BY_NAME_F
+H5O_mp_H5OVISIT_BY_NAME_F
+H5O_mp_H5OVISIT_F
+
; H5P
H5P_mp_H5PCREATE_F
H5P_mp_H5PSET_PRESERVE_F
diff --git a/fortran/test/Makefile.am b/fortran/test/Makefile.am
index b261785..42dd127 100644
--- a/fortran/test/Makefile.am
+++ b/fortran/test/Makefile.am
@@ -68,7 +68,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
if FORTRAN_2003_CONDITIONAL_F
fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
- tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90
endif
diff --git a/fortran/test/Makefile.in b/fortran/test/Makefile.in
index 33f1022..43df446 100644
--- a/fortran/test/Makefile.in
+++ b/fortran/test/Makefile.in
@@ -136,11 +136,13 @@ fortranlib_test_1_8_LDADD = $(LDADD)
fortranlib_test_1_8_DEPENDENCIES = libh5test_fortran.la $(LIBH5TEST) \
$(LIBH5F) $(LIBHDF5)
am__fortranlib_test_F03_SOURCES_DIST = fortranlib_test_F03.f90 \
- tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 \
+ tH5T_F03.f90
@FORTRAN_2003_CONDITIONAL_F_TRUE@am_fortranlib_test_F03_OBJECTS = fortranlib_test_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5E_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5L_F03.$(OBJEXT) \
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5O_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5P_F03.$(OBJEXT) \
@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5T_F03.$(OBJEXT)
fortranlib_test_F03_OBJECTS = $(am_fortranlib_test_F03_OBJECTS)
@@ -527,7 +529,7 @@ fortranlib_test_1_8_SOURCES = fortranlib_test_1_8.f90 \
tH5F.f90 tH5O.f90 tH5A_1_8.f90 tH5G_1_8.f90
@FORTRAN_2003_CONDITIONAL_F_TRUE@fortranlib_test_F03_SOURCES = fortranlib_test_F03.f90 \
-@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5P_F03.f90 tH5T_F03.f90
+@FORTRAN_2003_CONDITIONAL_F_TRUE@ tH5F.f90 tH5E_F03.f90 tH5L_F03.f90 tH5O_F03.f90 tH5P_F03.f90 tH5T_F03.f90
fflush1_SOURCES = fflush1.f90
fflush2_SOURCES = fflush2.f90
diff --git a/fortran/test/fortranlib_test_F03.f90 b/fortran/test/fortranlib_test_F03.f90
index c8830d6..a03241c 100644
--- a/fortran/test/fortranlib_test_F03.f90
+++ b/fortran/test/fortranlib_test_F03.f90
@@ -64,10 +64,7 @@ PROGRAM fortranlibtest_F03
! CALL write_test_status(ret_total_error, ' Test error API based on data I/O', total_error)
WRITE(*,*)
-! write(*,*)
-! write(*,*) '========================================='
-! write(*,*) 'Testing DATATYPE interface '
-! write(*,*) '========================================='
+
ret_total_error = 0
CALL test_array_compound_atomic(ret_total_error)
CALL write_test_status(ret_total_error, ' Testing 1-D Array of Compound Datatypes Functionality', total_error)
@@ -122,15 +119,11 @@ PROGRAM fortranlibtest_F03
ret_total_error = 0
CALL test_create(ret_total_error)
- CALL write_test_status(ret_total_error, &
- ' Testing filling functions', &
- total_error)
+ CALL write_test_status(ret_total_error, ' Testing filling functions', total_error)
ret_total_error = 0
CALL test_h5kind_to_type(total_error)
- CALL write_test_status(ret_total_error, &
- ' Test function h5kind_to_type', &
- total_error)
+ CALL write_test_status(ret_total_error, ' Test function h5kind_to_type', total_error)
ret_total_error = 0
CALL test_array_bkg(ret_total_error)
@@ -142,7 +135,7 @@ PROGRAM fortranlibtest_F03
ret_total_error = 0
CALL test_iter_group(ret_total_error)
- CALL write_test_status(ret_total_error, ' Testing Group Iteration Functionality', total_error)
+ CALL write_test_status(ret_total_error, ' Testing group iteration functionality', total_error)
ret_total_error = 0
CALL test_nbit(ret_total_error)
@@ -154,7 +147,18 @@ PROGRAM fortranlibtest_F03
! write(*,*) 'Testing GROUP interface '
! write(*,*) '========================================='
-
+ ret_total_error = 0
+ CALL test_h5o_refcount(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing object functions ', total_error)
+
+ ret_total_error = 0
+ CALL obj_visit(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing object visiting functions ', total_error)
+
+ ret_total_error = 0
+ CALL obj_info(ret_total_error)
+ CALL write_test_status(ret_total_error, ' Testing object info functions ', total_error)
+
WRITE(*,*)
WRITE(*,*) ' ============================================ '
diff --git a/fortran/test/tH5O.f90 b/fortran/test/tH5O.f90
index 247d1d0..b68e7ca 100644
--- a/fortran/test/tH5O.f90
+++ b/fortran/test/tH5O.f90
@@ -35,15 +35,8 @@ SUBROUTINE test_h5o(cleanup, total_error)
INTEGER, INTENT(OUT) :: total_error
INTEGER :: error
- ! /* Output message about test being performed */
- ! WRITE(*,*) "Testing Objects"
-
-!!$ test_h5o_open(); /* Test generic OPEN FUNCTION */
-!!$ test_h5o_open_by_addr(); /* Test opening objects by address */
-!!$ test_h5o_close(); /* Test generic CLOSE FUNCTION */
-!!$ test_h5o_refcount(); /* Test incrementing and decrementing reference count */
- CALL test_h5o_plist(total_error) ! /* Test object creation properties */
- CALL test_h5o_link(total_error) ! /* Test object link routine */
+ CALL test_h5o_plist(total_error) ! Test object creation properties
+ CALL test_h5o_link(total_error) ! Test object link routine
IF(cleanup) CALL h5_cleanup_f("TestFile", H5P_DEFAULT_F, error)
CALL check("h5_cleanup_f", error, total_error)
@@ -100,6 +93,19 @@ SUBROUTINE test_h5o_link(total_error)
INTEGER(HSIZE_T), DIMENSION(1:1) :: dims2 = (/dim0/) ! size read/write buffer
INTEGER , DIMENSION(1:dim0) :: wdata2, & ! Write buffer
rdata2 ! Read buffer
+ LOGICAL :: link_exists
+ CHARACTER(LEN=8) :: chr_exact
+ CHARACTER(LEN=10) :: chr_lg
+ INTEGER(size_t) :: nlinks
+ INTEGER(HID_T) :: plist = -1
+
+ CHARACTER(LEN=20) :: dset_comment = "dataset comment"
+ CHARACTER(LEN=13) :: grp_comment = "group comment"
+ CHARACTER(LEN=10) :: comment_sm ! to small comment sized buffer
+ CHARACTER(LEN=15) :: comment ! exact comment sized buffer
+ CHARACTER(LEN=20) :: comment_lg ! large comment sized buffer
+ INTEGER(HSSIZE_T) :: comment_size
+ INTEGER(SIZE_T) :: comment_size2
! Initialize the raw data
DO i = 1, TEST6_DIM1
@@ -131,8 +137,6 @@ SUBROUTINE test_h5o_link(total_error)
CALL H5Pset_libver_bounds_f(fapl_id, H5F_LIBVER_LATEST_F, H5F_LIBVER_LATEST_F, error)
CALL check("H5Pset_libver_bounds_f",error, total_error)
-!!$ ret = H5Pset_libver_bounds(fapl_id, (new_format ? H5F_LIBVER_LATEST : H5F_LIBVER_EARLIEST), H5F_LIBVER_LATEST);
-
! Create a new HDF5 file
CALL H5Fcreate_f(TEST_FILENAME, H5F_ACC_TRUNC_F, file_id, error, H5P_DEFAULT_F, fapl_id)
CALL check("H5Fcreate_f", error, total_error)
@@ -155,10 +159,9 @@ SUBROUTINE test_h5o_link(total_error)
! Create a dataset with no name using the committed datatype
CALL H5Dcreate_anon_f(file_id, type_id, space_id, dset_id, error ) ! using no optional parameters
CALL check("H5Dcreate_anon_f",error,total_error)
-
-
+ !
! Verify that we can write to and read from the dataset
-
+ !
! Write the data to the dataset
!EP CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata, dims, error, &
@@ -199,7 +202,6 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5tclose_f(type_id, error)
CALL check("h5tclose_f", error, total_error)
-
! Re-open datatype using new link
CALL H5Topen_f(group_id, "datatype", type_id, error)
CALL check("h5topen_f", error, total_error)
@@ -208,12 +210,10 @@ SUBROUTINE test_h5o_link(total_error)
CALL H5Olink_f(group_id, file_id, "/group", error)
CALL check("H5Olink_f", error, total_error)
-
CALL h5gclose_f(group_id, error)
CALL check("h5gclose_f",error,total_error)
! Open dataset through root group and verify its data
-
CALL H5Dopen_f(file_id, "/group/inter_group/dataset", dset_id, error)
CALL check("test_lcpl.h5dopen_f", error, total_error)
@@ -236,7 +236,6 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5tclose_f(type_id, error)
CALL check("h5tclose_f",error,total_error)
-
! Close remaining IDs
CALL h5sclose_f(space_id, error)
CALL check("h5sclose_f",error,total_error)
@@ -264,16 +263,214 @@ SUBROUTINE test_h5o_link(total_error)
CALL check("h5gcreate_f", error, total_error)
CALL h5gcreate_f(file_id,"/G1/G2/G3",group_id,error)
CALL check("h5gcreate_f", error, total_error)
+
+ ! Try putting a comment on the group /G1/G2/G3 by name
+ CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3", grp_comment, error)
+ CALL check("h5oset_comment_by_name_f", error, total_error)
+
+ comment_lg = ' '
+
+ CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3", comment_lg, error)
+ CALL check("h5oget_comment_by_name_f", error, total_error)
+
+ IF(comment_lg(1:13).NE.grp_comment)THEN
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+ IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Try putting a comment on the group /G1/G2/G3 by name with trailing blanks
+
+ CALL h5oset_comment_by_name_f(file_id, "/G1/G2/G3"//' ', grp_comment, error)
+ CALL check("h5oset_comment_by_name_f", error, total_error)
+
+ comment_lg = ' '
+
+ CALL h5oget_comment_by_name_f(file_id, "/G1/G2/G3"//' ', comment_lg, error)
+ CALL check("h5oget_comment_by_name_f", error, total_error)
+
+ IF(comment_lg(1:13).NE.grp_comment)THEN
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+ IF(comment_lg(14:20).NE.' ')THEN ! make sure no NULL terminator
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
!
! Create the dataset
!
CALL h5dcreate_f(group_id, dataset, H5T_STD_I32LE, space_id, dset_id, error)
CALL check("h5dcreate_f", error, total_error)
+
+ ! Putting a comment on the dataset
+ CALL h5oset_comment_f(dset_id, dset_comment, error)
+ CALL check("h5oset_comment_f", error, total_error)
+
+ ! Try reading into a buffer that is the correct size
+
+ CALL h5oget_comment_f(dset_id, comment, error)
+ CALL check("h5oget_comment_f", error, total_error)
+
+ IF(comment(1:15).NE.dset_comment(1:15))THEN
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+
+ ! Try reading into a buffer that is to small
+
+ CALL h5oget_comment_f(dset_id, comment_sm, error)
+ CALL check("h5oget_comment_f", error, total_error)
+
+ IF(comment_sm(1:10).NE.dset_comment(1:10))THEN
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+
+ ! Try reading into a buffer that is larger then needed
+
+ comment_lg = ' '
+
+ CALL h5oget_comment_f(dset_id, comment_lg, error)
+ CALL check("h5oget_comment_f", error, total_error)
+
+ IF(comment_lg(1:15).NE.dset_comment)THEN
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+ IF(comment_lg(16:20).NE.' ')THEN ! make sure no NULL terminator
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+ !
+ ! Check optional parameter
+ !
+ CALL h5oget_comment_f(dset_id, comment_lg, error, comment_size)
+ CALL check("h5oget_comment_f", error, total_error)
+
+ IF( comment_size.NE.15)THEN
+ CALL check("h5oget_comment_f", -1, total_error)
+ ENDIF
+
+ ! CHECK h5oget_comment_by_name_f
+
+ ! Try reading into a buffer that is the correct size
+
+ CALL h5oget_comment_by_name_f(dset_id, ".", comment, error)
+ CALL check("h5oget_comment_by_name_f", error, total_error)
+
+ IF(comment(1:15).NE.dset_comment(1:15))THEN
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Try with trailing blanks in the name
+
+ CALL h5oget_comment_by_name_f(dset_id, ". ", comment, error)
+ CALL check("h5oget_comment_by_name_f", error, total_error)
+
+ IF(comment(1:15).NE.dset_comment(1:15))THEN
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
+ !
+ ! Check optional parameter
+ !
+ CALL h5oget_comment_by_name_f(dset_id, ". ", comment_lg, error, comment_size2)
+ CALL check("h5oget_comment_by_name_f", error, total_error)
+
+ IF( comment_size2.NE.15)THEN
+ CALL check("h5oget_comment_by_name_f", -1, total_error)
+ ENDIF
+
!
! Write the data to the dataset.
!
CALL h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, wdata2, dims2, error)
CALL check("h5dwrite_f", error, total_error)
+
+ ! *************************
+ ! CHECK H5OEXISTS_BY_NAME_F
+ ! *************************
+
+ ! Create a soft link to /G1
+ CALL h5lcreate_soft_f("/G1", file_id, "/G1_LINK", error)
+ CALL check("h5lcreate_soft_f", error, total_error)
+
+
+ ! Create a soft link to /G1000, does not exist
+ CALL h5lcreate_soft_f("/G1000", file_id, "/G1_FALSE", error)
+ CALL check("h5lcreate_soft_f", error, total_error)
+
+ ! Create a soft link to /G1_LINK
+ CALL h5lcreate_soft_f("/G1_FALSE", file_id, "/G2_FALSE", error)
+ CALL check("h5lcreate_soft_f", error, total_error)
+
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ chr_exact = "/G1_LINK"
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,chr_exact, link_exists, error, H5P_DEFAULT_F)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ chr_lg = "/G1_LINK"
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ chr_lg = "/G1_LINK "
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,chr_lg, link_exists, error, H5P_DEFAULT_F)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.NOT.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,"/G1_FALSE", link_exists, error)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should not exist
+ IF(link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Check optional parameter
+
+ CALL h5pcreate_f(H5P_LINK_ACCESS_F,plist,error)
+ CALL check("h5pcreate_f",error,total_error)
+
+ nlinks = 2
+ CALL h5pset_nlinks_f(plist, nlinks, error)
+ CALL check("h5pset_nlinks_f", error, total_error)
+ ! Ensure that nlinks was set successfully
+ nlinks = 0
+ CALL h5pget_nlinks_f(plist, nlinks, error)
+ CALL check("h5pget_nlinks_f",error,total_error)
+ CALL VERIFY("h5pget_nlinks_f", INT(nlinks), 2, total_error)
+
+ ! See if the link exists
+ CALL h5oexists_by_name_f(file_id,"/G1_LINK", link_exists, error, plist)
+ CALL check("h5oexists_by_name_f", error, total_error)
+
+ ! Object should exist
+ IF(.not.link_exists)THEN
+ CALL check("h5oexists_by_name_f", -1, total_error)
+ ENDIF
!
! Close and release resources.
!
@@ -283,6 +480,14 @@ SUBROUTINE test_h5o_link(total_error)
CALL check("h5sclose_f", error, total_error)
CALL h5gclose_f(group_id, error)
CALL check("h5gclose_f", error, total_error)
+
+ ! Test opening an object by index, note
+ CALL h5oopen_by_idx_f(file_id, "/G1/G2/G3", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, group_id, error)
+ CALL check("h5oopen_by_idx_f", error, total_error)
+
+ CALL h5oclose_f(group_id, error)
+ CALL check("h5gclose_f", error, total_error)
+
!
! create property to pass copy options
!
@@ -324,7 +529,7 @@ SUBROUTINE test_h5o_link(total_error)
CALL h5tcopy_f(H5T_NATIVE_INTEGER, tid, error)
CALL check("h5tcopy_f", error, total_error)
- ! create named datatype
+ ! create named datatype
CALL h5tcommit_f(file_id, NAME_DATATYPE_SIMPLE, tid, error)
CALL check("h5tcommit_f", error, total_error)
@@ -346,8 +551,7 @@ SUBROUTINE test_h5o_link(total_error)
! Compare the datatypes
CALL h5tequal_f(tid, tid2, flag, error)
IF(.NOT.flag)THEN
- WRITE(*,*) "h5ocopy_f FAILED"
- total_error = total_error + 1
+ CALL check("h5ocopy_f FAILED", -1, total_error)
ENDIF
! close the destination datatype
@@ -436,7 +640,6 @@ SUBROUTINE test_h5o_plist(total_error)
CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
-
! Create a group, dataset, and committed datatype within the file,
! using the respective type of creation property lists.
!
@@ -472,7 +675,6 @@ SUBROUTINE test_h5o_plist(total_error)
CALL h5sclose_f(dspace, error)
CALL check("h5sclose_f",error,total_error)
-
! Close current creation property lists
CALL h5pclose_f(gcpl,error)
CALL check("h5pclose_f", error, total_error)
@@ -482,7 +684,6 @@ SUBROUTINE test_h5o_plist(total_error)
CALL check("h5pclose_f", error, total_error)
! Retrieve each object's creation property list
-
CALL H5Gget_create_plist_f(grp, gcpl, error)
CALL check("H5Gget_create_plist", error, total_error)
@@ -492,7 +693,6 @@ SUBROUTINE test_h5o_plist(total_error)
CALL H5Dget_create_plist_f(dset, dcpl, error)
CALL check("H5Dget_create_plist_f", error, total_error)
-
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
@@ -509,9 +709,7 @@ SUBROUTINE test_h5o_plist(total_error)
CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
-
! Close current objects
-
CALL h5pclose_f(gcpl,error)
CALL check("h5pclose_f", error, total_error)
CALL h5pclose_f(dcpl,error)
@@ -552,7 +750,6 @@ SUBROUTINE test_h5o_plist(total_error)
CALL H5Dget_create_plist_f(dset, dcpl, error)
CALL check("H5Dget_create_plist_f", error, total_error)
-
! Retrieve attribute phase change values on each creation property list and verify
CALL H5Pget_attr_phase_change_f(gcpl, max_compact, min_dense, error)
CALL check("H5Pget_attr_phase_change_f", error, total_error)
@@ -569,9 +766,7 @@ SUBROUTINE test_h5o_plist(total_error)
CALL VERIFY("H5Pget_attr_phase_change_f", max_compact, (def_max_compact + 1), total_error)
CALL VERIFY("H5Pget_attr_phase_change_f", min_dense, (def_min_dense - 1), total_error)
-
! Close current objects
-
CALL h5pclose_f(gcpl,error)
CALL check("h5pclose_f", error, total_error)
CALL h5pclose_f(dcpl,error)
diff --git a/fortran/test/tH5O_F03.f90 b/fortran/test/tH5O_F03.f90
new file mode 100644
index 0000000..e969c4a
--- /dev/null
+++ b/fortran/test/tH5O_F03.f90
@@ -0,0 +1,547 @@
+!****h* root/fortran/test/tH5O_F03.f90
+!
+! NAME
+! tH5O_F03.f90
+!
+! FUNCTION
+! Test FORTRAN HDF5 H5O APIs which are dependent on FORTRAN 2003
+! features.
+!
+! COPYRIGHT
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! Copyright by The HDF Group. *
+! Copyright by the Board of Trustees of the University of Illinois. *
+! 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 files COPYING and Copyright.html. COPYING can be found at the root *
+! of the source code distribution tree; Copyright.html can be found at the *
+! root level of an installed copy of the electronic HDF5 document set and *
+! is linked from the top-level documents page. It can also be found at *
+! http://hdfgroup.org/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from help@hdfgroup.org. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+!*****
+
+! *****************************************
+! *** H 5 O T E S T S
+! *****************************************
+MODULE visit_cb
+
+ USE HDF5
+ USE ISO_C_BINDING
+
+ IMPLICIT NONE
+
+ INTEGER, PARAMETER :: info_size = 9
+
+ !-------------------------------------------------------------------------
+ ! Function: visit_obj_cb
+ !
+ ! Purpose: Callback routine for visiting objects in a file
+ !
+ ! Return: Success: 0
+ ! Failure: -1
+ !
+ ! Programmer: M.S. Breitenfeld
+ ! July 12, 2012
+ ! Adopted from C test.
+ !
+ !-------------------------------------------------------------------------
+ !
+ ! Object visit structs
+ TYPE, bind(c) :: obj_visit_t
+ CHARACTER(LEN=1), DIMENSION(1:180) :: path ! Path to object
+ INTEGER(c_int) :: type_obj ! type of object
+ END TYPE obj_visit_t
+
+ TYPE, bind(c) :: ovisit_ud_t
+ INTEGER(c_int) :: idx ! Index in object visit structure
+ TYPE(obj_visit_t), DIMENSION(1:info_size) :: info ! Pointer to the object visit structure to use
+ END TYPE ovisit_ud_t
+
+CONTAINS
+
+ INTEGER FUNCTION visit_obj_cb( group_id, name, oinfo, op_data) bind(C)
+
+ IMPLICIT NONE
+
+ INTEGER(HID_T) :: group_id
+ CHARACTER(LEN=1), DIMENSION(1:180) :: name
+ TYPE(h5o_info_t) :: oinfo
+ TYPE(ovisit_ud_t) :: op_data
+
+ INTEGER :: len, i
+ INTEGER(C_INT) :: idx
+
+ visit_obj_cb = 0
+
+ ! Since the name is generated in C and passed to a Fortran string, it
+ ! will be NULL terminated, so we need to find the end of the string.
+
+ len = 1
+ DO len = 1, 180
+ IF(name(len) .EQ. C_NULL_CHAR) EXIT
+ ENDDO
+
+ len = len - 1
+
+ ! Check for correct object information
+
+ idx = op_data%idx
+
+ DO i = 1, len
+ IF(op_data%info(idx)%path(i)(1:1) .NE. name(i)(1:1))THEN
+ visit_obj_cb = -1
+ RETURN
+ ENDIF
+
+ IF(op_data%info(idx)%type_obj .NE. oinfo%type)THEN
+ visit_obj_cb = -1
+ RETURN
+ ENDIF
+
+ ENDDO
+
+ ! Advance to next location in expected output
+ op_data%idx = op_data%idx + 1
+
+ END FUNCTION visit_obj_cb
+
+END MODULE visit_cb
+
+!/****************************************************************
+!**
+!** test_h5o_refcount(): Test H5O refcounting functions.
+!**
+!****************************************************************/
+
+SUBROUTINE test_h5o_refcount(total_error)
+
+ USE HDF5
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+
+ INTEGER, INTENT(INOUT) :: total_error
+
+ CHARACTER(LEN=11), PARAMETER :: FILENAME = "th5o_ref.h5"
+ INTEGER, PARAMETER :: DIM0 = 5
+ INTEGER, PARAMETER :: DIM1 = 10
+ INTEGER(hid_t) :: fid ! HDF5 File ID
+ INTEGER(hid_t) :: grp, dset, dtype, dspace ! Object identifiers
+ TYPE(h5o_info_t) :: oinfo ! Object info struct
+ INTEGER(hsize_t), DIMENSION(1:2) :: dims
+ INTEGER :: error ! Value returned from API calls
+
+ ! Create a new HDF5 file
+ CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid,error)
+ CALL check("h5fcreate_f", error, total_error)
+
+ ! Create a group, dataset, and committed datatype within the file
+ ! Create the group
+ CALL h5gcreate_f(fid, "group", grp, error)
+ CALL check("h5gcreate_f",error, total_error)
+
+ ! Commit the type inside the group
+ CALL h5tcopy_f(H5T_NATIVE_INTEGER, dtype, error)
+ CALL check("H5Tcopy_f",error, total_error)
+ CALL h5tcommit_f(fid, "datatype", dtype, error)
+ CALL check("h5tcommit_f", error, total_error)
+
+ ! Create the data space for the dataset.
+ dims(1) = DIM0
+ dims(2) = DIM1
+
+ CALL h5screate_simple_f(2, dims, dspace, error)
+ CALL check("h5screate_simple_f", error, total_error)
+
+ ! Create the dataset.
+ CALL h5dcreate_f(fid, "dataset", H5T_NATIVE_INTEGER, dspace, dset, error)
+ CALL check("h5dcreate_f", error, total_error)
+ CALL h5sclose_f(dspace, error)
+ CALL check("h5sclose_f", error, total_error)
+
+ ! Get ref counts for each object. They should all be 1, since each object has a hard link.
+ CALL h5oget_info_by_name_f(fid, "group", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Check h5oget_info
+ CALL h5oget_info_f(grp, oinfo, error)
+ CALL check("h5oget_info_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_f", -1, total_error)
+ ENDIF
+ IF(oinfo%type.NE.H5O_TYPE_GROUP_F)THEN
+ CALL check("h5oget_info_f", -1, total_error)
+ ENDIF
+
+ ! Increment each object's reference count.
+ CALL h5oincr_refcount_f(grp, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5oincr_refcount_f(dtype, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5oincr_refcount_f(dset, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+
+ ! Get ref counts for each object. They should all be 2 now.
+ CALL h5oget_info_by_name_f(fid, "group", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.2)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.2)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.2)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+
+ ! Decrement the reference counts and check that they decrease back to 1.
+ CALL h5odecr_refcount_f(grp, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5odecr_refcount_f(dtype, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+ CALL h5odecr_refcount_f(dset, error)
+ CALL check("h5oincr_refcount_f", error, total_error)
+
+ CALL h5oget_info_by_name_f(fid, "group", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "datatype", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+ CALL h5oget_info_by_name_f(fid, "dataset", oinfo, error)
+ CALL check("h5oget_info_by_name_f", error, total_error)
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_name_f", -1, total_error)
+ ENDIF
+
+ CALL h5gclose_f(grp, error)
+ CALL check("h5gclose_f",error, total_error)
+ CALL h5tclose_f(dtype, error)
+ CALL check("h5tclose_f",error, total_error)
+ CALL h5dclose_f(dset, error)
+ CALL check("h5dclose_f",error, total_error)
+ CALL h5fclose_f(fid, error)
+ CALL check("h5fclose_f",error, total_error)
+
+END SUBROUTINE test_h5o_refcount
+
+!****************************************************************
+!**
+!** test_h5o_refcount(): Test H5O visit functions.
+!**
+!****************************************************************
+
+SUBROUTINE obj_visit(total_error)
+
+ USE HDF5
+
+ USE visit_cb
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+
+ INTEGER, INTENT(INOUT) :: total_error
+
+ TYPE(ovisit_ud_t), TARGET :: udata ! User-data for visiting
+ INTEGER(hid_t) :: fid = -1
+ INTEGER(hid_t) :: gid = -1 ! Group ID
+ TYPE(C_PTR) :: f_ptr
+ TYPE(C_FUNPTR) :: fun_ptr
+ CHARACTER(LEN=180) :: object_name
+ INTEGER :: ret_val
+ INTEGER :: error
+
+ ! Construct "interesting" file to visit
+ CALL build_visit_file(fid)
+
+ ! Inialize udata for testing purposes
+ udata%info(1)%path(1:1) ="."
+ udata%info(1)%type_obj = H5O_TYPE_GROUP_F
+ udata%info(2)%path(1:12) = &
+ (/"D","a","t","a","s","e","t","_","z","e","r","o"/)
+ udata%info(2)%type_obj =H5O_TYPE_DATASET_F
+ udata%info(3)%path(1:6) = &
+ (/"G","r","o","u","p","1"/)
+ udata%info(3)%type_obj = H5O_TYPE_GROUP_F
+ udata%info(4)%path(1:18) =&
+ (/"G","r","o","u","p","1","/","D","a","t","a","s","e","t","_","o","n","e"/)
+ udata%info(4)%type_obj = H5O_TYPE_DATASET_F
+ udata%info(5)%path(1:13) =&
+ (/"G","r","o","u","p","1","/","G","r","o","u","p","2"/)
+ udata%info(5)%type_obj = H5O_TYPE_GROUP_F
+ udata%info(6)%path(1:25) =&
+ (/"G","r","o","u","p","1","/","G","r","o","u","p","2","/","D","a","t","a","s","e","t","_","t","w","o"/)
+ udata%info(6)%type_obj = H5O_TYPE_DATASET_F
+ udata%info(7)%path(1:22) =&
+ (/"G","r","o","u","p","1","/","G","r","o","u","p","2","/","T","y","p","e","_","t","w","o"/)
+ udata%info(7)%type_obj = H5O_TYPE_NAMED_DATATYPE_F
+ udata%info(8)%path(1:15) =&
+ (/"G","r","o","u","p","1","/","T","y","p","e","_","o","n","e"/)
+ udata%info(8)%type_obj = H5O_TYPE_NAMED_DATATYPE_F
+ udata%info(9)%path(1:9) =&
+ (/"T","y","p","e","_","z","e","r","o"/)
+ udata%info(9)%type_obj = H5O_TYPE_NAMED_DATATYPE_F
+
+ ! Visit all the objects reachable from the root group (with file ID)
+ udata%idx = 1
+
+ fun_ptr = C_FUNLOC(visit_obj_cb)
+ f_ptr = C_LOC(udata)
+
+ ! Test h5ovisit_f
+ CALL h5ovisit_f(fid, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error)
+ CALL check("h5ovisit_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_f", -1, total_error)
+ ENDIF
+
+ ! Test h5ovisit_by_name_f
+
+ object_name = "/"
+ udata%idx = 1
+
+ CALL h5ovisit_by_name_f(fid, object_name, H5_INDEX_NAME_F, H5_ITER_INC_F, fun_ptr, f_ptr, ret_val, error)
+ CALL check("h5ovisit_by_name_f", error, total_error)
+ IF(ret_val.LT.0)THEN
+ CALL check("h5ovisit_by_name_f", -1, total_error)
+ ENDIF
+
+ CALL h5fclose_f(fid, error)
+ CALL check("h5fclose_f",error, total_error)
+
+END SUBROUTINE obj_visit
+
+!****************************************************************
+!**
+!** test_h5o_refcount(): Test H5O info functions.
+!**
+!****************************************************************
+
+SUBROUTINE obj_info(total_error)
+
+ USE HDF5
+ USE ISO_C_BINDING
+ IMPLICIT NONE
+
+ INTEGER, INTENT(INOUT) :: total_error
+
+ INTEGER(hid_t) :: fid = -1 ! File ID
+ INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs
+ INTEGER(hid_t) :: did ! Dataset ID
+ INTEGER(hid_t) :: sid ! Dataspace ID
+ TYPE(hobj_ref_t_f), TARGET :: wref ! Reference to write
+ TYPE(hobj_ref_t_f), TARGET :: rref ! Reference to read
+ TYPE(H5O_info_t) :: oinfo ! Object info struct
+ INTEGER :: count = 0 ! Count within iterated group
+ INTEGER :: error
+ TYPE(C_PTR) :: f_ptr
+
+ CHARACTER(LEN=6) :: GROUPNAME = "/group"
+ CHARACTER(LEN=6) :: GROUPNAME2 = "group2"
+ CHARACTER(LEN=6) :: GROUPNAME3 = "group3"
+ CHARACTER(LEN=5) :: DSETNAME = "/dset"
+ CHARACTER(LEN=5) :: DSETNAME2 = "dset2"
+
+ ! Create file with a group and a dataset containing an object reference to the group
+ CALL h5fcreate_f("get_info.h5", H5F_ACC_TRUNC_F, fid, error)
+ CALL check("h5fcreate_f",error, total_error)
+
+ ! Create dataspace to use for dataset
+ CALL h5screate_f(H5S_SCALAR_F, sid, error)
+ CALL check("h5screate_f",error,total_error)
+
+ ! Create group to refer to
+ CALL h5gcreate_f(fid, GROUPNAME, gid, error)
+ CALL check("h5gcreate_f",error,total_error)
+
+ ! Create nested groups
+ CALL h5gcreate_f(gid, GROUPNAME2, gid2, error)
+ CALL check("h5gcreate_f",error,total_error)
+ CALL h5gclose_f(gid2, error)
+ CALL check("h5gclose_f",error,total_error)
+
+ CALL h5gcreate_f(gid, GROUPNAME3, gid2, error)
+ CALL check("h5gcreate_f",error,total_error)
+ CALL h5gclose_f(gid2, error)
+ CALL check("h5gclose_f",error,total_error)
+
+ ! Create bottom dataset
+ CALL h5dcreate_f(gid, DSETNAME2, 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 h5gclose_f(gid, error)
+ CALL check("h5gclose_f",error,total_error)
+
+ ! Create dataset
+ CALL h5dcreate_f(fid, DSETNAME, H5T_STD_REF_OBJ, sid, did, error)
+ CALL check("h5dcreate_f",error, total_error)
+
+ f_ptr = C_LOC(wref)
+
+ ! Create reference to group
+ CALL h5rcreate_f(fid, GROUPNAME, H5R_OBJECT_F, f_ptr, error)
+ CALL check("h5rcreate_f",error, total_error)
+
+ ! Write reference to disk
+ CALL h5dwrite_f(did, H5T_STD_REF_OBJ, f_ptr, error)
+ CALL check("h5dwrite_f",error, total_error)
+
+ ! Close objects
+ CALL h5dclose_f(did, error)
+ CALL check("h5dclose_f", error, total_error)
+ CALL h5sclose_f(sid, error)
+ CALL check("h5sclose_f", error, total_error)
+ CALL h5fclose_f(fid, error)
+ CALL check("h5fclose_f", error, total_error)
+
+ ! Re-open file
+ CALL h5fopen_f("get_info.h5", H5F_ACC_RDWR_F, fid, error)
+ CALL check("h5fopen_f", error, total_error)
+
+ ! Re-open dataset
+ CALL h5dopen_f(fid, DSETNAME, did, error)
+ CALL check("h5dopen_f", error, total_error)
+
+ ! Read in the reference
+
+ f_ptr = C_LOC(rref)
+
+ CALL h5dread_f(did, H5T_STD_REF_OBJ, f_ptr, error)
+ CALL check("H5Dread_f",error, total_error)
+
+ ! Dereference to get the group
+
+ CALL h5rdereference_f(did, H5R_OBJECT_F, f_ptr, gid, error)
+ CALL check("h5rdereference_f", error, total_error)
+
+ CALL h5oget_info_by_idx_f(gid, ".", H5_INDEX_NAME_F, H5_ITER_INC_F, 0_hsize_t, oinfo, error)
+ CALL check("h5oget_info_by_idx_f", error, total_error)
+
+ IF(oinfo%rc.NE.1)THEN
+ CALL check("h5oget_info_by_idx_f", -1, total_error)
+ ENDIF
+
+ IF(oinfo%type.NE.H5O_TYPE_DATASET_F)THEN
+ CALL check("h5oget_info_by_idx_f", -1, total_error)
+ ENDIF
+
+ ! Close objects
+ CALL h5dclose_f(did, error)
+ CALL check("h5dclose_f", error, total_error)
+ CALL h5gclose_f(gid, error)
+ CALL check("h5sclose_f", error, total_error)
+ CALL h5fclose_f(fid, error)
+ CALL check("h5fclose_f", error, total_error)
+
+END SUBROUTINE obj_info
+
+!-------------------------------------------------------------------------
+! Function: build_visit_file
+!
+! Purpose: Build an "interesting" file to use for visiting links & objects
+!
+! Programmer: M. Scot Breitenfeld
+! July 12, 2012
+! NOTE: Adapted from C test.
+!
+!-------------------------------------------------------------------------
+!
+
+SUBROUTINE build_visit_file(fid)
+
+ USE HDF5
+ IMPLICIT NONE
+
+ INTEGER(hid_t) :: fid ! File ID
+ INTEGER(hid_t) :: gid = -1, gid2 = -1 ! Group IDs
+ INTEGER(hid_t) :: sid = -1 ! Dataspace ID
+ INTEGER(hid_t) :: did = -1 ! Dataset ID
+ INTEGER(hid_t) :: tid = -1 ! Datatype ID
+ CHARACTER(LEN=20) :: filename = 'visit.h5'
+ INTEGER :: error
+
+ ! Create file for visiting
+ CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, fid, error)
+
+ ! Create group
+ CALL H5Gcreate_f(fid, "/Group1", gid, error)
+
+ ! Create nested group
+ CALL H5Gcreate_f(gid, "Group2", gid2, error)
+
+ ! Close groups
+ CALL h5gclose_f(gid2, error)
+ CALL h5gclose_f(gid, error)
+
+ ! Create soft links to groups created
+ CALL H5Lcreate_soft_f("/Group1", fid, "/soft_one", error)
+ CALL H5Lcreate_soft_f("/Group1/Group2", fid, "/soft_two", error)
+
+ ! Create dangling soft link
+ CALL H5Lcreate_soft_f("nowhere", fid, "/soft_dangle", error)
+
+ ! Create hard links to all groups
+ CALL H5Lcreate_hard_f(fid, "/", fid, "hard_zero", error)
+ CALL H5Lcreate_hard_f(fid, "/Group1", fid, "hard_one", error)
+ CALL H5Lcreate_hard_f(fid, "/Group1/Group2", fid, "hard_two", error)
+
+ ! Create loops w/hard links
+ CALL H5Lcreate_hard_f(fid, "/Group1", fid, "/Group1/hard_one", error)
+ CALL H5Lcreate_hard_f(fid, "/", fid, "/Group1/Group2/hard_zero", error)
+
+ ! Create dataset in each group
+ CALL H5Screate_f(H5S_SCALAR_F, sid, error)
+
+ CALL H5Dcreate_f(fid, "/Dataset_zero", H5T_NATIVE_INTEGER, sid, did, error)
+ CALL H5Dclose_f(did, error)
+
+ CALL H5Dcreate_f(fid, "/Group1/Dataset_one", H5T_NATIVE_INTEGER, sid, did, error)
+ CALL H5Dclose_f(did, error)
+
+ CALL H5Dcreate_f(fid, "/Group1/Group2/Dataset_two", H5T_NATIVE_INTEGER, sid, did, error)
+ CALL H5Dclose_f(did, error)
+
+ CALL H5Sclose_f(sid, error)
+
+ ! Create named datatype in each group
+ CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+
+ CALL H5Tcommit_f(fid, "/Type_zero", tid, error)
+ CALL H5Tclose_f(tid, error)
+
+ CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+ CALL H5Tcommit_f(fid, "/Group1/Type_one", tid, error)
+ CALL H5Tclose_f(tid, error)
+
+ CALL H5Tcopy_f(H5T_NATIVE_INTEGER, tid, error)
+ CALL H5Tcommit_f(fid, "/Group1/Group2/Type_two", tid, error)
+ CALL H5Tclose_f(tid, error)
+
+END SUBROUTINE build_visit_file
diff --git a/fortran/test/tH5T_F03.f90 b/fortran/test/tH5T_F03.f90
index 7c99856..da35696 100644
--- a/fortran/test/tH5T_F03.f90
+++ b/fortran/test/tH5T_F03.f90
@@ -103,7 +103,7 @@ SUBROUTINE test_array_compound_atomic(total_error)
! Create file
CALL h5fcreate_f(FILENAME,H5F_ACC_TRUNC_F,fid1,error)
- CALL check("h5fcreate_f", error, total_error)
+ CALL check("h5fcreate_f", error, total_error)
! Create dataspace for datasets
CALL h5screate_simple_f(SPACE1_RANK, sdims1, sid1, error)
@@ -1988,6 +1988,7 @@ SUBROUTINE t_regref(total_error)
TYPE(C_PTR) :: f_ptr
CHARACTER(LEN=ds2dim0) :: chrvar
CHARACTER(LEN=20), DIMENSION(1:2) :: chrref_correct
+ TYPE(h5o_info_t) :: oinfo ! Object info struct
chrvar = "The quick brown "
READ(chrvar,'(16A1)') wdata2(1:16,1)
@@ -2097,7 +2098,7 @@ SUBROUTINE t_regref(total_error)
f_ptr = C_LOC(rdata(i))
CALL H5Rdereference_f(dset, H5R_DATASET_REGION_F, f_ptr, dset2, error)
CALL check("H5Rdereference_f",error, total_error)
-
+
CALL H5Rget_region_f(dset, f_ptr, space, error)
CALL check("H5Rget_region_f",error, total_error)