1! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 2! * Copyright by The HDF Group. * 3! * Copyright by the Board of Trustees of the University of Illinois. * 4! * All rights reserved. * 5! * * 6! * This file is part of HDF5. The full HDF5 copyright notice, including * 7! * terms governing use, modification, and redistribution, is contained in * 8! the COPYING file, which can be found at the root of the source code * 9! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases. * 10! If you do not have access to either file, you may request a copy from * 11! help@hdfgroup.org. * 12! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 13 14MODULE TSTDS 15 16CONTAINS 17 18!------------------------------------------------------------------------- 19! test_begin 20!------------------------------------------------------------------------- 21 22SUBROUTINE test_begin(string) 23 CHARACTER(LEN=*), INTENT(IN) :: string 24 WRITE(*, fmt = '(A)', advance = 'no') ADJUSTL(string) 25END SUBROUTINE test_begin 26 27!------------------------------------------------------------------------- 28! passed/failed 29!------------------------------------------------------------------------- 30SUBROUTINE write_test_status( test_result) 31 32! Writes the results of the tests 33 34 IMPLICIT NONE 35 36 INTEGER, INTENT(IN) :: test_result ! negative, failed 37 ! 0 , passed 38 39! Controls the output style for reporting test results 40 41 CHARACTER(LEN=8) :: error_string 42 CHARACTER(LEN=8), PARAMETER :: success = ' PASSED ' 43 CHARACTER(LEN=8), PARAMETER :: failure = '*FAILED*' 44 45 error_string = failure 46 IF (test_result .EQ. 0) THEN 47 error_string = success 48 ENDIF 49 50 WRITE(*, fmt = '(T34, A)') error_string 51 52END SUBROUTINE write_test_status 53 54END MODULE TSTDS 55 56MODULE TSTDS_TESTS 57 58CONTAINS 59 60SUBROUTINE test_testds(err) 61 62 USE HDF5 63 USE H5LT 64 USE H5DS 65 USE TSTDS ! module for testing dataset support routines 66 67 IMPLICIT NONE 68 69 INTEGER, PARAMETER :: RANK = 2 ! rank of DATA dataset 70 INTEGER, PARAMETER :: DIM_DATA = 12 71 INTEGER, PARAMETER :: DIM1_SIZE = 3 72 INTEGER, PARAMETER :: DIM2_SIZE = 4 73 INTEGER, PARAMETER :: DIM1 = 1 74 INTEGER, PARAMETER :: DIM2 = 2 75 INTEGER, PARAMETER :: FAILED = -1 76 77 CHARACTER(LEN=6), PARAMETER :: DSET_NAME = "Mydata" 78 CHARACTER(LEN=5), PARAMETER :: DS_1_NAME = "Yaxis" 79 CHARACTER(LEN=5), PARAMETER :: DS_2_NAME = "Xaxis" 80 81 82 INTEGER(hid_t) :: fid ! file ID 83 INTEGER(hid_t) :: did ! dataset ID 84 INTEGER(hid_t) :: dsid ! DS dataset ID 85 INTEGER :: rankds = 1 ! rank of DS dataset 86 INTEGER(hsize_t), DIMENSION(1:rank) :: dims = (/DIM2_SIZE,DIM1_SIZE/) ! size of DATA dataset 87 INTEGER, DIMENSION(1:DIM_DATA) :: buf = (/1,2,3,4,5,6,7,8,9,10,11,12/) ! DATA of DATA dataset 88 INTEGER(hsize_t), DIMENSION(1:1) :: s1_dim = (/DIM1_SIZE/) ! size of DS 1 dataset 89 INTEGER(hsize_t), DIMENSION(1:1) :: s2_dim = (/DIM2_SIZE/) ! size of DS 2 dataset 90 REAL, DIMENSION(1:DIM1_SIZE) :: s1_wbuf = (/10,20,30/) ! DATA of DS 1 dataset 91 INTEGER, DIMENSION(1:DIM2_SIZE) :: s2_wbuf = (/10,20,50,100/) ! DATA of DS 2 dataset 92 INTEGER :: err 93 INTEGER :: num_scales 94 INTEGER(size_t) :: name_len 95 CHARACTER(LEN=80) :: name 96 INTEGER(size_t) :: label_len 97 CHARACTER(LEN=80) :: label 98 LOGICAL :: is_attached, is_scale 99 100 ! 101 ! Initialize FORTRAN predefined datatypes. 102 ! 103 CALL h5open_f(err) 104 IF(err.LT.0) RETURN 105 106 ! create a file using default properties 107 CALL H5Fcreate_f("tstds.h5",H5F_ACC_TRUNC_F, fid, err) 108 IF(err.LT.0) RETURN 109 110 ! make a dataset 111 CALL H5LTmake_dataset_int_f(fid,DSET_NAME,rank,dims,buf, err) 112 IF(err.LT.0) RETURN 113 114 ! make a DS dataset for the first dimension 115 CALL H5LTmake_dataset_float_f(fid,DS_1_NAME,rankds,s1_dim,s1_wbuf,err) 116 IF(err.LT.0) RETURN 117 118 ! make a DS dataset for the second dimension 119 CALL H5LTmake_dataset_int_f(fid,DS_2_NAME,rankds,s2_dim,s2_wbuf,err) 120 IF(err.LT.0) RETURN 121 122 !------------------------------------------------------------------------- 123 ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension 1 124 !------------------------------------------------------------------------- 125 126 CALL test_begin(' Test Attaching Dimension Scale ') 127 128 ! get the dataset id for DSET_NAME 129 CALL H5Dopen_f(fid, DSET_NAME, did, err) 130 IF(err.LT.0) RETURN 131 132 ! get the DS dataset id 133 CALL H5Dopen_f(fid, DS_1_NAME, dsid, err) 134 IF(err.LT.0) RETURN 135 136 ! check attaching to a non-existent dimension; should fail 137 CALL H5DSattach_scale_f(did, dsid, 20, err) 138 IF(err.NE.-1) THEN 139 err = FAILED ! should fail, mark as an error 140 CALL write_test_status(err) 141 RETURN 142 ENDIF 143 144 ! attach the DS_1_NAME dimension scale to DSET_NAME at dimension index 1 145 CALL H5DSattach_scale_f(did, dsid, DIM1, err) 146 IF(err.EQ.-1) THEN 147 CALL write_test_status(err) 148 RETURN 149 ENDIF 150 CALL write_test_status(err) 151 152 CALL test_begin(' Test If Dimension Scale Attached ') 153 154 CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err) 155 IF(err.EQ.-1.OR..NOT.is_attached) THEN 156 err = FAILED 157 CALL write_test_status(err) 158 RETURN 159 ENDIF 160 CALL write_test_status(err) 161 162 ! Check to see how many Dimension Scales are attached 163 164 CALL test_begin(' Test Getting Number Dimension Scales ') 165 166 CALL H5DSget_num_scales_f(did, DIM1, num_scales, err) 167 IF(err.LT.0.OR.num_scales.NE.1)THEN 168 err = FAILED 169 CALL write_test_status(err) 170 RETURN 171 ENDIF 172 CALL write_test_status(err) 173 174 CALL test_begin(' Test Detaching Dimension Scale ') 175 176 ! Detach scale 177 CALL H5DSdetach_scale_f(did, dsid, DIM1, err) 178 IF(err.LT.0) RETURN 179 180 ! Check to see if a dimension scale is attached, should be .false. 181 CALL H5DSis_attached_f(did, dsid, DIM1, is_attached, err) 182 IF(err.LT.0.OR.is_attached)THEN 183 err = FAILED 184 CALL write_test_status(err) 185 RETURN 186 ENDIF 187 CALL write_test_status(err) 188 189 !------------------------------------------------------------------------- 190 ! set the DS_1_NAME dimension scale to DSET_NAME at dimension 0 191 !------------------------------------------------------------------------- 192 193 CALL test_begin(' Test Setting Dimension Scale ') 194 195 CALL H5DSset_scale_f(dsid, err, "Dimension Scale Set 1") 196 IF(err.LT.0.OR.is_attached)THEN 197 err = FAILED 198 CALL write_test_status(err) 199 RETURN 200 ENDIF 201 CALL write_test_status(err) 202 203 CALL test_begin(' Test If Dimension Scale ') 204 205 CALL H5DSis_scale_f(dsid, is_scale, err) 206 IF(err.LT.0.OR..NOT.is_scale)THEN 207 err = FAILED 208 CALL write_test_status(err) 209 RETURN 210 ENDIF 211 CALL write_test_status(err) 212 213 ! Get scale name; test to large character buffer 214 215 CALL test_begin(' Test Getting Dimension Scale By Name ') 216 217 name_len = 25 218 name = '' 219 CALL H5DSget_scale_name_f(dsid, name, name_len, err) 220 IF(err.LT.0 .OR. & 221 name_len.NE.21 .OR. & 222 TRIM(name).NE."Dimension Scale Set 1" .OR. & 223 name(22:25).NE.' ')THEN 224 err = FAILED 225 CALL write_test_status(err) 226 RETURN 227 ENDIF 228 229 ! Get scale name; test exact size character buffer 230 name_len = 21 231 name = '' 232 CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) 233 IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimension Scale Set 1")THEN 234 err = FAILED 235 CALL write_test_status(err) 236 RETURN 237 ENDIF 238 239 ! Get scale name; test to small character buffer 240 name_len = 5 241 name = '' 242 CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) 243 IF(err.LT.0.OR.name_len.NE.21.OR.TRIM(name).NE."Dimen")THEN 244 err = FAILED 245 CALL write_test_status(err) 246 RETURN 247 ENDIF 248 249 ! close DS id 250 CALL H5Dclose_f(dsid, err) 251 IF(err.LT.0) RETURN 252 253 !------------------------------------------------------------------------- 254 ! attach the DS_2_NAME dimension scale to DSET_NAME 255 !------------------------------------------------------------------------- 256 257 ! get the DS dataset id 258 CALL H5Dopen_f(fid, DS_2_NAME, dsid, err) 259 IF(err.LT.0) RETURN 260 261 ! attach the DS_2_NAME dimension scale to DSET_NAME as the 2nd dimension (index 2) 262 CALL H5DSattach_scale_f(did, dsid, DIM2, err) 263 IF(err.LT.0) RETURN 264 265 CALL H5DSis_attached_f(did, dsid, DIM2, is_attached, err) 266 IF(err.LT.0) RETURN 267 268 ! test sending no Dimension Scale name 269 270 CALL H5DSset_scale_f(dsid, err) 271 IF(err.LT.0)THEN 272 CALL write_test_status(err) 273 RETURN 274 ENDIF 275 276 CALL H5DSis_scale_f(dsid, is_scale, err) 277 IF(err.LT.0.OR..NOT.is_scale)THEN 278 err = FAILED 279 CALL write_test_status(err) 280 RETURN 281 ENDIF 282 283 ! Get scale name when there is no scale name 284 name_len = 5 285 name = '' 286 CALL H5DSget_scale_name_f(dsid, name(1:name_len), name_len, err) 287 IF(err.LT.0.OR.name_len.NE.0)THEN ! name_len is 0 if no name is found 288 err = FAILED 289 CALL write_test_status(err) 290 RETURN 291 ENDIF 292 293 CALL write_test_status(err) 294 295 CALL test_begin(' Test Setting Dimension Scale Label ') 296 297 CALL H5DSset_label_f(did, DIM2, "Label12", err) 298 IF(err.LT.0)THEN 299 CALL write_test_status(err) 300 RETURN 301 ENDIF 302 303 ! Test label where character length is to small 304 305 label_len = 5 306 label = '' 307 CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err) 308 IF(err.LT.0.OR.label(1:5).NE."Label".OR.label_len.NE.7)THEN 309 err = FAILED 310 CALL write_test_status(err) 311 RETURN 312 ENDIF 313 314 ! Test label where character length is exact 315 316 label_len = 7 317 label = '' 318 CALL H5DSget_label_f(did, DIM2, label(1:label_len), label_len, err) 319 IF(err.LT.0.OR.label(1:label_len).NE."Label12".OR.label_len.NE.7)THEN 320 err = FAILED 321 CALL write_test_status(err) 322 RETURN 323 ENDIF 324 325 ! Test label where character length is to big 326 327 label_len = 25 328 label = '' 329 CALL H5DSget_label_f(did, DIM2, label, label_len, err) 330 IF(err.LT.0.OR. & 331 label(1:label_len).NE."Label12" .OR. & 332 label_len.NE.7 .OR. & 333 label(8:25).NE.' ')THEN 334 err = FAILED 335 CALL write_test_status(err) 336 RETURN 337 ENDIF 338 CALL write_test_status(err) 339 340 ! close DS id 341 CALL H5Dclose_f(dsid, err) 342 IF(err.LT.0) RETURN 343 344 ! close file 345 CALL H5Fclose_f(fid, err) 346 IF(err.LT.0) RETURN 347 348END SUBROUTINE test_testds 349 350END MODULE TSTDS_TESTS 351 352PROGRAM test_ds 353 354 USE TSTDS_TESTS ! module for testing dataset routines 355 356 IMPLICIT NONE 357 358 INTEGER :: err 359 360 CALL test_testds(err) 361 362 IF(err.LT.0)THEN 363 WRITE(*,'(5X,A)') "DIMENSION SCALES TEST *FAILED*" 364 ENDIF 365 366END PROGRAM test_ds 367 368