Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add Tcl::Interp#interp_receive and an interp_send command for calling…

… Ruby methods on Tcl::Interp instances from Tcl.

git-svn-id: svn://rubyforge.org/var/svn/tcl/trunk@5 017b7ecb-b1d0-4998-98d6-e9014aaf4887
  • Loading branch information...
commit 0da7faa0af82b3e402d053cdfc15c3b4dceafd80 1 parent c15e5da
@sstephenson sstephenson authored
View
4 lib/tcl/interp.rb
@@ -14,6 +14,10 @@ def interp
self
end
+ def interp_receive(method, *args)
+ send("tcl_#{method}", *args)
+ end
+
def proc(name)
Tcl::Proc.new(self, name)
end
View
2  script/console
@@ -21,7 +21,7 @@ $stdin.each_line do |line|
result = interp.eval(script)
puts result unless result.length.zero?
rescue Tcl::Error => e
- puts e
+ puts "error: #{e}"
end
script = ""
print ">> "
View
54 src/tcl.c
@@ -9,12 +9,59 @@ static VALUE rb_value_to_s(VALUE value) {
return rb_funcall(value, rb_intern("to_s"), 0, 0);
}
-void rb_tcl_interp_destroy(tcl_interp_struct *tcl_interp) {
+static void rb_tcl_interp_destroy(tcl_interp_struct *tcl_interp) {
Tcl_DeleteInterp(tcl_interp->interp);
Tcl_Release(tcl_interp->interp);
free(tcl_interp);
}
+static VALUE rb_tcl_interp_send_begin(VALUE args) {
+ VALUE obj = rb_ary_entry(args, 0);
+ VALUE interp_receive_args = rb_ary_entry(args, 1);
+
+ VALUE result = rb_funcall2(obj, rb_intern("interp_receive"), RARRAY_LEN(interp_receive_args), RARRAY_PTR(interp_receive_args));
+
+ tcl_interp_struct *tcl_interp;
+ Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
+
+ char *tcl_result = strdup(RSTRING(rb_value_to_s(result))->ptr);
+ Tcl_SetResult(tcl_interp->interp, tcl_result, (Tcl_FreeProc *)free);
+
+ return Qtrue;
+}
+
+static VALUE rb_tcl_interp_send_rescue(VALUE args, VALUE error_info) {
+ VALUE obj = rb_ary_entry(args, 0);
+ tcl_interp_struct *tcl_interp;
+ Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
+
+ char *tcl_result = strdup(RSTRING(rb_value_to_s(error_info))->ptr);
+ Tcl_SetResult(tcl_interp->interp, tcl_result, (Tcl_FreeProc *)free);
+
+ return Qfalse;
+}
+
+static int rb_tcl_interp_send(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
+ VALUE interp_receive_args = rb_ary_new2(objc - 1);
+ int i;
+
+ for (i = 1; i < objc; i++) {
+ int element_length;
+ const char *element;
+
+ element = Tcl_GetStringFromObj(objv[i], &element_length);
+ rb_ary_push(interp_receive_args, rb_tainted_str_new2(element));
+ }
+
+ VALUE args = rb_ary_new3(2, (VALUE) clientData, interp_receive_args);
+
+ if (rb_rescue(rb_tcl_interp_send_begin, args, rb_tcl_interp_send_rescue, args) == Qtrue) {
+ return TCL_RETURN;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
static VALUE rb_tcl_interp_allocate(VALUE klass) {
tcl_interp_struct *tcl_interp;
VALUE obj = Data_Make_Struct(klass, tcl_interp_struct, NULL, rb_tcl_interp_destroy, tcl_interp);
@@ -23,6 +70,8 @@ static VALUE rb_tcl_interp_allocate(VALUE klass) {
Tcl_Init(tcl_interp->interp);
Tcl_Preserve(tcl_interp->interp);
+ Tcl_CreateObjCommand(tcl_interp->interp, "interp_send", (Tcl_ObjCmdProc *)rb_tcl_interp_send, (ClientData) obj, (Tcl_CmdDeleteProc *)NULL);
+
return obj;
}
@@ -70,9 +119,8 @@ static VALUE rb_tcl_interp_list_to_array(VALUE self, VALUE list) {
return Qnil;
}
- for (i = 0; i < list_length; i++) {
+ for (i = 0; i < list_length; i++)
Tcl_IncrRefCount(elements[i]);
- }
VALUE result = rb_ary_new2(list_length);
View
67 test/interp_receive_test.rb
@@ -0,0 +1,67 @@
+require File.join(File.dirname(__FILE__), "test_helper")
+
+class InterpWithNoReceiveMethod < Tcl::Interp
+ undef_method :interp_receive
+end
+
+class InterpWithDefaultReceiveMethod < Tcl::Interp
+ def tcl_no_arguments
+ "hello"
+ end
+
+ def tcl_one_argument(arg)
+ arg
+ end
+
+ def tcl_variable_arguments(*args)
+ _(*args)
+ end
+
+ def tcl_multiply_by_5(n)
+ n.to_i * 5
+ end
+end
+
+class InterpWithCustomReceiveMethod < Tcl::Interp
+ def interp_receive(method, *args)
+ _(method, *args)
+ end
+end
+
+class InterpReceiveTest < Test::Unit::TestCase
+ def setup
+ @interp = InterpWithDefaultReceiveMethod.new
+ end
+
+ def test_interp_send_on_interp_with_no_interp_receive_method_should_raise
+ @interp = InterpWithDefaultReceiveMethod.new
+ assert_raises(Tcl::Error) { @interp.eval("interp_send") }
+ end
+
+ def test_interp_send_with_no_arguments_should_raise
+ assert_raises(Tcl::Error) { @interp.eval("interp_send") }
+ end
+
+ def test_interp_send_to_method_with_no_arguments
+ assert_equal "hello", @interp.eval("interp_send no_arguments")
+ assert_raises(Tcl::Error) { @interp.eval("interp_send no_arguments foo") }
+ end
+
+ def test_interp_send_to_method_with_one_argument
+ assert_raises(Tcl::Error) { @interp.eval("interp_send one_argument") }
+ assert_equal "foo", @interp.eval("interp_send one_argument foo")
+ assert_raises(Tcl::Error) { @interp.eval("interp_send one_argument foo bar") }
+ end
+
+ def test_interp_send_to_method_with_variable_arguments
+ assert_equal "", @interp.eval("interp_send variable_arguments")
+ assert_equal "foo", @interp.eval("interp_send variable_arguments foo")
+ assert_equal "foo bar", @interp.eval("interp_send variable_arguments foo bar")
+ end
+
+ def test_interp_send_converts_non_string_results_to_string
+ assert_equal "0", @interp.eval("interp_send multiply_by_5 0")
+ assert_equal "25", @interp.eval("interp_send multiply_by_5 5")
+ end
+end
+
Please sign in to comment.
Something went wrong with that request. Please try again.