XVFS
Check-in [10f67b2ced]
Login
HomeTimelineFilesBranchesTagsTicketsWiki
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: 10f67b2ced82317ba994558381756ff17b00802ed6b2caa8a67903010c0c9390
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified Makefile from [be830d5dd1] to [11debdaef9].

︙
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43

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
	$(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

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
32
33
34

35
36
37
38
39
40
41
42
43
44













































45
46
47
48
49
50
51

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::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

	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

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

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

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
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
181

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 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);
	}

	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
579






580
581
582
583
584
585
586

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");
		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

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
︙

Powered by Fossil · RSS