summaryrefslogtreecommitdiffstats
path: root/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'fortran')
-rw-r--r--fortran/src/H5Ef.c148
-rw-r--r--fortran/src/H5Eff_F03.f90154
-rw-r--r--fortran/src/H5f90proto.h57
-rw-r--r--fortran/test/tH5E_F03.f908
4 files changed, 64 insertions, 303 deletions
diff --git a/fortran/src/H5Ef.c b/fortran/src/H5Ef.c
index 875b59f..c0d7a77 100644
--- a/fortran/src/H5Ef.c
+++ b/fortran/src/H5Ef.c
@@ -319,151 +319,3 @@ nh5eset_auto2_c(int_f *printflag, hid_t_f *estack_id, H5E_auto2_t func, void *cl
return ret_val;
}
-
-int_f
-H5Eget_auto3(void **client_data)
-{
- int *i;
-
- i = (int*)client_data;
-
- *i = 1000;
- printf(" Buffer In (C) = %d \n", *i);
-
- return 0;
-
-}
-
-int_f nprocess_buffer(hid_t_f *estack_id, void **buffer)
-{
- int status;
- int *i;
- H5E_auto2_t func_c;
-
- status = H5Eget_auto2((hid_t)*estack_id, &func_c, buffer);
-/* status = H5Eget_auto3(buffer); */
-
- i = (int*)buffer;
-
- printf(" Buffer In (C) = %d \n", *i);
- return;
-}
-/****if* H5Ef/h5eget_auto_c
- * NAME
- * h5eget_auto_c
- * PURPOSE
- * Calls H5Eget_auto2
- * INPUTS
- * estack_id - Error stack identifier
- * OUTPUTS
- * func - The function currently set to be called upon an error condition.
- * client_data - Data currently set to be passed to the error function.
- * RETURNS
- * 0 on success, -1 on failure
- * AUTHOR
- * M. Scot Breitenfeld
- * July 10, 2009
- * NOTE
- * if func is the default H5Eprint or H5Eprint2 then need to use the Fortran callback function
- * associated with H5Eprint*.
- * SOURCE
-*/
-int_f
-nh5eget_auto_c(hid_t_f *estack_id, H5E_auto2_t *func, void **client_data, int_f *ret_func)
-/******/
-{
- int ret_val = -1;
- herr_t status = -1;
- hid_t dataset;
- H5E_auto2_t func_c;
- void *client_data_c=NULL;
- void **data_c;
- int *i;
-
-/* status = H5Eget_auto3(client_data); */
-/* i = (int*)client_data; */
-
-/* printf(" Buffer In (C3) = %d \n", *i); */
-
-/* return 0; */
-
-/* *ret_func = -1; */
-
- status = H5Eget_auto2((hid_t)*estack_id, &func_c, &client_data_c);
-
-/* status = H5Eget_auto2((hid_t)*estack_id, &func_c, client_data); */
-
- i = (int*)*client_data;
-
-/* *i = 1000; */
-
-
-/* i = (int*)client_data_c; */
-/* *i = 100; */
-
-/* *client_data = client_data_c; */
-/* *data_c = client_data_c; */
-
- printf("aa %d \n",*((int*)client_data_c));
-/* printf("bb %d \n",**((int**)client_data)); */
-/* printf("cc %d \n",**((int**)data_c)); */
-
-/* printf("a %p \n",client_data_c); */
-/* printf("b %p \n",*client_data); */
-/* printf("c %p \n",*data_c); */
-
-/* i = (int*)client_data_c; */
-/* **client_data = *((int*)client_data_c);*/
-
-/* *i = 200; */
-
-/* if(client_data == NULL) */
-/* printf("error \n"); */
-
-/* if(func == NULL) */
-/* printf("error \n"); */
-
-/* #ifdef H5_USE_16_API */
-/* if (func == (H5E_auto_t)H5Eprint) */
-/* *ret_func = 0; */
-/* #else /\* H5_USE_16_API *\/ */
-/* if (func == (H5E_auto2_t)H5Eprint2) */
-/* *ret_func = 0; */
-/* #endif /\* H5_USE_16_API *\/ */
-
-/* #ifdef H5_USE_16_API */
-/* if (func == (H5E_auto_t)H5Eprint) */
-/* *ret_func = 0; */
-/* #else /\* H5_USE_16_API *\/ */
-/* if (func == (H5E_auto2_t)H5Eprint2) */
-/* *ret_func = 0; */ /* printf("%p %p \n",func,(H5E_auto2_t)H5Eprint2); */
-/* #endif /\* H5_USE_16_API *\/ */
-
-/* printf(" ret %d \n", ret_val); */
- if (status >= 0) ret_val = 0;
- ret_func = 0;
- return ret_val;
-}
-
-void*
-nh5eget_auto_c2(hid_t_f *estack_id, H5E_auto2_t *func, int_f *ret_func)
-/******/
-{
- int ret_val = -1;
- herr_t status = -1;
- hid_t dataset;
- H5E_auto2_t func_c;
- void *client_data_c=NULL;
- void **data_c;
- int *i;
-
- status = H5Eget_auto2((hid_t)*estack_id, &func_c, &client_data_c);
-
- printf("a %p \n",client_data_c);
-
-
- if (status >= 0) ret_val = 0;
- ret_func = 0;
- return client_data_c;
-}
-
diff --git a/fortran/src/H5Eff_F03.f90 b/fortran/src/H5Eff_F03.f90
index bf4797f..164f203 100644
--- a/fortran/src/H5Eff_F03.f90
+++ b/fortran/src/H5Eff_F03.f90
@@ -1,7 +1,7 @@
!****h* ROBODoc/H5E (F03)
!
! NAME
-! H5L_PROVISIONAL
+! H5E_PROVISIONAL
!
! FILE
! src/fortran/src/H5Eff_F03.f90
@@ -9,9 +9,9 @@
! PURPOSE
!
! This file contains Fortran 90 and Fortran 2003 interfaces for H5E functions.
-! It contains the same functions as H5Eff_DEPRECIATE.f90 but includes the
+! It contains the same functions as H5Eff_F90.f90 but includes the
! Fortran 2003 functions and the interface listings. This file will be compiled
-! instead of H5Eff_DEPRECIATE.f90 if Fortran 2003 functions are enabled.
+! instead of H5Eff_F90.f90 if Fortran 2003 functions are enabled.
!
!
! COPYRIGHT
@@ -44,24 +44,10 @@ MODULE H5E_PROVISIONAL
CONTAINS
- INTEGER FUNCTION h5eprint_def() bind(C)
-
- USE ISO_C_BINDING
- IMPLICIT NONE
- INTEGER :: hdferr
-
- PRINT*,'Inside h5eprint_def'
-! STOP
-
-!!$ CALL h5eprint_f(hdferr)
-!!$ h5eprint_def = hdferr
-
- END FUNCTION h5eprint_def
-
-!****s* H5E/h5eset_auto2_f
+!****s* H5E/h5eset_auto_f
!
! NAME
-! h5eset_auto2_f
+! h5eset_auto_f
!
! PURPOSE
! Returns settings for automatic error stack traversal function and its data.
@@ -82,9 +68,9 @@ CONTAINS
! M. Scot Breitenfeld
! July 10, 2009
!
-! Signature:
+! Fortran2003 Interface:
SUBROUTINE h5eset_auto_f(printflag, hdferr, estack_id, func, client_data)
- USE ISO_C_BINDING
+ USE, INTRINSIC :: ISO_C_BINDING
INTEGER , INTENT(IN) :: printflag
INTEGER , INTENT(OUT) :: hdferr
INTEGER(HID_T), INTENT(IN) , OPTIONAL :: estack_id
@@ -96,7 +82,7 @@ CONTAINS
TYPE(C_PTR) :: client_data_default
INTERFACE
INTEGER FUNCTION h5eset_auto2_c(printflag, estack_id, func, client_data)
- USE ISO_C_BINDING
+ USE, INTRINSIC :: ISO_C_BINDING
USE H5GLOBAL
!DEC$IF DEFINED(HDF5F90_WINDOWS)
!DEC$ATTRIBUTES C,reference,decorate,alias:'H5ESET_AUTO2_C'::h5eset_auto2_c
@@ -121,128 +107,4 @@ CONTAINS
hdferr = h5eset_auto2_c(printflag, estack_id_default, func_default, client_data_default)
END SUBROUTINE h5eset_auto_f
-!****s* H5E/h5eget_auto_f
-!
-! NAME
-! h5eget_auto_f
-!
-! PURPOSE
-! Returns the settings for the automatic error stack traversal function and its data.
-!
-! Inputs:
-! estack_id - Error stack identifier. H5E_DEFAULT_F indicates the current stack.
-! Outputs:
-! func - The function currently set to be called upon an error condition.
-! client_data - Data currently set to be passed to the error function.
-! hdferr - Returns 0 if successful and -1 if fails.
-!
-! AUTHOR
-! M. Scot Breitenfeld
-! July 10, 2009
-!
-! Signature:
- SUBROUTINE h5eget_auto_f(estack_id, op, client_data, hdferr)
- USE ISO_C_BINDING
- IMPLICIT NONE
- INTEGER(HID_T), INTENT(IN) :: estack_id
-!!$ TYPE(C_FUNPTR) :: op_f
-!!$ TYPE(C_PTR) :: client_data_f
- TYPE(C_FUNPTR) :: op
- TYPE(C_PTR), VALUE :: client_data
- INTEGER, INTENT(OUT) :: hdferr
-!*****
- INTEGER :: ret_func2
- !INTEGER(C_INT), DIMENSION(:), POINTER :: ptr_data
- INTEGER, DIMENSION(1:1) :: array_shape
- TYPE(C_PTR), TARGET :: f_ptr1
- INTEGER(C_INT) :: ptr_data
- INTEGER(C_INT) :: i
- TYPE(C_PTR) :: test
- INTEGER, POINTER :: a
-
- INTEGER, TARGET :: j
- TYPE(C_PTR) :: f_ptr2
-
- INTERFACE
- INTEGER FUNCTION h5eget_auto_c(estack_id, op, client_data, ret_func2)
- USE ISO_C_BINDING
- USE H5GLOBAL
- IMPLICIT NONE
- !DEC$IF DEFINED(HDF5F90_WINDOWS)
- !DEC$ATTRIBUTES C,reference,decorate,alias:'H5EGET_AUTO_C'::h5eget_auto_c
- !DEC$ENDIF
- INTEGER(HID_T) :: estack_id
- TYPE(C_FUNPTR) :: op
- TYPE(C_PTR) :: client_data
- INTEGER :: ret_func2
- END FUNCTION h5eget_auto_c
-
-!!$ TYPE(C_PTR) FUNCTION h5eget_auto_c2(estack_id, op, ret_func2)
-!!$ USE ISO_C_BINDING
-!!$ USE H5GLOBAL
-!!$ IMPLICIT NONE
-!!$ !DEC$IF DEFINED(HDF5F90_WINDOWS)
-!!$ !DEC$ATTRIBUTES C,reference,decorate,alias:'H5EGET_AUTO_C'::h5eget_auto_c
-!!$ !DEC$ENDIF
-!!$ INTEGER(HID_T) :: estack_id
-!!$ TYPE(C_FUNPTR) :: op
-!!$ INTEGER :: ret_func2
-!!$ END FUNCTION h5eget_auto_c2
-
-!!$ SUBROUTINE process_buffer(estack_id, buffer)
-!!$ USE, INTRINSIC :: ISO_C_BINDING
-!!$ USE H5GLOBAL
-!!$ INTEGER(HID_T) :: estack_id
-!!$ TYPE(C_PTR) :: buffer
-!!$ END SUBROUTINE process_buffer
-
- END INTERFACE
-
-! j = -9999
-
-
- f_ptr2 = c_loc(j)
-! CALL process_buffer(estack_id,f_ptr2)
-
- hdferr = h5eget_auto_c(estack_id, op, f_ptr2, ret_func2)
-
-!!!!! PRINT*,c_associated(f_ptr2)
-!!$ hdferr = h5eget_auto_c(estack_id, op, client_data, ret_func2)
-
- PRINT*,'fortran',j
- stop
-
-! client_data = h5eget_auto_c2(estack_id, op, ret_func2)
-
-! PRINT*,'Is client_data associated',C_associated(client_data)
-! PRINT*,'Is op_data associated',C_associated(op)
-
-! ALLOCATE(i(1:1))
-! CALL c_f_pointer(f_ptr2,a,[1])
-! CALL c_f_pointer(f_ptr2,i)
-! PRINT*,i
-! PRINT*,"Buffer in (F) = ", a(1)
-
-! stop
-
-! ALLOCATE(ptr_data(1:2))
-! ptr_data = 0
-! array_shape(1) = 1
-! CALL C_F_POINTER(client_data, ptr_data, array_shape)
-! CALL C_F_POINTER(f_ptr2, i,(/ 1 /))
-
-! ptr_data => f_ptr1(1)
-
-! PRINT*,'value in fortran',i
-
-
-! Check to see if the user created their own function,
-! otherwise we have to create a fortran version of the default
-
-!!$ IF(ret_func2.EQ.0)THEN
-!!$ op = c_funloc(h5eprint_def)
-!!$ END IF
-
- END SUBROUTINE h5eget_auto_f
-
END MODULE H5E_PROVISIONAL
diff --git a/fortran/src/H5f90proto.h b/fortran/src/H5f90proto.h
index 7f45ff9..89957a4 100644
--- a/fortran/src/H5f90proto.h
+++ b/fortran/src/H5f90proto.h
@@ -27,6 +27,57 @@ H5_FCDLL void HD5packFstring(char *src, char *dest, size_t len);
#endif /*H5_VMS*/
/*
+ * Storage info struct used by H5O_info_t and H5F_info_t
+ * interoperable with Fortran.
+ */
+typedef struct H5_ih_info_t_f {
+ hsize_t index_size; /* btree and/or list */
+ hsize_t heap_size;
+} H5_ih_info_t_f;
+
+/* Information struct for object header metadata (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx)
+ * interoperable with Fortran.
+ */
+typedef struct H5O_hdr_info_t_f {
+ int_f version; /* Version number of header format in file */
+ int_f nmesgs; /* Number of object header messages */
+ int_f nchunks; /* Number of object header chunks */
+ int_f flags; /* Object header status flags */
+ struct {
+ hsize_t total; /* Total space for storing object header in file */
+ hsize_t meta; /* Space within header for object header metadata information */
+ hsize_t mesg; /* Space within header for actual message information */
+ hsize_t free; /* Free space within object header */
+ } space;
+ struct {
+ uint64_t present; /* Flags to indicate presence of message type in header */
+ uint64_t shared; /* Flags to indicate message type is shared in header */
+ } mesg;
+} H5O_hdr_info_t_f;
+
+/* Information struct for object (for H5Oget_info/H5Oget_info_by_name/H5Oget_info_by_idx)
+ * interoperable with Fortran.
+ */
+typedef struct H5O_info_t_f {
+ unsigned long fileno; /* File number that object is located in */
+ haddr_t_f addr; /* Object address in file */
+ int_f type; /* Basic object type (group, dataset, etc.) */
+ int_f rc; /* Reference count of object */
+ int_f atime[8]; /* Access time */
+ int_f mtime[8]; /* Modification time */
+ int_f ctime[8]; /* Change time */
+ int_f btime[8]; /* Birth time */
+ hsize_t num_attrs; /* # of attributes attached to object */
+ H5O_hdr_info_t_f hdr; /* Object header information */
+ /* Extra metadata storage for obj & attributes */
+ struct {
+ H5_ih_info_t_f obj; /* v1/v2 B-tree & local/fractal heap for groups, B-tree for chunked datasets */
+ H5_ih_info_t_f attr; /* v2 B-tree & heap for attributes */
+ } meta_size;
+} H5O_info_t_f;
+
+
+/*
* Functions from H5Ff.c
*/
#define nh5fcreate_c H5_FC_FUNC_(h5fcreate_c, H5FCREATE_C)
@@ -766,7 +817,7 @@ H5_FCDLL int_f nh5olink_c (hid_t_f *object_id, hid_t_f *new_loc_id, _fcd name, s
hid_t_f *lcpl_id, hid_t_f *lapl_id);
H5_FCDLL int_f nh5ovisit_c (hid_t_f *group_id, int_f *index_type, int_f *order, H5O_iterate_t op, void *op_data);
H5_FCDLL int_f nh5oget_info_by_name_c (hid_t_f *loc_id, _fcd name, size_t_f *namelen,hid_t_f *lapl_id,
- H5O_info_t *object_info);
+ H5O_info_t_f *object_info);
/*
* Functions from H5Pf.c
*/
@@ -1144,8 +1195,6 @@ H5_FCDLL int_f nh5iis_valid_c(hid_t_f *obj_id, int_f *c_valid);
#define nh5eget_minor_c H5_FC_FUNC_(h5eget_minor_c, H5EGET_MINOR_C)
#define nh5eset_auto_c H5_FC_FUNC_(h5eset_auto_c, H5ESET_AUTO_C)
#define nh5eset_auto2_c H5_FC_FUNC_(h5eset_auto2_c, H5ESET_AUTO2_C)
-#define nh5eget_auto_c H5_FC_FUNC_(h5eget_auto_c, H5EGET_AUTO_C)
-#define nh5eget_auto_c2 H5_FC_FUNC_(h5eget_auto_c2, H5EGET_AUTO_C2)
#define nprocess_buffer H5_FC_FUNC_(process_buffer, PROCESS_BUFFER)
@@ -1156,8 +1205,6 @@ H5_FCDLL int_f nh5eget_major_c(int_f* error_no, _fcd name, size_t_f* namelen);
H5_FCDLL int_f nh5eget_minor_c(int_f* error_no, _fcd name, size_t_f* namelen);
H5_FCDLL int_f nh5eset_auto_c(int_f* printflag);
H5_FCDLL int_f nh5eset_auto2_c(int_f* printflag, hid_t_f *estack_id, H5E_auto2_t func, void *client_data);
-H5_FCDLL int_f nh5eget_auto_c(hid_t_f *estack_id, H5E_auto2_t *func, void **client_data, int_f* ret_func);
-H5_FCDLL void* nh5eget_auto_c2(hid_t_f *estack_id, H5E_auto2_t *func, int_f* ret_func);
H5_FCDLL int_f nprocess_buffer(hid_t_f *estack_id,void **buffer);
/*
diff --git a/fortran/test/tH5E_F03.f90 b/fortran/test/tH5E_F03.f90
index 75a534e..04e3190 100644
--- a/fortran/test/tH5E_F03.f90
+++ b/fortran/test/tH5E_F03.f90
@@ -158,10 +158,10 @@ SUBROUTINE test_error(total_error)
!!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(1),10, total_error)
!!$ CALL VERIFY("H5Eset_auto_f",my_hdf5_error_handler_data(2),20, total_error)
- ! Test enabling and disabling default printing
-
- CALL H5Eget_auto_f(H5E_DEFAULT_F, func1, f_ptr1, error)
- CALL VERIFY("H5Eget_auto_f", error, 0, total_error)
+!!$ ! Test enabling and disabling default printing
+!!$
+!!$ CALL H5Eget_auto_f(H5E_DEFAULT_F, func1, f_ptr1, error)
+!!$ CALL VERIFY("H5Eget_auto_f", error, 0, total_error)
! PRINT*,c_associated(f_ptr1)