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
	#   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             { 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" }







>
>
>
>
>
>
>
>
>







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









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










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


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
















>
>
>
>
>
>
>
>






>







>
>
>
>
>
>
>
>
>
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"
}