Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Support for TIP 143 when compiled against Tcl 8.5. Tcl::Interp#eval t…

…akes an optional second argument, which specifies the maximum number of milliseconds for execution.

git-svn-id: svn://rubyforge.org/var/svn/tcl/trunk@13 017b7ecb-b1d0-4998-98d6-e9014aaf4887
  • Loading branch information...
commit 60c13cd8f63a7863652f51fc2c4a21246d11c00c 1 parent c986848
@sstephenson sstephenson authored
Showing with 53 additions and 4 deletions.
  1. +6 −1 src/extconf.rb
  2. +41 −3 src/tcl.c
  3. +6 −0 test/interp_test.rb
View
7 src/extconf.rb
@@ -1,3 +1,8 @@
require "mkmf"
-have_library("tcl")
+
+# To build against Tcl 8.5 on OS X Intel:
+# RC_ARCHS=i386 ruby extconf.rb --with-tcl-dir=/path/to/tcl8.5
+
+dir_config("tcl")
+have_library("tcl") unless have_library("tcl8.5")
create_makefile("tcl")
View
44 src/tcl.c
@@ -86,14 +86,46 @@ static VALUE rb_tcl_safe_interp_allocate(VALUE klass) {
return obj;
}
+#ifdef TCL_LIMIT_TIME
+static VALUE rb_tcl_interp_eval(VALUE self, VALUE args) {
+ VALUE script = rb_ary_entry(args, 0);
+
+ int timeout = 0;
+ if (RARRAY(args)->len == 2) {
+ timeout = NUM2INT(rb_ary_entry(args, 1));
+ }
+#else
static VALUE rb_tcl_interp_eval(VALUE self, VALUE script) {
- VALUE error_class = rb_const_get(rb_const_get(rb_cObject, rb_intern("Tcl")), rb_intern("Error"));
+#endif
tcl_interp_struct *tcl_interp;
Data_Get_Struct(self, tcl_interp_struct, tcl_interp);
+#ifdef TCL_LIMIT_TIME
+ if (timeout > 0) {
+ Tcl_Time timeout_time;
+ Tcl_GetTime(&timeout_time);
+ timeout_time.sec += (long) timeout / 1000;
+ timeout_time.usec += (long) (timeout % 1000) * 1000;
+
+ Tcl_LimitSetTime(tcl_interp->interp, &timeout_time);
+ Tcl_LimitTypeSet(tcl_interp->interp, TCL_LIMIT_TIME);
+ }
+#endif
+
int result = Tcl_Eval(tcl_interp->interp, RSTRING(rb_value_to_s(script))->ptr);
+
+ VALUE error_class = rb_const_get(rb_const_get(rb_cObject, rb_intern("Tcl")), rb_intern("Error"));
+#ifdef TCL_LIMIT_TIME
+ if (timeout > 0) {
+ if (Tcl_LimitTypeExceeded(tcl_interp->interp, TCL_LIMIT_TIME))
+ error_class = rb_const_get(rb_const_get(rb_cObject, rb_intern("Tcl")), rb_intern("Timeout"));
+
+ Tcl_LimitTypeReset(tcl_interp->interp, TCL_LIMIT_TIME);
+ }
+#endif
+
switch (result) {
case TCL_OK:
return rb_tainted_str_new2(tcl_interp->interp->result);
@@ -168,10 +200,16 @@ void Init_tcl() {
VALUE interp_class = rb_define_class_under(tcl_module, "Interp", rb_cObject);
VALUE safe_interp_class = rb_define_class_under(tcl_module, "SafeInterp", interp_class);
VALUE error_class = rb_define_class_under(tcl_module, "Error", rb_eStandardError);
-
+
rb_define_alloc_func(interp_class, rb_tcl_interp_allocate);
rb_define_alloc_func(safe_interp_class, rb_tcl_safe_interp_allocate);
- rb_define_method(interp_class, "eval", rb_tcl_interp_eval, 1);
rb_define_method(interp_class, "list_to_array", rb_tcl_interp_list_to_array, 1);
rb_define_method(interp_class, "array_to_list", rb_tcl_interp_array_to_list, 1);
+
+#ifdef TCL_LIMIT_TIME
+ VALUE timeout_class = rb_define_class_under(tcl_module, "Timeout", error_class);
+ rb_define_method(interp_class, "eval", rb_tcl_interp_eval, -2);
+#else
+ rb_define_method(interp_class, "eval", rb_tcl_interp_eval, 1);
+#endif
}
View
6 test/interp_test.rb
@@ -27,6 +27,12 @@ def test_eval_raises_on_tcl_exception
assert_raises(Tcl::Error) { @interp.eval("error") }
end
+ def test_eval_with_timeout_argument
+ if defined?(Tcl::Timeout)
+ assert_raises(Tcl::Timeout) { @interp.eval("while 1 {}", 100) }
+ end
+ end
+
def test_array_to_list
assert_equal "", @interp.array_to_list([])
assert_equal "{}", @interp.array_to_list([nil])
Please sign in to comment.
Something went wrong with that request. Please try again.