1C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 2C Copyright by The HDF Group. * 3C Copyright by the Board of Trustees of the University of Illinois. * 4C All rights reserved. * 5C * 6C This file is part of HDF. The full HDF copyright notice, including * 7C terms governing use, modification, and redistribution, is contained in * 8C the COPYING file, which can be found at the root of the source code * 9C distribution tree, or in https://support.hdfgroup.org/ftp/HDF/releases/. * 10C If you do not have access to either file, you may request a copy from * 11C help@hdfgroup.org. * 12C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 13C 14C $Id$ 15C 16 subroutine tanfilef (number_failed) 17C 18C 19C Test program: 20C Writes file labels and descriptions in a file. 21C Reads the labels and descriptions from the file 22C 23C Input file: none 24C Output files: tdfanflF.hdf 25C 26C Possible bug: When reading in a label, we have to give it a 27C length that is one greater than MAXLEN_LAB. This 28C may be due to a bug in dfan.c in DFANIgetann(). 29C 30 31 implicit none 32 include 'fortest.inc' 33 34 integer number_failed 35 character*20 myname 36 parameter (myname = 'anfile') 37 38 integer ret 39 integer ISFIRST, NOFIRST, MAXLEN_LAB, MAXLEN_DESC 40 integer fid 41 42 character*35 lab1, lab2 43 character*35 templab 44 character*100 desc1, desc2, tempstr 45 character*64 TESTFILE 46 character*1 CR 47 48 call ptestban('Testing', myname) 49 ISFIRST = 1 50 NOFIRST = 0 51 number_failed = 0 52 TESTFILE = 'tdfanflF.hdf' 53 CR = char(10) 54 MAXLEN_LAB = 35 55 MAXLEN_DESC = 100 56 57 lab1 = 'File label #1: aaa' 58 lab2 = 'File label #2: bbbbbb' 59 desc1 = 'File descr #1: This is a test file annotation' 60 desc2 = 'File descr #2: One more test ...' 61 62 call MESSAGE(VERBO_HI, '****** Write file labels *******') 63 fid = hopen(TESTFILE, DFACC_CREATE, 0) 64 call VRFY(fid, 'hopen', number_failed) 65 ret = daafid(fid, lab1) 66 call VRFY(ret, 'daafid', number_failed) 67 68 ret = daafid(fid, lab2) 69 call VRFY(ret, 'daafid', number_failed) 70 71 call MESSAGE(VERBO_HI, '****** Write file descriptions *******') 72 ret = daafds(fid, desc1, len(desc1)) 73 call VRFY(ret, 'daafds', number_failed) 74 75 ret = daafds(fid, desc2, len(desc2)) 76 call VRFY(ret, 'daafds', number_failed) 77 78 ret = hclose(fid) 79 call VRFY(ret, 'hclose', number_failed) 80 81 call MESSAGE(VERBO_HI, 82 + '****** Read length of the first file label ****') 83 fid = hopen(TESTFILE, DFACC_READ, 0) 84 call VRFY(fid, 'hopen-read', number_failed) 85 ret = dagfidl(fid, ISFIRST) 86 call VRFY(ret, 'dagfidl', number_failed) 87 call checklen(ret, lab1, 'label' ) 88 89 call MESSAGE(VERBO_HI, '******...followed by the label *****') 90 ret = dagfid(fid, templab, MAXLEN_LAB, ISFIRST) 91 92 call VRFY(ret, 'dagfid', number_failed) 93 call checklab(lab1, templab, ret, 'label') 94 95 call MESSAGE(VERBO_HI, 96 + '****** Read length of the second file label ****') 97 ret = dagfidl(fid, NOFIRST) 98 call VRFY(ret, 'dagfidl', number_failed) 99 call checklen(ret, lab2, 'label') 100 101 call MESSAGE(VERBO_HI, '******...followed by the label *****') 102 ret = dagfid(fid, templab, MAXLEN_LAB, NOFIRST) 103 call VRFY(ret, 'dagfid', number_failed) 104 call checklab(lab2, templab, ret, 'label') 105 106 call MESSAGE(VERBO_HI, 107 + '****** Read length of the first file description ****') 108 ret = dagfdsl(fid, ISFIRST) 109 call VRFY(ret, 'dagfdsl', number_failed) 110 call checklen(ret, desc1, 'description' ) 111 112 call MESSAGE(VERBO_HI, 113 + '******...followed by the description *****') 114 ret = dagfds(fid, tempstr, MAXLEN_DESC, ISFIRST) 115 call VRFY(ret, 'dagfds', number_failed) 116 call checkann(desc1, tempstr, ret, 'description') 117 118 call MESSAGE(VERBO_HI, 119 + '****** Read length of the second file description ****') 120 ret = dagfdsl(fid, NOFIRST) 121 call VRFY(ret, 'dagfdsl', number_failed) 122 call checklen(ret, desc2, 'description' ) 123 124 call MESSAGE(VERBO_HI, 125 + '******...followed by the description *****') 126 ret = dagfds(fid, tempstr, MAXLEN_DESC, NOFIRST) 127 call VRFY(ret, 'dagfds', number_failed) 128 call checkann(desc2, tempstr, ret, 'description') 129 130 ret = hclose(fid) 131 call VRFY(ret, 'hclose', number_failed) 132 133 if (number_failed .eq. 0) then 134 call MESSAGE(VERBO_HI, 135 + '***** ALL DFANFILE TESTS SUCCESSFUL ******') 136 else 137 print *, '********', number_failed, ' TESTS FAILED' 138 endif 139 140 141 return 142 end 143 144 145C********************************************* 146C 147C checklen 148C 149C********************************************* 150 151 subroutine checklen(ret, oldstr, type) 152 implicit none 153 character*(*) type, oldstr 154 integer ret 155 156 integer oldlen 157 158 oldlen = len(oldstr) 159 if (ret .ge. 0 .and. ret .ne. oldlen) then 160 print *, 'Length of ', type, ' is ', len(oldstr), 161 * ' instead of ', ret 162 endif 163 return 164 end 165 166C*********************************************** 167C 168C checkann 169C 170C*********************************************** 171 172 subroutine checkann(oldstr, newstr, ret, type) 173 implicit none 174 character*90 oldstr, newstr 175 character*(*) type 176 integer ret 177 178 179 if (ret .ge. 0 .and. oldstr .ne. newstr) then 180 print *, type, ' is incorrect.' 181 print *, ' It should be <', oldstr, '>' 182 print *, ' instead of <', newstr, '>' 183 endif 184 return 185 end 186 187C*********************************************** 188C 189C checklab 190C 191C*********************************************** 192 193 subroutine checklab(oldstr, newstr, ret, type) 194 implicit none 195 character*30 oldstr, newstr 196 character*(*) type 197 integer ret 198 199 200 if (ret .ge. 0 .and. oldstr .ne. newstr) then 201 print *, type, ' is incorrect.' 202 print *, ' It should be <', oldstr, '>' 203 print *, ' instead of <', newstr, '>' 204 endif 205 return 206 end 207