tcl 0.0.1

data/.gitignore

@@ -0,0 +1 @@
+pkg

data/LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2009 Sam Stephenson
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

data/README.rdoc

@@ -0,0 +1,18 @@
+= tcl
+
+A minimal Ruby interface to libtcl.
+The library is written by Sam Stephenson. Aslak Hellesøy forked it to gemify it.
+
+== Note on Patches/Pull Requests
+ 
+* Fork the project.
+* Make your feature addition or bug fix.
+* Add tests for it. This is important so I don't break it in a
+  future version unintentionally.
+* Commit, do not mess with rakefile, version, or history.
+  (if you want to have your own version, that is fine but bump version in a commit by itself I can ignore when I pull)
+* Send me a pull request. Bonus points for topic branches.
+
+== Copyright
+
+Copyright (c) 2009 Sam Stephenson. See LICENSE for details.

data/Rakefile

@@ -0,0 +1,58 @@
+require 'rubygems'
+require 'rake'
+
+begin
+  require 'jeweler'
+  Jeweler::Tasks.new do |gem|
+    gem.name = "tcl"
+    gem.summary = %Q{Tcl bindings for Ruby}
+    gem.description = %Q{A minimal Ruby interface to libtcl}
+    gem.email = "sstephenson@gmail.com"
+    gem.homepage = "http://github.com/sstephenson/ruby-tcl"
+    gem.authors = ["Sam Stephenson"]
+
+    gem.extensions = FileList['ext/tcl_ruby/extconf.rb']
+    # gem is a Gem::Specification... see http://www.rubygems.org/read/chapter/20 for additional settings
+  end
+  Jeweler::GemcutterTasks.new
+rescue LoadError
+  puts "Jeweler (or a dependency) not available. Install it with: gem install jeweler"
+end
+
+require 'rake/testtask'
+Rake::TestTask.new(:test) do |test|
+  test.libs << 'lib' << 'test'
+  test.pattern = 'test/*.rb'
+  test.verbose = true
+end
+
+begin
+  require 'rcov/rcovtask'
+  Rcov::RcovTask.new do |test|
+    test.libs << 'test'
+    test.pattern = 'test/*.rb'
+    test.verbose = true
+  end
+rescue LoadError
+  task :rcov do
+    abort "RCov is not available. In order to run rcov, you must: sudo gem install spicycode-rcov"
+  end
+end
+
+task :test => [:check_dependencies, :compile]
+
+task :default => :test
+
+require 'rake/rdoctask'
+Rake::RDocTask.new do |rdoc|
+  version = File.exist?('VERSION') ? File.read('VERSION') : ""
+
+  rdoc.rdoc_dir = 'rdoc'
+  rdoc.title = "tcl #{version}"
+  rdoc.rdoc_files.include('README*')
+  rdoc.rdoc_files.include('lib/**/*.rb')
+end
+
+require 'rake/extensiontask'
+Rake::ExtensionTask.new("tcl_ruby")
+CLEAN.include ['**/*.{o,bundle,jar,so,obj,pdb,lib,def,exp,log}']

data/TODO

@@ -0,0 +1,2 @@
+* Tcl::Proc#builtin? should return false if the procedure has been overridden
+* Tcl::Interp#to_tcl should account for interpreter aliases (see http://wiki.tcl.tk/8766) and namespaces.

data/VERSION

@@ -0,0 +1 @@
+0.0.1

data/ext/tcl_ruby/extconf.rb

@@ -0,0 +1,8 @@
+require "mkmf"
+
+# 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_ruby")

data/ext/tcl_ruby/tcl_ruby.c

