Check-in [fbca0aea0c]
Overview
Comment:Updated to treat NULL return values as errors from most types of return types
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: fbca0aea0cbe4a57a253fef1ddb84731ba8968a0
User & Date: rkeene on 2014-06-17 16:56:08
Other Links: manifest | tags
Context
2014-06-18
04:45
Rewrote high-level API to support a handle-based interface check-in: daa895fdb4 user: rkeene tags: trunk
2014-06-17
16:56
Updated to treat NULL return values as errors from most types of return types check-in: fbca0aea0c user: rkeene tags: trunk
16:42
Updated to include a more reliable test for "mkdir" check-in: a4245ab3df user: rkeene tags: trunk
Changes

Modified tcc4tcl.tcl from [7f2fbfc8a7] to [cb9913280b].

308
309
310
311
312
313
314









315
316
317
318
319
320
321
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330







+
+
+
+
+
+
+
+
+







	#   double
	#   char*     (TCL_STATIC char*)
	#   string    (TCL_DYNAMIC char*)
	#   dstring   (TCL_DYNAMIC char*)
	#   vstring   (TCL_VOLATILE char*)
	#   default   (Tcl_Obj*)
	#   wide
	switch -- $rtype {
		void - ok - int - long - float - double - wide {}
		default {
			append cbody "  if (rv == NULL) {\n"
			append cbody "    return(TCL_ERROR);\n"
			append cbody "  }\n"
		}
	}

	switch -- $rtype {
		void           { }
		ok             { append cbody "  return rv;" "\n" }
		int            { append cbody "  Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" }
		long           { append cbody "  Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" }
		float          -
		double         { append cbody "  Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" }

Modified test from [e33a20cdc2] to [22ae724521].

26
27
28
29
30
31
32








33
34
35
36
37
38

39
40
41
42
43
44
45









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
52
53
54
55
56
57
58
59
60
61
62
63







+
+
+
+
+
+
+
+






+







+
+
+
+
+
+
+
+
+
	if (mkdir_ret != 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("failed", -1));
		return(TCL_ERROR);
	};
	return(TCL_OK);
}

# Return error on NULL
tcc4tcl::cproc test4 {int v} char* {
	if (v == 1) {
		return("ok");
	}

	return(NULL);
}

puts [test 1]
puts [test1 1]
puts [test3 1]
puts [::bob::test1 1]
puts [add [test 1] 1]
puts [test4 1]

catch {
	puts [mkdir "/"]
} err
if {$err != "failed"} {
	error "\[mkdir\] did not return the expected error"
}

catch {
	set v 0
	puts [test4 0]
	set v 1
} err
if {$err != "" || $v == 1} {
	error "\[test4\] did not return the expected error"
}