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    308   	#   double
   309    309   	#   char*     (TCL_STATIC char*)
   310    310   	#   string    (TCL_DYNAMIC char*)
   311    311   	#   dstring   (TCL_DYNAMIC char*)
   312    312   	#   vstring   (TCL_VOLATILE char*)
   313    313   	#   default   (Tcl_Obj*)
   314    314   	#   wide
          315  +	switch -- $rtype {
          316  +		void - ok - int - long - float - double - wide {}
          317  +		default {
          318  +			append cbody "  if (rv == NULL) {\n"
          319  +			append cbody "    return(TCL_ERROR);\n"
          320  +			append cbody "  }\n"
          321  +		}
          322  +	}
          323  +
   315    324   	switch -- $rtype {
   316    325   		void           { }
   317    326   		ok             { append cbody "  return rv;" "\n" }
   318    327   		int            { append cbody "  Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" }
   319    328   		long           { append cbody "  Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" }
   320    329   		float          -
   321    330   		double         { append cbody "  Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" }

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

    26     26   	if (mkdir_ret != 0) {
    27     27   		Tcl_SetObjResult(interp, Tcl_NewStringObj("failed", -1));
    28     28   		return(TCL_ERROR);
    29     29   	};
    30     30   	return(TCL_OK);
    31     31   }
    32     32   
           33  +# Return error on NULL
           34  +tcc4tcl::cproc test4 {int v} char* {
           35  +	if (v == 1) {
           36  +		return("ok");
           37  +	}
           38  +
           39  +	return(NULL);
           40  +}
    33     41   
    34     42   puts [test 1]
    35     43   puts [test1 1]
    36     44   puts [test3 1]
    37     45   puts [::bob::test1 1]
    38     46   puts [add [test 1] 1]
           47  +puts [test4 1]
    39     48   
    40     49   catch {
    41     50   	puts [mkdir "/"]
    42     51   } err
    43     52   if {$err != "failed"} {
    44     53   	error "\[mkdir\] did not return the expected error"
    45     54   }
           55  +
           56  +catch {
           57  +	set v 0
           58  +	puts [test4 0]
           59  +	set v 1
           60  +} err
           61  +if {$err != "" || $v == 1} {
           62  +	error "\[test4\] did not return the expected error"
           63  +}