@@ -0,0 +1,225 @@
+#include <ruby.h>
+#include <tcl.h>
+
+typedef struct {
+  Tcl_Interp *interp;
+  VALUE exit_exception;
+} tcl_interp_struct;
+
+static VALUE rb_value_to_s(VALUE value) {
+  return rb_funcall(value, rb_intern("to_s"), 0, 0);
+}
+
+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(interp_receive_args)->len, RARRAY(interp_receive_args)->ptr);
+  
+  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);
+
+  if (rb_obj_is_kind_of(error_info, rb_eSystemExit)) {
+    tcl_interp->exit_exception = error_info;
+  }
+
+  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_rescue2(rb_tcl_interp_send_begin, args, rb_tcl_interp_send_rescue, args, rb_eException) == Qtrue) {
+    return TCL_OK;
+  } 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);
+  
+  tcl_interp->interp = Tcl_CreateInterp();
+  tcl_interp->exit_exception = Qnil;
+  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;
+}
+
+static VALUE rb_tcl_safe_interp_allocate(VALUE klass) {
+  VALUE obj = rb_tcl_interp_allocate(klass);
+
+  tcl_interp_struct *tcl_interp;
+  Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
+  
+  Tcl_MakeSafe(tcl_interp->interp);
+
+  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) {
+#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);
+    case TCL_ERROR:
+      if (NIL_P(tcl_interp->exit_exception)) {
+        rb_raise(error_class, "%s", tcl_interp->interp->result);
+      } else {
+        rb_exit(NUM2INT(rb_iv_get(tcl_interp->exit_exception, "status")));
+      }
+    default:
+      return Qnil;
+  }
+}
+
+static VALUE rb_tcl_interp_list_to_array(VALUE self, VALUE list) {
+  tcl_interp_struct *tcl_interp;
+  Data_Get_Struct(self, tcl_interp_struct, tcl_interp);
+  
+  Tcl_Obj *string = Tcl_NewStringObj(RSTRING(rb_value_to_s(list))->ptr, -1);
+  Tcl_IncrRefCount(string);
+
+  int list_length, i;
+  Tcl_Obj **elements;
+  
+  if (Tcl_ListObjGetElements(tcl_interp->interp, string, &list_length, &elements) != TCL_OK) {
+    Tcl_DecrRefCount(string);
+    return Qnil;
+  }
+  
+  for (i = 0; i < list_length; i++)
+    Tcl_IncrRefCount(elements[i]);
+  
+  VALUE result = rb_ary_new2(list_length);
+  
+  for (i = 0; i < list_length; i++) {
+    int element_length;
+    const char *element;
+    
+    element = Tcl_GetStringFromObj(elements[i], &element_length);
+    rb_ary_push(result, element ? rb_tainted_str_new(element, element_length) : rb_str_new2(""));
+    Tcl_DecrRefCount(elements[i]);
+  }
+  
+  Tcl_DecrRefCount(string);
+
+  return result;
+}
+
+static VALUE rb_tcl_interp_array_to_list(VALUE self, VALUE array) {
+  tcl_interp_struct *tcl_interp;
+  Data_Get_Struct(self, tcl_interp_struct, tcl_interp);
+
+  int array_length = RARRAY(array)->len, i;
+  
+  Tcl_Obj *list = Tcl_NewObj();
+  Tcl_IncrRefCount(list);
+  
+  for (i = 0; i < array_length; i++) {
+    VALUE element = rb_ary_entry(array, i);
+    Tcl_Obj *string = Tcl_NewStringObj(RSTRING(rb_value_to_s(element))->ptr, -1);
+
+    Tcl_IncrRefCount(string);
+    Tcl_ListObjAppendElement(tcl_interp->interp, list, string);
+    Tcl_DecrRefCount(string);
+  }
+
+  VALUE result = rb_tainted_str_new2(Tcl_GetStringFromObj(list, NULL));
+  
+  Tcl_DecrRefCount(list);
+  
+  return result;
+}
+
+void Init_tcl_ruby() {
+  VALUE tcl_module = rb_define_module("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, "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
+}

data/lib/.gitignore

@@ -0,0 +1,2 @@
+*.bundle
+*.so

data/lib/tcl.rb

@@ -0,0 +1,5 @@
+require "tcl_ruby"
+require "tcl/interp_helper"
+require "tcl/interp"
+require "tcl/proc"
+require "tcl/var"

data/lib/tcl/interp.rb

@@ -0,0 +1,51 @@
+module Tcl
+  class Interp
+    include InterpHelper
+    
+    class << self
+      def load_from_file(filename)
+        interp = new
+        interp.eval(IO.read(filename))
+        interp
+      end
+    end
+    
+    def interp
+      self
+    end
+    
+    def interp_receive(method, *args)
+      send("tcl_#{method}", *args)
+    end
+  
+    def expose(name)
+      _!(:interp, :alias, nil, name, nil, :interp_send, name)
+    end
+
+    def proc(name)
+      Tcl::Proc.new(self, name)
+    end
+    
+    def var(name)
+      Tcl::Var.find(self, name)
+    end
+
+    def procs
+      list_to_array _!(:info, :procs)
+    end
+    
+    def vars
+      list_to_array _!(:info, :vars)
+    end
+    
+    def to_tcl
+      %w( var proc ).inject([]) do |lines, type|
+        send("#{type}s").sort.each do |name|
+          object = send(type, name)
+          lines << object.to_tcl unless object.builtin?
+        end
+        lines
+      end.join("\n")
+    end
+  end
+end

data/lib/tcl/interp_helper.rb

@@ -0,0 +1,25 @@
+module Tcl
+  module InterpHelper
+    def self.included(klass)
+      klass.class_eval do
+        attr_reader :interp
+      end
+    end
+    
+    def _(*args)
+      interp.array_to_list(args)
+    end
+    
+    def _!(*args)
+      interp.eval(_(*args))
+    end
+    
+    def method_missing(name, *args, &block)
+      if interp.respond_to?(name)
+        interp.send(name, *args, &block)
+      else
+        super
+      end
+    end
+  end
+end

data/lib/tcl/proc.rb

@@ -0,0 +1,50 @@
+module Tcl
+  class Proc
+    BUILTINS = %w(
+      auto_execok auto_import auto_load auto_load_index 
+      auto_qualify tclLog unknown
+    )
+
+    include InterpHelper
+
+    attr_reader :name
+    
+    def initialize(interp, name)
+      @interp = interp
+      @name = name.to_s
+      to_tcl
+    end
+    
+    def arguments
+      list_to_array(_!(:info, :args, name)).map do |argument_name|
+        begin
+          variable_name = "__Tcl_Proc_arguments_#{name}_#{argument_name}"
+          if _!(:info, :default, name, argument_name, variable_name) == "0"
+            argument_name
+          else
+            _(argument_name, var(variable_name).value)
+          end
+        ensure
+          _!(:unset, variable_name)
+        end
+      end
+    end
+    
+    def body
+      _!(:info, :body, name)
+    end
+    
+    def call(*args)
+      _!(name, *args.map { |arg| arg.to_s })
+    end
+    
+    def to_tcl
+      _(:proc, name, _(*arguments), body)
+    end
+    
+    def builtin?
+      # TODO should also check to see if the definition has changed
+      BUILTINS.include?(name) 
+    end
+  end
+end

data/lib/tcl/var.rb

@@ -0,0 +1,54 @@
+module Tcl
+  class Var
+    BUILTINS = %w(
+      auto_index auto_oldpath auto_path env errorCode errorInfo
+      tcl_libPath tcl_library tcl_patchLevel tcl_pkgPath tcl_platform tcl_version
+    )
+    
+    include InterpHelper
+    
+    class << self
+      def find(interp, name)
+        if interp._!(:array, :exists, name) == "1"
+          ArrayVar.new(interp, name)
+        elsif interp._!(:info, :exists, name) == "1"
+          StringVar.new(interp, name)
+        else
+          raise Tcl::Error, "can't read \"#{name}\": no such variable"
+        end
+      end
+    end
+    
+    attr_reader :name
+    
+    def initialize(interp, name)
+      @interp = interp
+      @name = name.to_s
+      to_tcl
+    end
+    
+    def builtin?
+      BUILTINS.include?(name)
+    end
+  end
+  
+  class StringVar < Var
+    def value
+      _!(:set, name)
+    end
+    
+    def to_tcl
+      _(:set, name, value)
+    end
+  end
+  
+  class ArrayVar < Var
+    def value
+      _!(:array, :get, name)
+    end
+    
+    def to_tcl
+      _(:array, :set, name, value)
+    end
+  end
+end

data/script/console

@@ -0,0 +1,46 @@
+#!/usr/bin/env ruby
+
+require File.join(File.dirname(__FILE__), *%w".. lib tcl")
+
+class ConsoleInterp < Tcl::Interp
+  def initialize
+    super
+    expose :ruby_eval
+    expose :exit
+  end
+  
+  def tcl_ruby_eval(script)
+    Kernel.eval(script)
+  end
+  
+  def tcl_exit(code = 0)
+    exit(code.to_i)
+  end
+end
+
+filename = ARGV.shift || File.join(File.dirname(__FILE__), *%w".. .state.dat")
+interp   = ConsoleInterp.load_from_file(filename) rescue ConsoleInterp.new
+script   = ""
+
+at_exit do
+  File.open(filename, "w") do |file|
+    file.write(interp.to_tcl)
+  end
+end
+
+print ">> "
+$stdin.each_line do |line|
+  script << line
+  if interp.list_to_array(script)
+    begin
+      result = interp.eval(script)
+      puts result unless result.length.zero?
+    rescue Tcl::Error => e
+      puts "error: #{e}"
+    end
+    script = ""
+    print ">> "
+  else
+    print "?> "
+  end
+end

data/tcl.gemspec

@@ -0,0 +1,70 @@
+# Generated by jeweler
+# DO NOT EDIT THIS FILE DIRECTLY
+# Instead, edit Jeweler::Tasks in Rakefile, and run the gemspec command
+# -*- encoding: utf-8 -*-
+
+Gem::Specification.new do |s|
+  s.name = %q{tcl}
+  s.version = "0.0.1"
+
+  s.required_rubygems_version = Gem::Requirement.new(">= 0") if s.respond_to? :required_rubygems_version=
+  s.authors = ["Sam Stephenson"]
+  s.date = %q{2009-12-01}
+  s.description = %q{A minimal Ruby interface to libtcl}
+  s.email = %q{sstephenson@gmail.com}
+  s.extensions = ["ext/tcl_ruby/extconf.rb"]
+  s.extra_rdoc_files = [
+    "LICENSE",
+     "README.rdoc",
+     "TODO"
+  ]
+  s.files = [
+    ".gitignore",
+     "LICENSE",
+     "README.rdoc",
+     "Rakefile",
+     "TODO",
+     "VERSION",
+     "ext/tcl_ruby/extconf.rb",
+     "ext/tcl_ruby/tcl_ruby.c",
+     "lib/.gitignore",
+     "lib/tcl.rb",
+     "lib/tcl/interp.rb",
+     "lib/tcl/interp_helper.rb",
+     "lib/tcl/proc.rb",
+     "lib/tcl/var.rb",
+     "script/console",
+     "tcl.gemspec",
+     "test/fixtures/test.tcl",
+     "test/helper.rb",
+     "test/interp_receive_test.rb",
+     "test/interp_test.rb",
+     "test/proc_test.rb",
+     "test/test_helper.rb",
+     "test/var_test.rb"
+  ]
+  s.homepage = %q{http://github.com/sstephenson/ruby-tcl}
+  s.rdoc_options = ["--charset=UTF-8"]
+  s.require_paths = ["lib"]
+  s.rubygems_version = %q{1.3.5}
+  s.summary = %q{Tcl bindings for Ruby}
+  s.test_files = [
+    "test/helper.rb",
+     "test/interp_receive_test.rb",
+     "test/interp_test.rb",
+     "test/proc_test.rb",
+     "test/test_helper.rb",
+     "test/var_test.rb"
+  ]
+
+  if s.respond_to? :specification_version then
+    current_version = Gem::Specification::CURRENT_SPECIFICATION_VERSION
+    s.specification_version = 3
+
+    if Gem::Version.new(Gem::RubyGemsVersion) >= Gem::Version.new('1.2.0') then
+    else
+    end
+  else
+  end
+end
+

data/test/fixtures/test.tcl

@@ -0,0 +1,6 @@
+set a 0
+set b(a) 1
+set b(b) 2
+proc c args return
+proc d {a {b 0}} {return $b}
+proc e {} {}

data/test/helper.rb

@@ -0,0 +1,9 @@
+require 'rubygems'
+require 'test/unit'
+
+$LOAD_PATH.unshift(File.dirname(__FILE__))
+$LOAD_PATH.unshift(File.join(File.dirname(__FILE__), '..', 'lib'))
+require 'tcl'
+
+class Test::Unit::TestCase
+end

data/test/interp_receive_test.rb

@@ -0,0 +1,106 @@
+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 InterpWithExposedMethods < Tcl::Interp
+  def initialize
+    super
+    expose :hello
+  end
+  
+  def tcl_hello(who)
+    "hello, #{who}"
+  end
+end
+
+class InterpWithExitMethod < Tcl::Interp  
+  def tcl_exit
+    exit
+  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_returns_tcl_ok
+    assert_equal "0",           @interp.eval("catch {interp_send no_arguments}")
+  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
+  
+  def test_interp_send_with_custom_interp_receive_method
+    @interp = InterpWithCustomReceiveMethod.new
+    assert_raises(Tcl::Error) { @interp.eval("interp_send") }
+    assert_equal "foo",         @interp.eval("interp_send foo")
+    assert_equal "foo bar",     @interp.eval("interp_send foo bar")
+  end
+  
+  def test_interp_expose
+    @interp = InterpWithExposedMethods.new
+    assert_equal "hello, Sam",  @interp.eval("interp_send hello Sam")
+    assert_equal "hello, Sam",  @interp.eval("hello Sam")
+  end
+  
+  def test_interp_send_does_not_convert_system_exit_into_tcl_error
+    @interp = InterpWithExitMethod.new
+    assert_raises(SystemExit) { @interp.eval("interp_send exit") }
+  end
+end
+

data/test/interp_test.rb

@@ -0,0 +1,107 @@
+require File.join(File.dirname(__FILE__), "test_helper")
+
+class InterpTest < Test::Unit::TestCase
+  def setup
+    @interp = Tcl::Interp.new
+  end
+  
+  def test_load_from_file
+    vars, procs = @interp.vars, @interp.procs
+    @interp = Tcl::Interp.load_from_file(path_to_fixture("test.tcl"))
+
+    assert_equal ["a", "b"],       (@interp.vars - vars).sort
+    assert_equal ["c", "d", "e"],  (@interp.procs - procs).sort
+  end
+  
+  def test_eval
+    assert_equal "",                @interp.eval("")
+    assert_equal "0",               @interp.eval("return 0")
+    assert_equal "",                @interp.eval("return \"\"")
+    assert_equal "",                @interp.eval("return {}")
+    assert_equal " ",               @interp.eval("return \" \"")
+  end
+  
+  def test_eval_raises_on_tcl_exception
+    assert_raises(Tcl::Error)     { @interp.eval("nonexistent") }
+    assert_raises(Tcl::Error)     { @interp.eval("{") }
+    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])
+    assert_equal "{}",              @interp.array_to_list([""])
+    assert_equal "one",             @interp.array_to_list(["one"])
+    assert_equal "one two",         @interp.array_to_list(["one", "two"])
+    assert_equal "a { b} c",        @interp.array_to_list(["a", " b", "c"])
+    assert_equal "\\{",             @interp.array_to_list(["{"])
+    assert_equal "{\"}",            @interp.array_to_list(["\""])
+  end
+  
+  def test_list_to_array
+    assert_equal [],                @interp.list_to_array("")
+    assert_equal [""],              @interp.list_to_array("{}")
+    assert_equal ["one"],           @interp.list_to_array("one")
+    assert_equal ["one", "two"],    @interp.list_to_array("one two")
+    assert_equal ["a", " b", "c"],  @interp.list_to_array("a { b} c")
+    assert_equal ["a", " b", "c"],  @interp.list_to_array("a \\ b c")
+    assert_equal ["{"],             @interp.list_to_array("\\{")
+    assert_equal ["["],             @interp.list_to_array("\\[")
+    assert_equal ["\""],            @interp.list_to_array("\\\"")
+  end
+  
+  def test_procs
+    @interp.clear!
+    assert_equal [], @interp.procs
+    @interp.eval "proc foo {} {}"
+    assert_equal ["foo"], @interp.procs
+    @interp.eval "proc bar {} {}"
+    assert_equal ["bar", "foo"], @interp.procs.sort
+  end
+  
+  def test_vars
+    @interp.clear!
+    assert_equal [], @interp.vars
+    @interp.eval "set a 0"
+    assert_equal ["a"], @interp.vars
+    @interp.eval "set b(a) 0"
+    assert_equal ["a", "b"], @interp.vars.sort
+  end
+  
+  def test_proc
+    assert_raises(Tcl::Error) { @interp.proc("foo") }
+    @interp.eval "proc foo {} {}"
+    proc = @interp.proc("foo")
+    assert proc.is_a?(Tcl::Proc)
+    assert_equal "foo", proc.name
+  end
+  
+  def test_var
+    assert_raises(Tcl::Error) { @interp.var("foo") }
+    @interp.eval "set foo bar"
+    var = @interp.var("foo")
+    assert var.is_a?(Tcl::Var)
+    assert_equal "foo", var.name
+  end
+  
+  def test_to_tcl
+    @interp.eval IO.read(path_to_fixture("test.tcl"))
+    assert_equal <<-EOF.chomp, @interp.to_tcl
+set a 0
+array set b {a 1 b 2}
+proc c args return
+proc d {a {b 0}} {return $b}
+proc e {} {}
+    EOF
+  end
+  
+  def test_interp_helper_method_missing_super_passthrough
+    assert_raises(NoMethodError) { @interp.nonexistent }
+  end
+end

