Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -31,11 +31,11 @@ rm -f __test__.tcl coverage: $(MAKE) clean $(MAKE) example.so XVFS_ADD_CFLAGS=-coverage XVFS_ADD_LDFLAGS=-coverage - $(MAKE) test + $(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 Index: example/main.tcl ================================================================== --- example/main.tcl +++ example/main.tcl @@ -1,9 +1,11 @@ #! /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] @@ -27,13 +29,11 @@ } else { return false } }}] -tcltest::testConstraint tcl87 [string match "8.7.*" [info patchlevel]] - -tcltest::test xvfs-basic-seek "Xvfs Seek Test" -setup { +tcltest::test xvfs-seek-basic "Xvfs Seek Test" -setup { set fd [open $testFile] } -body { seek $fd 0 end seek $fd -1 current @@ -40,10 +40,55 @@ 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 { @@ -81,12 +126,17 @@ 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 @@ -115,10 +165,40 @@ } -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 @@ -171,11 +251,17 @@ $::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 Index: xvfs-core.c ================================================================== --- xvfs-core.c +++ xvfs-core.c @@ -125,33 +125,10 @@ XVFS_DEBUG_LEAVE; return(pathFinal); } -static const char *xvfs_perror(int xvfs_error) { - if (xvfs_error >= 0) { - return("Not an error"); - } - - switch (xvfs_error) { - case XVFS_RV_ERR_ENOENT: - return("No such file or directory"); - case XVFS_RV_ERR_EINVAL: - return("Invalid argument"); - case XVFS_RV_ERR_EISDIR: - return("Is a directory"); - case XVFS_RV_ERR_ENOTDIR: - return("Not a directory"); - case XVFS_RV_ERR_EFAULT: - return("Bad address"); - case XVFS_RV_ERR_INTERNAL: - return("Internal error"); - default: - return("Unknown error"); - } -} - static int xvfs_errorToErrno(int xvfs_error) { if (xvfs_error >= 0) { return(0); } @@ -164,16 +141,38 @@ 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 { @@ -574,11 +573,16 @@ 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"); + 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); } Index: xvfs-core.h ================================================================== --- xvfs-core.h +++ xvfs-core.h @@ -29,10 +29,11 @@ #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)