Overview
Comment: | More tests and small fixes |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA3-256: |
10f67b2ced82317ba994558381756ff1 |
User & Date: | rkeene on 2019-09-16 20:43:45 |
Other Links: | manifest | tags |
Context
2019-09-16
| ||
21:02 | More tests and cleaned up error handling for POSIX error codes check-in: e786b9e07b user: rkeene tags: trunk | |
20:43 | More tests and small fixes check-in: 10f67b2ced user: rkeene tags: trunk | |
20:04 | Added a coverage target to emit code coverage from tests check-in: 77d5262842 user: rkeene tags: trunk | |
Changes
Modified Makefile from [be830d5dd1] to [11debdaef9].
︙ | ︙ | |||
29 30 31 32 33 34 35 | echo 'if {[catch { load ./example.so Xvfs_example; source //xvfs:/example/main.tcl }]} { puts stderr $$::errorInfo; exit 1 }; exit 0' > __test__.tcl $(GDB) $(TCLSH) __test__.tcl $(TCL_TEST_ARGS) rm -f __test__.tcl coverage: $(MAKE) clean $(MAKE) example.so XVFS_ADD_CFLAGS=-coverage XVFS_ADD_LDFLAGS=-coverage | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | echo 'if {[catch { load ./example.so Xvfs_example; source //xvfs:/example/main.tcl }]} { puts stderr $$::errorInfo; exit 1 }; exit 0' > __test__.tcl $(GDB) $(TCLSH) __test__.tcl $(TCL_TEST_ARGS) rm -f __test__.tcl coverage: $(MAKE) clean $(MAKE) example.so XVFS_ADD_CFLAGS=-coverage XVFS_ADD_LDFLAGS=-coverage $(MAKE) test XVFS_TEST_EXIT_ON_FAILURE=0 rm -f xvfs-test-coverage.info lcov --capture --directory . --output-file xvfs-test-coverage.info rm -rf xvfs-test-coverage mkdir xvfs-test-coverage genhtml xvfs-test-coverage.info --output-directory xvfs-test-coverage rm -f xvfs-test-coverage.info |
︙ | ︙ |
Modified example/main.tcl from [a1ab38e038] to [5b23a3839e].
1 2 3 4 5 6 7 8 9 10 11 | #! /usr/bin/env tclsh package require tcltest tcltest::configure -verbose pbse tcltest::configure {*}$argv set rootDir "//xvfs:/example" set rootDirNative [file join [pwd] example] #set rootDir $rootDirNative set testFile "${rootDir}/foo" | > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 | #! /usr/bin/env tclsh package require tcltest tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]] tcltest::configure -verbose pbse tcltest::configure {*}$argv set rootDir "//xvfs:/example" set rootDirNative [file join [pwd] example] #set rootDir $rootDirNative set testFile "${rootDir}/foo" |
︙ | ︙ | |||
25 26 27 28 29 30 31 | if {!!$expected == !!$actual} { return true } else { return false } }}] | < < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 | if {!!$expected == !!$actual} { return true } else { return false } }}] tcltest::test xvfs-seek-basic "Xvfs Seek Test" -setup { set fd [open $testFile] } -body { seek $fd 0 end seek $fd -1 current read $fd 1 } -cleanup { close $fd unset fd } -result "\n" tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup { set fd [open $testFile] } -body { seek $fd 1 end } -cleanup { close $fd unset fd } -match glob -returnCodes error -result "*: invalid argument" tcltest::test xvfs-seek-past-eof "Xvfs Seek Past EOF File Test" -setup { set fd [open $testFile] } -body { seek $fd -10 current } -cleanup { close $fd unset fd } -match glob -returnCodes error -result "*: invalid argument" tcltest::test xvfs-seek-read-past-eof "Xvfs Seek Then Read Past EOF Test" -setup { set fd [open $testFile] } -body { seek $fd 0 end read $fd 1 read $fd 1 } -cleanup { close $fd unset fd } -result "" tcltest::test xvfs-basic-open-write "Xvfs Open For Writing Test" -setup { unset -nocomplain fd } -body { set fd [open $rootDir/new-file w] close $fd } -cleanup { if {[info exists fd]} { close $fd unset fd } catch { file delete $rootDir/new-file } } -match glob -returnCodes error -result "*read*only file*system*" tcltest::test xvfs-basic-two-files "Xvfs Multiple Open Files Test" -setup { set fd1 [open $testFile] set fd2 [open $testFile] } -body { set data1 [read $fd1] close $fd1 |
︙ | ︙ | |||
79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | incr ::calls }} $fd] vwait done list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}] } -cleanup { close $fd unset -nocomplain fd size done calls output } -result {1 1} tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body { llength [glob_verify *] } -result 3 tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body { llength [glob_verify f*] | > > > > > | 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | incr ::calls }} $fd] vwait done list [expr {$calls == ($size + 1)}] [expr {[lsort -integer $output] eq $output}] } -cleanup { close $fd update unset -nocomplain fd size done calls output } -result {1 1} tcltest::test xvfs-match-almost-root-neg "Xvfs Match Almost Root" -body { file exists ${rootDir}_DOES_NOT_EXIST } -match boolean -result false tcltest::test xvfs-glob-basic-any "Xvfs Glob Match Any Test" -body { llength [glob_verify *] } -result 3 tcltest::test xvfs-glob-basic-limited "Xvfs Glob Match Limited Test" -body { llength [glob_verify f*] |
︙ | ︙ | |||
113 114 115 116 117 118 119 120 121 122 123 124 125 126 | tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body { llength [glob_verify lib/*] } -result 1 tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body { lindex [glob_verify lib/*] 0 } -match glob -result "$rootDir/*" # Broken in Tcl 8.6 and earlier tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body { llength [glob //xvfs:/example/*] } -constraints tcl87 -result 3 tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body { | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 | tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-1 "Xvfs Glob Match Directory Included in Search Test (Count)" -body { llength [glob_verify lib/*] } -result 1 tcltest::test xvfs-glob-basic-limited-prefixed-other-dir-2 "Xvfs Glob Match Directory Included in Search Test (Value)" -body { lindex [glob_verify lib/*] 0 } -match glob -result "$rootDir/*" tcltest::test xvfs-access-basic-read "Xvfs acccess Read Basic Test" -body { file readable $testFile } -match boolean -result true tcltest::test xvfs-access-basic-write "Xvfs acccess Write Basic Test" -body { file writable $testFile } -match boolean -result false tcltest::test xvfs-access-basic-neg "Xvfs acccess Basic Negative Test" -body { file executable $testFile } -match boolean -result false tcltest::test xvfs-exists-basic-neg "Xvfs exists Basic Negative Test" -body { file exists $rootDir/does-not-exist } -match boolean -result false tcltest::test xvfs-stat-basic-file "Xvfs stat Basic File Test" -body { file stat $testFile fileInfo set fileInfo(type) } -cleanup { unset -nocomplain fileInfo } -result file tcltest::test xvfs-stat-basic-dir "Xvfs stat Basic Directory Test" -body { file stat $rootDir/lib fileInfo set fileInfo(type) } -cleanup { unset -nocomplain fileInfo } -result directory # Broken in Tcl 8.6 and earlier tcltest::test xvfs-glob-advanced-dir-with-pattern "Xvfs Glob Match Pattern and Directory Together" -body { llength [glob //xvfs:/example/*] } -constraints tcl87 -result 3 tcltest::test xvfs-glob-file-dirname "Xvfs Relies on file dirname" -body { |
︙ | ︙ | |||
169 170 171 172 173 174 175 176 177 178 179 180 181 | $::tcltest::numTests(Passed) \ $::tcltest::numTests(Failed) \ $::tcltest::numTests(Skipped) \ $::tcltest::numTests(Total) \ ] puts [string repeat - [string length [format $format - - - -]]] exit 1 } puts "ALL TESTS PASSED" exit 0 | > > > > > > | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 | $::tcltest::numTests(Passed) \ $::tcltest::numTests(Failed) \ $::tcltest::numTests(Skipped) \ $::tcltest::numTests(Total) \ ] puts [string repeat - [string length [format $format - - - -]]] if {[info exists ::env(XVFS_TEST_EXIT_ON_FAILURE)]} { exit $::env(XVFS_TEST_EXIT_ON_FAILURE) } exit 1 } puts "ALL TESTS PASSED" if {[info exists ::env(XVFS_TEST_EXIT_ON_SUCCESS)]} { exit $::env(XVFS_TEST_EXIT_ON_SUCCESS) } exit 0 |
Modified xvfs-core.c from [bf348346aa] to [ecbc07c77d].
︙ | ︙ | |||
123 124 125 126 127 128 129 | XVFS_DEBUG_PRINTF("... relative path: \"%s\"", pathFinal); XVFS_DEBUG_LEAVE; return(pathFinal); } | < < < < < < < < < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > > > > > > > > | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 | XVFS_DEBUG_PRINTF("... relative path: \"%s\"", pathFinal); XVFS_DEBUG_LEAVE; return(pathFinal); } static int xvfs_errorToErrno(int xvfs_error) { if (xvfs_error >= 0) { return(0); } switch (xvfs_error) { case XVFS_RV_ERR_ENOENT: return(ENOENT); case XVFS_RV_ERR_EINVAL: return(EINVAL); case XVFS_RV_ERR_EISDIR: return(EISDIR); case XVFS_RV_ERR_ENOTDIR: return(ENOTDIR); case XVFS_RV_ERR_EFAULT: return(EFAULT); case XVFS_RV_ERR_EROFS: return(EROFS); case XVFS_RV_ERR_INTERNAL: return(EINVAL); default: return(ERANGE); } } static const char *xvfs_perror(int xvfs_error) { if (xvfs_error >= 0) { return("Not an error"); } switch (xvfs_error) { case XVFS_RV_ERR_ENOENT: case XVFS_RV_ERR_EINVAL: case XVFS_RV_ERR_EISDIR: case XVFS_RV_ERR_ENOTDIR: case XVFS_RV_ERR_EFAULT: case XVFS_RV_ERR_EROFS: return(Tcl_ErrnoMsg(xvfs_errorToErrno(xvfs_error))); case XVFS_RV_ERR_INTERNAL: return("Internal error"); default: return("Unknown error"); } } /* * Xvfs Memory Channel */ struct xvfs_tclfs_channel_id { Tcl_Channel channel; struct xvfs_tclfs_instance_info *fsInstanceInfo; |
︙ | ︙ | |||
572 573 574 575 576 577 578 | const char *pathStr; XVFS_DEBUG_ENTER; XVFS_DEBUG_PRINTF("Asked to open(\"%s\", %x)...", Tcl_GetString(path), mode); if (mode & O_WRONLY) { | | > > > > > | 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 | const char *pathStr; XVFS_DEBUG_ENTER; XVFS_DEBUG_PRINTF("Asked to open(\"%s\", %x)...", Tcl_GetString(path), mode); if (mode & O_WRONLY) { XVFS_DEBUG_PUTS("... failed (asked to open for writing)"); if (interp) { Tcl_SetErrno(xvfs_errorToErrno(XVFS_RV_ERR_EROFS)); Tcl_SetResult(interp, (char *) Tcl_PosixError(interp), NULL); } XVFS_DEBUG_LEAVE; return(NULL); } path = xvfs_absolutePath(path); |
︙ | ︙ |
Modified xvfs-core.h from [38b72c1f15] to [d0f2e4af12].
︙ | ︙ | |||
27 28 29 30 31 32 33 34 35 36 37 38 39 40 | * not be changed. */ #define XVFS_RV_ERR_ENOENT (-8192) #define XVFS_RV_ERR_EINVAL (-8193) #define XVFS_RV_ERR_EISDIR (-8194) #define XVFS_RV_ERR_ENOTDIR (-8195) #define XVFS_RV_ERR_EFAULT (-8196) #define XVFS_RV_ERR_INTERNAL (-16383) #define XVFS_REGISTER_INTERFACE(name) int name(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo); #if defined(XVFS_MODE_STANDALONE) /* * In standalone mode, we just redefine calls to | > | 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 | * not be changed. */ #define XVFS_RV_ERR_ENOENT (-8192) #define XVFS_RV_ERR_EINVAL (-8193) #define XVFS_RV_ERR_EISDIR (-8194) #define XVFS_RV_ERR_ENOTDIR (-8195) #define XVFS_RV_ERR_EFAULT (-8196) #define XVFS_RV_ERR_EROFS (-8197) #define XVFS_RV_ERR_INTERNAL (-16383) #define XVFS_REGISTER_INTERFACE(name) int name(Tcl_Interp *interp, struct Xvfs_FSInfo *fsInfo); #if defined(XVFS_MODE_STANDALONE) /* * In standalone mode, we just redefine calls to |
︙ | ︙ |