data/test/proc_test.rb

@@ -0,0 +1,42 @@
+require File.join(File.dirname(__FILE__), "test_helper")
+
+class ProcTest < Test::Unit::TestCase
+  def setup
+    @interp = Tcl::Interp.load_from_file(path_to_fixture("test.tcl"))
+  end
+  
+  def test_proc_arguments_for_proc_with_no_arguments
+    assert_equal [], @interp.proc("e").arguments
+  end
+  
+  def test_proc_arguments_for_proc_with_one_argument
+    assert_equal ["args"], @interp.proc("c").arguments
+  end
+
+  def test_proc_arguments_for_proc_with_default_argument
+    assert_equal ["a", "b 0"], @interp.proc("d").arguments
+  end
+  
+  def test_proc_body
+    assert_equal "return",    @interp.proc("c").body
+    assert_equal "return $b", @interp.proc("d").body
+    assert_equal "",          @interp.proc("e").body
+  end
+
+  def test_proc_call
+    assert_equal "",  @interp.proc("c").call
+    assert_equal "0", @interp.proc("d").call("a")
+    assert_equal "b", @interp.proc("d").call("a", "b")
+    assert_equal "",  @interp.proc("e").call
+  end
+  
+  def test_proc_call_raises_on_missing_argument
+    assert_raises(Tcl::Error) { @interp.proc("d").call }
+  end
+  
+  def test_proc_to_tcl
+    assert_equal "proc c args return", @interp.proc("c").to_tcl
+    assert_equal "proc d {a {b 0}} {return $b}", @interp.proc("d").to_tcl
+    assert_equal "proc e {} {}", @interp.proc("e").to_tcl
+  end
+end

