summaryrefslogtreecommitdiffstats
path: root/xlib
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2012-06-08 22:47:55 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2012-06-08 22:47:55 (GMT)
commit8409ff09f08fd2b2ef22585bb9559ee6930d4d5f (patch)
tree8085e4e968c883798ec985c45f94065fe230ee15 /xlib
parent676eb78eadce63bc5b6a98b6c1f2d077b49a9869 (diff)
parent79fa64792bbab42e97785552b9a9cf75fa126695 (diff)
downloadtk-8409ff09f08fd2b2ef22585bb9559ee6930d4d5f.zip
tk-8409ff09f08fd2b2ef22585bb9559ee6930d4d5f.tar.gz
tk-8409ff09f08fd2b2ef22585bb9559ee6930d4d5f.tar.bz2
Change XChangeWindowAttributes signature and many others to match Xorg, needed for Cygwin
Diffstat (limited to 'xlib')
-rw-r--r--xlib/xdraw.c8
-rw-r--r--xlib/xgc.c50
2 files changed, 37 insertions, 21 deletions
diff --git a/xlib/xdraw.c b/xlib/xdraw.c
index f8f035c..b8d7973 100644
--- a/xlib/xdraw.c
+++ b/xlib/xdraw.c
@@ -27,7 +27,7 @@
*----------------------------------------------------------------------
*/
-void
+int
XDrawLine(
Display *display,
Drawable d,
@@ -41,7 +41,7 @@ XDrawLine(
points[0].y = y1;
points[1].x = x2;
points[1].y = y2;
- XDrawLines(display, d, gc, points, 2, CoordModeOrigin);
+ return XDrawLines(display, d, gc, points, 2, CoordModeOrigin);
}
/*
@@ -61,7 +61,7 @@ XDrawLine(
*----------------------------------------------------------------------
*/
-void
+int
XFillRectangle(
Display *display,
Drawable d,
@@ -76,7 +76,7 @@ XFillRectangle(
rectangle.y = y;
rectangle.width = width;
rectangle.height = height;
- XFillRectangles(display, d, gc, &rectangle, 1);
+ return XFillRectangles(display, d, gc, &rectangle, 1);
}
/*
diff --git a/xlib/xgc.c b/xlib/xgc.c
index 61602e2..0cebbc8 100644
--- a/xlib/xgc.c
+++ b/xlib/xgc.c
@@ -29,6 +29,7 @@
# define gcCacheSize sizeof(TkpGCCache)
#endif
+#undef TkSetRegion
/*
*----------------------------------------------------------------------
@@ -48,7 +49,7 @@
static TkpClipMask *AllocClipMask(GC gc) {
TkpClipMask *clip_mask = (TkpClipMask*) gc->clip_mask;
-
+
if (clip_mask == None) {
clip_mask = ckalloc(sizeof(TkpClipMask));
gc->clip_mask = (Pixmap) clip_mask;
@@ -159,7 +160,7 @@ XCreateGC(
gp->clip_mask = None;
if (mask & GCClipMask) {
TkpClipMask *clip_mask = AllocClipMask(gp);
-
+
clip_mask->type = TKP_CLIP_PIXMAP;
clip_mask->value.pixmap = values->clip_mask;
}
@@ -206,7 +207,7 @@ TkpGetGCCache(GC gc) {
*----------------------------------------------------------------------
*/
-void
+int
XChangeGC(
Display *d,
GC gc,
@@ -244,6 +245,7 @@ XChangeGC(
gc->dashes = values->dashes;
(&(gc->dashes))[1] = 0;
}
+ return Success;
}
/*
@@ -262,7 +264,7 @@ XChangeGC(
*----------------------------------------------------------------------
*/
-void XFreeGC(
+int XFreeGC(
Display *d,
GC gc)
{
@@ -271,6 +273,7 @@ void XFreeGC(
TkpFreeGCCache(gc);
ckfree(gc);
}
+ return Success;
}
/*
@@ -290,25 +293,27 @@ void XFreeGC(
*----------------------------------------------------------------------
*/
-void
+int
XSetForeground(
Display *display,
GC gc,
unsigned long foreground)
{
gc->foreground = foreground;
+ return Success;
}
-void
+int
XSetBackground(
Display *display,
GC gc,
unsigned long background)
{
gc->background = background;
+ return Success;
}
-void
+int
XSetDashes(
Display *display,
GC gc,
@@ -330,36 +335,40 @@ XSetDashes(
*p++ = *dash_list++;
}
*p = 0;
+ return Success;
}
-void
+int
XSetFunction(
Display *display,
GC gc,
int function)
{
gc->function = function;
+ return Success;
}
-void
+int
XSetFillRule(
Display *display,
GC gc,
int fill_rule)
{
gc->fill_rule = fill_rule;
+ return Success;
}
-void
+int
XSetFillStyle(
Display *display,
GC gc,
int fill_style)
{
gc->fill_style = fill_style;
+ return Success;
}
-void
+int
XSetTSOrigin(
Display *display,
GC gc,
@@ -367,36 +376,40 @@ XSetTSOrigin(
{
gc->ts_x_origin = x;
gc->ts_y_origin = y;
+ return Success;
}
-void
+int
XSetFont(
Display *display,
GC gc,
Font font)
{
gc->font = font;
+ return Success;
}
-void
+int
XSetArcMode(
Display *display,
GC gc,
int arc_mode)
{
gc->arc_mode = arc_mode;
+ return Success;
}
-void
+int
XSetStipple(
Display *display,
GC gc,
Pixmap stipple)
{
gc->stipple = stipple;
+ return Success;
}
-void
+int
XSetLineAttributes(
Display *display,
GC gc,
@@ -409,9 +422,10 @@ XSetLineAttributes(
gc->line_style = line_style;
gc->cap_style = cap_style;
gc->join_style = join_style;
+ return Success;
}
-void
+int
XSetClipOrigin(
Display *display,
GC gc,
@@ -420,6 +434,7 @@ XSetClipOrigin(
{
gc->clip_x_origin = clip_x_origin;
gc->clip_y_origin = clip_y_origin;
+ return Success;
}
/*
@@ -462,7 +477,7 @@ TkSetRegion(
}
}
-void
+int
XSetClipMask(
Display *display,
GC gc,
@@ -476,6 +491,7 @@ XSetClipMask(
clip_mask->type = TKP_CLIP_PIXMAP;
clip_mask->value.pixmap = pixmap;
}
+ return Success;
}
/*
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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
!
!
! Testing Fortran functionality.
@@ -30,6 +45,8 @@
CHARACTER(LEN=8) :: success = ' PASSED '
CHARACTER(LEN=8) :: failure = '*FAILED*'
CHARACTER(LEN=4) :: e_format ='(8a)'
+ LOGICAL :: cleanup = .TRUE.
+! LOGICAL :: cleanup = .FALSE.
CALL h5open_f(error)
write(*,*) ' ========================== '
@@ -40,7 +57,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL mountingtest(mounting_total_error)
+ CALL mountingtest(cleanup, mounting_total_error)
IF (mounting_total_error == 0) error_string = success
write(*, fmt = '(14a)', advance = 'no') ' Mounting test'
write(*, fmt = '(56x,a)', advance = 'no') ' '
@@ -49,7 +66,7 @@
total_error = total_error + mounting_total_error
error_string = failure
- CALL reopentest(reopen_total_error)
+ CALL reopentest(cleanup, reopen_total_error)
IF (reopen_total_error == 0) error_string = success
write(*, fmt = '(12a)', advance = 'no') ' Reopen test'
write(*, fmt = '(58x,a)', advance = 'no') ' '
@@ -63,7 +80,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL datasettest(dataset_total_error)
+ CALL datasettest(cleanup, dataset_total_error)
IF (dataset_total_error == 0) error_string = success
write(*, fmt = '(13a)', advance = 'no') ' Dataset test'
write(*, fmt = '(57x,a)', advance = 'no') ' '
@@ -71,7 +88,7 @@
total_error = total_error + dataset_total_error
error_string = failure
- CALL extenddsettest(extend_dataset_total_error)
+ CALL extenddsettest(cleanup, extend_dataset_total_error)
IF (extend_dataset_total_error == 0) error_string = success
write(*, fmt = '(24a)', advance = 'no') ' Extendible dataset test'
write(*, fmt = '(46x,a)', advance = 'no') ' '
@@ -84,7 +101,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL dataspace_basic_test(dataspace_total_error)
+ CALL dataspace_basic_test(cleanup, dataspace_total_error)
IF (dataspace_total_error == 0) error_string = success
write(*, fmt = '(21a)', advance = 'no') ' Basic dataspace test'
write(*, fmt = '(49x,a)', advance = 'no') ' '
@@ -98,7 +115,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL refobjtest(refobj_total_error)
+ CALL refobjtest(cleanup, refobj_total_error)
IF (refobj_total_error == 0) error_string = success
write(*, fmt = '(25a)', advance = 'no') ' Reference to object test'
write(*, fmt = '(45x,a)', advance = 'no') ' '
@@ -106,7 +123,7 @@
total_error = total_error + refobj_total_error
error_string = failure
- CALL refregtest(refreg_total_error)
+ CALL refregtest(cleanup, refreg_total_error)
IF (refreg_total_error == 0) error_string = success
write(*, fmt = '(33a)', advance = 'no') ' Reference to dataset region test'
write(*, fmt = '(37x,a)', advance = 'no') ' '
@@ -119,7 +136,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL test_basic_select(basic_select_total_error)
+ CALL test_basic_select(cleanup, basic_select_total_error)
IF (basic_select_total_error == 0) error_string = success
write(*, fmt = '(21a)', advance = 'no') ' Basic selection test'
write(*, fmt = '(49x,a)', advance = 'no') ' '
@@ -127,7 +144,7 @@
total_error = total_error + basic_select_total_error
error_string = failure
- CALL test_select_hyperslab( hyperslab_total_error)
+ CALL test_select_hyperslab( cleanup, hyperslab_total_error)
IF ( hyperslab_total_error == 0) error_string = success
write(*, fmt = '(25a)', advance = 'no') ' Hyperslab selection test'
write(*, fmt = '(45x,a)', advance = 'no') ' '
@@ -135,7 +152,7 @@
total_error = total_error + hyperslab_total_error
error_string = failure
- CALL test_select_element(element_total_error)
+ CALL test_select_element(cleanup, element_total_error)
IF (element_total_error == 0) error_string = success
write(*, fmt = '(23a)', advance = 'no') ' Element selection test'
write(*, fmt = '(47x,a)', advance = 'no') ' '
@@ -149,7 +166,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL basic_data_type_test(basic_datatype_total_error)
+ CALL basic_data_type_test(cleanup, basic_datatype_total_error)
IF (basic_datatype_total_error == 0) error_string = success
write(*, fmt = '(20a)', advance = 'no') ' Basic datatype test'
write(*, fmt = '(50x,a)', advance = 'no') ' '
@@ -157,7 +174,7 @@
total_error = total_error + basic_datatype_total_error
error_string = failure
- CALL compoundtest(total_error_compoundtest)
+ CALL compoundtest(cleanup, total_error_compoundtest)
IF (total_error_compoundtest == 0) error_string = success
write(*, fmt = '(23a)', advance = 'no') ' Compound datatype test'
write(*, fmt = '(47x,a)', advance = 'no') ' '
@@ -170,7 +187,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL external_test(external_total_error)
+ CALL external_test(cleanup, external_total_error)
IF (external_total_error == 0) error_string = success
write(*, fmt = '(22a)', advance = 'no') ' External dataset test'
write(*, fmt = '(48x,a)', advance = 'no') ' '
@@ -183,7 +200,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL attribute_test(attribute_total_error)
+ CALL attribute_test(cleanup, attribute_total_error)
write(*, fmt = '(15a)', advance = 'no') ' Attribute test'
write(*, fmt = '(55x,a)', advance = 'no') ' '
IF (attribute_total_error == 0) error_string = success
@@ -196,7 +213,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL identifier_test(identifier_total_error)
+ CALL identifier_test(cleanup, identifier_total_error)
IF (identifier_total_error == 0) error_string = success
write(*, fmt = '(16a)', advance = 'no') ' Identifier test'
write(*, fmt = '(54x,a)', advance = 'no') ' '
@@ -209,7 +226,7 @@
! write(*,*) '========================================='
error_string = failure
- CALL group_test(group_total_error)
+ CALL group_test(cleanup, group_total_error)
IF (group_total_error == 0) error_string = success
write(*, fmt = '(11a)', advance = 'no') ' Group test'
write(*, fmt = '(59x,a)', advance = 'no') ' '
@@ -217,7 +234,7 @@
total_error = total_error + identifier_total_error
error_string = failure
- CALL error_report_test(error_total_error)
+ CALL error_report_test(cleanup, error_total_error)
IF (error_total_error == 0) error_string = success
write(*, fmt = '(11a)', advance = 'no') ' Error test'
write(*, fmt = '(59x,a)', advance = 'no') ' '
diff --git a/fortran/test/hdf5test.f90 b/fortran/test/hdf5test.f90
deleted file mode 100644
index 978c832..0000000
--- a/fortran/test/hdf5test.f90
+++ /dev/null
@@ -1,16 +0,0 @@
-!
-!
-! This module contains check subroutine which is used in
-! all the fortran h5 test files
-!
-
- SUBROUTINE check(string,error,total_error)
- CHARACTER(LEN=*) :: string
- INTEGER :: error, total_error
- if (error .lt. 0) then
- total_error=total_error+1
- write(*,*) string, " failed"
- endif
- RETURN
- END SUBROUTINE check
-
diff --git a/fortran/test/t.c b/fortran/test/t.c
new file mode 100644
index 0000000..ed18c0f
--- /dev/null
+++ b/fortran/test/t.c
@@ -0,0 +1,115 @@
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
+ * access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+#include "t.h"
+
+/*----------------------------------------------------------------------------
+ * Name: h5_fixname_c
+ * Purpose: Call h5_fixname to modify file name
+ * Inputs: base_name - name of the file
+ * base_namelen - name length
+ * fapl - file access property list
+ * full_name - buffer to return full name
+ * full_namelen - name length
+ * Returns: 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Friday, September 13, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+int_f
+nh5_fixname_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl, _fcd full_name, int_f *full_namelen)
+{
+ int ret_value = -1;
+ char *c_base_name;
+ int c_base_namelen;
+ int c_full_namelen;
+ char *c_full_name;
+ hid_t c_fapl;
+
+ /*
+ * Define ifile access property list
+ */
+ c_fapl = (hid_t)*fapl;
+ /*
+ * Convert FORTRAN name to C name
+ */
+ c_base_namelen = *base_namelen;
+ c_base_name = (char *)HD5f2cstring(base_name, c_base_namelen);
+ if (c_base_name == NULL) goto DONE;
+ c_full_name = (char *) HDmalloc(*full_namelen + 1);
+ if (c_full_name == NULL) goto DONE;
+
+ /*
+ * Call h5_fixname function.
+ */
+ if (NULL != h5_fixname(c_base_name, c_fapl, c_full_name, *full_namelen + 1)) {
+ HD5packFstring(c_full_name, _fcdtocp(full_name), *full_namelen);
+ ret_value = 0;
+ goto DONE;
+ }
+DONE:
+ if (NULL != c_base_name) HDfree(c_base_name);
+ if (NULL != c_full_name) HDfree(c_full_name);
+ return ret_value;
+}
+
+/*----------------------------------------------------------------------------
+ * Name: h5_cleanup_c
+ * Purpose: Call h5_cleanup to clean temporary files.
+ * Inputs: base_name - name of the file
+ * base_namelen - name length
+ * fapl - file access property list
+ * Returns: 0 on success, -1 on failure
+ * Programmer: Elena Pourmal
+ * Thursday, September 19, 2002
+ * Modifications:
+ *---------------------------------------------------------------------------*/
+int_f
+nh5_cleanup_c(_fcd base_name, int_f *base_namelen, hid_t_f* fapl)
+{
+ char filename[1024];
+ int ret_value = -1;
+ char *c_base_name[1];
+ int c_base_namelen;
+ hid_t c_fapl;
+
+ /*
+ * Define ifile access property list
+ */
+ c_fapl = (hid_t)*fapl;
+ /*c_fapl = H5Pcreate(H5P_FILE_ACCESS);*/
+ /*
+ * Convert FORTRAN name to C name
+ */
+ c_base_namelen = *base_namelen;
+ c_base_name[0] = (char *)HD5f2cstring(base_name, c_base_namelen);
+ if (c_base_name[0] == NULL) goto DONE;
+
+ /*
+ * Call h5_cleanup function.
+ */
+ /*if (h5_cleanup(c_base_name, c_fapl) != 0) {
+ ret_value = 0;
+ goto DONE;
+ }
+*/
+ h5_fixname(c_base_name[0], c_fapl, filename, sizeof(filename));
+ remove(filename);
+ ret_value =0;
+DONE:
+ if (NULL != c_base_name[0]) HDfree(c_base_name[0]);
+ return ret_value;
+
+}
diff --git a/fortran/test/t.h b/fortran/test/t.h
new file mode 100644
index 0000000..980e597
--- /dev/null
+++ b/fortran/test/t.h
@@ -0,0 +1,34 @@
+
+/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
+ * access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
+
+#include "../../src/hdf5.h"
+#include "../src/H5f90i.h"
+
+/*
+ * Functions from t.c
+ */
+#ifdef DF_CAPFNAMES
+# define nh5_fixname_c FNAME(H5_FIXNAME_C)
+# define nh5_cleanup_c FNAME(H5_CLEANUP_C)
+#else /* !DF_CAPFNAMES */
+# define nh5_fixname_c FNAME(h5_fixname_c)
+# define nh5_cleanup_c FNAME(h5_cleanup_c)
+#endif /* DF_CAPFNAMES */
+
+ H5_DLL int_f nh5_fixname_c
+(_fcd base_name, int_f *base_namelen, hid_t_f *fapl, _fcd full_name, int_f *full_namelen);
+
+ H5_DLL int_f nh5_cleanup_c
+(_fcd base_name, int_f *base_namelen, hid_t_f *fapl);
diff --git a/fortran/test/tH5A.f90 b/fortran/test/tH5A.f90
index cec25de..7f984e5 100644
--- a/fortran/test/tH5A.f90
+++ b/fortran/test/tH5A.f90
@@ -1,17 +1,33 @@
- SUBROUTINE attribute_test(total_error)
-
-!THis subroutine tests following functionalities:
-!h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f,
-!h5aget_name_f,h5aget_space_f, h5aget_type_f,
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+ SUBROUTINE attribute_test(cleanup, total_error)
+
+! This subroutine tests following functionalities:
+! h5acreate_f, h5awrite_f, h5aclose_f,h5aread_f, h5aopen_name_f,
+! h5aget_name_f,h5aget_space_f, h5aget_type_f,
!
USE HDF5 ! This module contains all necessary modules
IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
- CHARACTER(LEN=8), PARAMETER :: filename = "atest.h5" !File name
+ CHARACTER(LEN=5), PARAMETER :: filename = "atest.h5" !File name
+ CHARACTER(LEN=80) :: fix_filename
CHARACTER(LEN=9), PARAMETER :: dsetname = "atestdset" !Dataset name
CHARACTER(LEN=11), PARAMETER :: aname = "attr_string" !String Attribute name
CHARACTER(LEN=14), PARAMETER :: aname2 = "attr_character"!Character Attribute name
@@ -114,7 +130,12 @@
!
! Create the file.
!
- CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error)
+ CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
+ if (error .ne. 0) then
+ write(*,*) "Cannot modify file name"
+ stop
+ endif
+ CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error)
CALL check("h5fcreate_f",error,total_error)
!
@@ -291,7 +312,7 @@
!
! Open file
!
- CALL h5fopen_f(filename, H5F_ACC_RDWR_F, file_id, error)
+ CALL h5fopen_f(fix_filename, H5F_ACC_RDWR_F, file_id, error)
CALL check("h5open_f",error,total_error)
!
! Reopen dataset
@@ -507,6 +528,10 @@
!
CALL h5fclose_f(file_id, error)
CALL check("h5fclose_f",error,total_error)
+ !
+ ! Remove the file
+ !
+ if (cleanup) call h5_cleanup_f(filename, H5P_DEFAULT_F, error)
RETURN
END SUBROUTINE attribute_test
diff --git a/fortran/test/tH5D.f90 b/fortran/test/tH5D.f90
index 1f32fbb..c808f22 100644
--- a/fortran/test/tH5D.f90
+++ b/fortran/test/tH5D.f90
@@ -1,25 +1,36 @@
+
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
!
!
! Testing Dataset Interface functionality.
!
-! MODULE H5DTEST
-
-! USE HDF5 ! This module contains all necessary modules
-
-! CONTAINS
-
!
-!The following subroutine tests the following functionalities:
-!h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, h5dget_type_f,
-!h5dread_f, and h5dwrite_f
+! The following subroutine tests the following functionalities:
+! h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, h5dget_type_f,
+! h5dread_f, and h5dwrite_f
!
- SUBROUTINE datasettest(total_error)
+ SUBROUTINE datasettest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
- CHARACTER(LEN=8), PARAMETER :: filename = "dsetf.h5" ! File name
+ CHARACTER(LEN=5), PARAMETER :: filename = "dsetf" ! File name
+ CHARACTER(LEN=80) :: fix_filename
CHARACTER(LEN=4), PARAMETER :: dsetname = "dset" ! Dataset name
INTEGER(HID_T) :: file_id ! File identifier
@@ -47,16 +58,16 @@
end do
end do
- !
- ! Initialize FORTRAN predefined datatypes.
- !
-! CALL h5init_types_f(error)
-! CALL check("h5init_types_f", error, total_error)
!
! Create a new file using default properties.
!
- CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error)
+ CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
+ if (error .ne. 0) then
+ write(*,*) "Cannot modify filename"
+ stop
+ endif
+ CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error)
CALL check("h5fcreate_f", error, total_error)
@@ -104,7 +115,7 @@
!
! Open the existing file.
!
- CALL h5fopen_f (filename, H5F_ACC_RDWR_F, file_id, error)
+ CALL h5fopen_f (fix_filename, H5F_ACC_RDWR_F, file_id, error)
CALL check("h5fopen_f", error, total_error)
!
@@ -165,13 +176,9 @@
!
CALL h5fclose_f(file_id, error)
CALL check("h5fclose_f", error, total_error)
+ if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
- !
- !Close FORTRAN predifined datatypes
- !
-! CALL h5close_types_f(error)
-! CALL check("h5close_types_f",error,total_error)
-
RETURN
END SUBROUTINE datasettest
@@ -179,16 +186,18 @@
!the following subroutine tests h5dextend_f functionality
!
- SUBROUTINE extenddsettest(total_error)
+ SUBROUTINE extenddsettest(cleanup, total_error)
USE HDF5 ! This module contains all necessary modules
IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
!
!the dataset is stored in file "extf.h5"
!
- CHARACTER(LEN=7), PARAMETER :: filename = "extf.h5"
+ CHARACTER(LEN=4), PARAMETER :: filename = "extf"
+ CHARACTER(LEN=80) :: fix_filename
!
!dataset name is "ExtendibleArray"
@@ -266,7 +275,12 @@
!
!Create a new file using default properties.
!
- CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error)
+ CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
+ if (error .ne. 0) then
+ write(*,*) "Cannot modify filename"
+ stop
+ endif
+ CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error)
CALL check("h5fcreate_f",error,total_error)
@@ -347,7 +361,7 @@
!
!Open the file.
!
- CALL h5fopen_f (filename, H5F_ACC_RDONLY_F, file_id, error)
+ CALL h5fopen_f (fix_filename, H5F_ACC_RDONLY_F, file_id, error)
CALL check("hfopen_f",error,total_error)
!
@@ -444,16 +458,10 @@
!
CALL h5fclose_f(file_id, error)
CALL check("h5fclose_f",error,total_error)
-
- !
- ! Close FORTRAN predefined datatypes.
- !
-! CALL h5close_types_f(error)
-! CALL check("h5close_types_f",error,total_error)
+ if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
RETURN
END SUBROUTINE extenddsettest
-
-! END MODULE H5DTEST
diff --git a/fortran/test/tH5E.f90 b/fortran/test/tH5E.f90
index c14b101..d0e1317 100644
--- a/fortran/test/tH5E.f90
+++ b/fortran/test/tH5E.f90
@@ -1,14 +1,32 @@
- SUBROUTINE error_report_test(total_error)
-!THis subroutine tests following functionalities: h5eprint_f
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+! 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://hdf.ncsa.uiuc.edu/HDF5/doc/Copyright.html. If you do not have *
+! access to either file, you may request a copy from hdfhelp@ncsa.uiuc.edu. *
+! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+!
+ SUBROUTINE error_report_test(cleanup, total_error)
+
+! This subroutine tests following functionalities: h5eprint_f
USE HDF5 ! This module contains all necessary modules
IMPLICIT NONE
+ LOGICAL, INTENT(IN) :: cleanup
INTEGER, INTENT(OUT) :: total_error
- CHARACTER(LEN=9), PARAMETER :: filename = "etestf.h5" ! File name
- CHARACTER(LEN=12), PARAMETER :: err_file_name = "err_file.tmp"! Error output file
+ CHARACTER(LEN=6), PARAMETER :: filename = "etestf" ! File name
+ CHARACTER(LEN=80) :: fix_filename
+ CHARACTER(LEN=8), PARAMETER :: err_filename = "err_file"! Error output file
+ CHARACTER(LEN=80) :: fix_err_filename
@@ -22,7 +40,12 @@
!
! Create a new file using default properties.
!
- CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error)
+ CALL h5_fixname_f(filename, fix_filename, H5P_DEFAULT_F, error)
+ if (error .ne. 0) then
+ write(*,*) "Cannot modify filename"
+ stop
+ endif
+ CALL h5fcreate_f(fix_filename, H5F_ACC_TRUNC_F, file_id, error)
CALL check("h5fcreate_f",error,total_error)
!
@@ -30,9 +53,14 @@
! Error message should go to the err_file_name file.
!
CALL h5gopen_f(file_id, "Doesnotexist1", grp_id, tmp_error)
- CALL h5eprint_f(error, err_file_name)
+ CALL h5_fixname_f(err_filename, fix_err_filename, H5P_DEFAULT_F, error)
+ if (error .ne. 0) then
+ write(*,*) "Cannot modify filename"
+ stop
+ endif
+ CALL h5eprint_f(error, fix_err_filename)
CALL h5gopen_f(file_id, "Doesnotexist2", grp_id, tmp_error)
- CALL h5eprint_f(error, err_file_name)
+ CALL h5eprint_f(error, fix_err_filename)
!
! Close the file.
@@ -40,5 +68,9 @@
CALL h5fclose_f(file_id, error)
CALL check("h5fclose_f",error,total_error)
+ if(cleanup) CALL h5_cleanup_f(filename, H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
+ if(cleanup) CALL h5_cleanup_f(err_filename, H5P_DEFAULT_F, error)
+ CALL check("h5_cleanup_f", error, total_error)
RETURN
END SUBROUTINE error_report_test
diff --git a/fortran/test/tH5F.f90 b/fortran/test/tH5F.f90
index 31da85d..0f058d9 100644
--- a/fortran/test/tH5F.f90
+++ b/fortran/test/tH5F.f90