data/test/test_helper.rb

@@ -0,0 +1,15 @@
+require "test/unit"
+require File.join(File.dirname(__FILE__), *%w".. lib tcl")
+
+class Tcl::Interp
+  def clear!
+    procs.each { |p| _! :rename, p, "" }
+    vars.each  { |v| _! :unset, v }
+  end
+end
+
+class Test::Unit::TestCase
+  def path_to_fixture(*path_pieces)
+    File.join(File.dirname(__FILE__), "fixtures", *path_pieces)
+  end
+end

data/test/var_test.rb

@@ -0,0 +1,56 @@
+require File.join(File.dirname(__FILE__), "test_helper")
+
+class VarTest < Test::Unit::TestCase
+  def setup
+    @interp = Tcl::Interp.load_from_file(path_to_fixture("test.tcl"))
+  end
+  
+  def test_var_find_raises_when_var_does_not_exist
+    assert_raises(Tcl::Error) { Tcl::Var.find(@interp, "nonexistent") }
+  end
+  
+  def test_var_find_returns_string_var
+    var = Tcl::Var.find(@interp, "a")
+    assert_equal "a", var.name
+    assert var.is_a?(Tcl::StringVar)
+  end
+  
+  def test_var_find_returns_array_var
+    var = Tcl::Var.find(@interp, "b")
+    assert_equal "b", var.name
+    assert var.is_a?(Tcl::ArrayVar)
+  end
+  
+  def test_string_var_value
+    assert_equal "0", @interp.var("a").value
+  end
+  
+  def test_array_var_value
+    assert_equal "a 1 b 2", @interp.var("b").value
+  end
+  
+  def test_string_var_to_tcl
+    assert_equal "set a 0", @interp.var("a").to_tcl
+  end
+  
+  def test_array_var_to_tcl
+    assert_equal "array set b {a 1 b 2}", @interp.var("b").to_tcl
+  end
+  
+  def test_array_var_to_tcl_does_not_modify_errorInfo
+    assert_errorinfo ""
+    Tcl::Var.find(@interp, "b")
+    assert_errorinfo ""
+  end
+  
+  def test_attempting_to_find_nonexistent_variable_does_not_modify_errorInfo
+    assert_errorinfo ""
+    assert_raises(Tcl::Error) { Tcl::Var.find(@interp, "nonexistent") }
+    assert_errorinfo ""
+  end
+  
+  protected
+    def assert_errorinfo(value)
+      assert_equal value, @interp.var("errorInfo").value
+    end
+end

metadata

@@ -0,0 +1,84 @@
+--- !ruby/object:Gem::Specification 
+name: tcl
+version: !ruby/object:Gem::Version 
+  version: 0.0.1
+platform: ruby
+authors: 
+- Sam Stephenson
+autorequire: 
+bindir: bin
+cert_chain: []
+
+date: 2009-12-01 00:00:00 +01:00
+default_executable: 
+dependencies: []
+
+description: A minimal Ruby interface to libtcl
+email: sstephenson@gmail.com
+executables: []
+
+extensions: 
+- ext/tcl_ruby/extconf.rb
+extra_rdoc_files: 
+- LICENSE
+- README.rdoc
+- TODO
+files: 
+- .gitignore
+- LICENSE
+- README.rdoc
+- Rakefile
+- TODO
+- VERSION
+- ext/tcl_ruby/extconf.rb
+- ext/tcl_ruby/tcl_ruby.c
+- lib/.gitignore
+- lib/tcl.rb
+- lib/tcl/interp.rb
+- lib/tcl/interp_helper.rb
+- lib/tcl/proc.rb
+- lib/tcl/var.rb
+- script/console
+- tcl.gemspec
+- test/fixtures/test.tcl
+- test/helper.rb
+- test/interp_receive_test.rb
+- test/interp_test.rb
+- test/proc_test.rb
+- test/test_helper.rb
+- test/var_test.rb
+has_rdoc: true
+homepage: http://github.com/sstephenson/ruby-tcl
+licenses: []
+
+post_install_message: 
+rdoc_options: 
+- --charset=UTF-8
+require_paths: 
+- lib
+required_ruby_version: !ruby/object:Gem::Requirement 
+  requirements: 
+  - - ">="
+    - !ruby/object:Gem::Version 
+      version: "0"
+  version: 
+required_rubygems_version: !ruby/object:Gem::Requirement 
+  requirements: 
+  - - ">="
+    - !ruby/object:Gem::Version 
+      version: "0"
+  version: 
+requirements: []
+
+rubyforge_project: 
+rubygems_version: 1.3.5
+signing_key: 
+specification_version: 3
+summary: Tcl bindings for Ruby
+test_files: 
+- test/helper.rb
+- test/interp_receive_test.rb
+- test/interp_test.rb
+- test/proc_test.rb
+- test/test_helper.rb
+- test/var_test.rb