ruby-tcl 0.1.0

This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
@@ -0,0 +1,11 @@
1
+ # .document is used by rdoc and yard to know how to generate documentation
2
+ # for example, it can be used to control how rdoc gets built when you do `gem install foo`
3
+
4
+ README.rdoc
5
+ lib/**/*.rb
6
+ bin/*
7
+
8
+ # Files below this - are treated as 'extra files', and aren't parsed for ruby code
9
+ -
10
+ features/**/*.feature
11
+ LICENSE
@@ -0,0 +1,41 @@
1
+ *.gem
2
+ .bundle
3
+ Gemfile.lock
4
+ pkg/*
5
+ tmp/*
6
+ # rcov generated
7
+ coverage
8
+
9
+ # rdoc generated
10
+ rdoc
11
+
12
+ # yard generated
13
+ doc
14
+ .yardoc
15
+
16
+ # Have editor/IDE/OS specific files you need to ignore? Consider using a global gitignore:
17
+ #
18
+ # * Create a file at ~/.gitignore
19
+ # * Include files you want ignored
20
+ # * Run: git config --global core.excludesfile ~/.gitignore
21
+ #
22
+ # After doing this, these files will be ignored in all your git projects,
23
+ # saving you from having to 'pollute' every project you touch with them
24
+ #
25
+ # Not sure what to needs to be ignored for particular editors/OSes? Here's some ideas to get you started. (Remember, remove the leading # of the line)
26
+ #
27
+ # For MacOS:
28
+ #
29
+ #.DS_Store
30
+ #
31
+ # For TextMate
32
+ #*.tmproj
33
+ #tmtags
34
+ #
35
+ # For emacs:
36
+ #*~
37
+ #\#*
38
+ #.\#*
39
+ #
40
+ # For vim:
41
+ #*.swp
data/Gemfile ADDED
@@ -0,0 +1,4 @@
1
+ source "http://rubygems.org"
2
+
3
+ # Specify your gem's dependencies in ruby-tcl.gemspec
4
+ gemspec
data/LICENSE ADDED
@@ -0,0 +1,20 @@
1
+ Copyright (c) 2008-2011 Sam Stephenson and Mark J. Titorenko
2
+
3
+ Permission is hereby granted, free of charge, to any person obtaining
4
+ a copy of this software and associated documentation files (the
5
+ "Software"), to deal in the Software without restriction, including
6
+ without limitation the rights to use, copy, modify, merge, publish,
7
+ distribute, sublicense, and/or sell copies of the Software, and to
8
+ permit persons to whom the Software is furnished to do so, subject to
9
+ the following conditions:
10
+
11
+ The above copyright notice and this permission notice shall be
12
+ included in all copies or substantial portions of the Software.
13
+
14
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
15
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
16
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
17
+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
18
+ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
19
+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
20
+ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
@@ -0,0 +1,30 @@
1
+ = ruby-tcl
2
+
3
+ A minimal Ruby interface to libtcl. The library was originally written
4
+ by Sam Stephenson. This edition was created by Mark J. Titorenko.
5
+
6
+ This fork uses the original C bindings written by Sam Stephenson in
7
+ order to integrate with libtcl. For a FFI implementation, see
8
+ https://github.com/factorypreset/ruby-tcl (which also contains some
9
+ other additions/improvements to the library).
10
+
11
+ The original codebase is located at
12
+ https://github.com/sstephenson/ruby-tcl - this is not a direct fork of
13
+ that codebase as it has been created from the ground up as a
14
+ Bueller-based gem.
15
+
16
+ == Note on Patches/Pull Requests
17
+
18
+ * Fork the project.
19
+ * Make your feature addition or bug fix.
20
+ * Add tests for it. This is important so I don't break it in a
21
+ future version unintentionally.
22
+ * Commit, do not mess with rakefile, version, or history.
23
+ (if you want to have your own version, that is fine but bump version
24
+ in a commit by itself I can ignore when I pull)
25
+ * Send me a pull request. Bonus points for topic branches.
26
+
27
+ == Copyright
28
+
29
+ Copyright (c) 2008-2001 Sam Stephenson and Mark J. Titorenko. See
30
+ LICENSE for details.
@@ -0,0 +1,45 @@
1
+ require 'rubygems'
2
+
3
+ begin
4
+ require 'bundler'
5
+ rescue LoadError
6
+ $stderr.puts "You must install bundler - run `gem install bundler`"
7
+ end
8
+
9
+ begin
10
+ Bundler.setup
11
+ rescue Bundler::BundlerError => e
12
+ $stderr.puts e.message
13
+ $stderr.puts "Run `bundle install` to install missing gems"
14
+ exit e.status_code
15
+ end
16
+ require 'rake'
17
+
18
+ require 'bueller'
19
+ Bueller::Tasks.new
20
+
21
+ require 'rake/testtask'
22
+ Rake::TestTask.new do |t|
23
+ t.libs << "test"
24
+ t.test_files = FileList['test/*_test.rb']
25
+ t.verbose = true
26
+ end
27
+
28
+ require 'rake/rdoctask'
29
+ Rake::RDocTask.new do |rdoc|
30
+ version = File.exist?('VERSION') ? File.read('VERSION') : ""
31
+
32
+ rdoc.main = 'README.rdoc'
33
+ rdoc.rdoc_dir = 'rdoc'
34
+ rdoc.title = "ruby-tcl #{version}"
35
+ rdoc.rdoc_files.include('README*')
36
+ rdoc.rdoc_files.include('lib/**/*.rb')
37
+ end
38
+
39
+ require 'rake/extensiontask'
40
+ Rake::ExtensionTask.new('tcl')
41
+ CLEAN.include ['**/*.{o,bundle,jar,so,obj,pdb,lib,def,exp,log}']
42
+
43
+ task :test => :compile
44
+ task :default => :test
45
+
@@ -0,0 +1,8 @@
1
+ require "mkmf"
2
+
3
+ # To build against Tcl 8.5 on OS X Intel:
4
+ # RC_ARCHS=i386 ruby extconf.rb --with-tcl-dir=/path/to/tcl8.5
5
+
6
+ dir_config("tcl")
7
+ have_library("tcl") unless have_library("tcl8.5")
8
+ create_makefile("tcl")
@@ -0,0 +1,225 @@
1
+ #include <ruby.h>
2
+ #include <tcl.h>
3
+
4
+ typedef struct {
5
+ Tcl_Interp *interp;
6
+ VALUE exit_exception;
7
+ } tcl_interp_struct;
8
+
9
+ static VALUE rb_value_to_s(VALUE value) {
10
+ return rb_funcall(value, rb_intern("to_s"), 0, 0);
11
+ }
12
+
13
+ static void rb_tcl_interp_destroy(tcl_interp_struct *tcl_interp) {
14
+ Tcl_DeleteInterp(tcl_interp->interp);
15
+ Tcl_Release(tcl_interp->interp);
16
+ free(tcl_interp);
17
+ }
18
+
19
+ static VALUE rb_tcl_interp_send_begin(VALUE args) {
20
+ VALUE obj = rb_ary_entry(args, 0);
21
+ VALUE interp_receive_args = rb_ary_entry(args, 1);
22
+
23
+ VALUE result = rb_funcall2(obj, rb_intern("interp_receive"), RARRAY_LEN(interp_receive_args), RARRAY_PTR(interp_receive_args));
24
+
25
+ tcl_interp_struct *tcl_interp;
26
+ Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
27
+
28
+ char *tcl_result = strdup(RSTRING_PTR(rb_value_to_s(result)));
29
+ Tcl_SetResult(tcl_interp->interp, tcl_result, (Tcl_FreeProc *)free);
30
+
31
+ return Qtrue;
32
+ }
33
+
34
+ static VALUE rb_tcl_interp_send_rescue(VALUE args, VALUE error_info) {
35
+ VALUE obj = rb_ary_entry(args, 0);
36
+ tcl_interp_struct *tcl_interp;
37
+ Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
38
+
39
+ char *tcl_result = strdup(RSTRING_PTR(rb_value_to_s(error_info)));
40
+ Tcl_SetResult(tcl_interp->interp, tcl_result, (Tcl_FreeProc *)free);
41
+
42
+ if (rb_obj_is_kind_of(error_info, rb_eSystemExit)) {
43
+ tcl_interp->exit_exception = error_info;
44
+ }
45
+
46
+ return Qfalse;
47
+ }
48
+
49
+ static int rb_tcl_interp_send(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) {
50
+ VALUE interp_receive_args = rb_ary_new2(objc - 1);
51
+ int i;
52
+
53
+ for (i = 1; i < objc; i++) {
54
+ int element_length;
55
+ const char *element;
56
+
57
+ element = Tcl_GetStringFromObj(objv[i], &element_length);
58
+ rb_ary_push(interp_receive_args, rb_tainted_str_new2(element));
59
+ }
60
+
61
+ VALUE args = rb_ary_new3(2, (VALUE) clientData, interp_receive_args);
62
+
63
+ if (rb_rescue2(rb_tcl_interp_send_begin, args, rb_tcl_interp_send_rescue, args, rb_eException) == Qtrue) {
64
+ return TCL_OK;
65
+ } else {
66
+ return TCL_ERROR;
67
+ }
68
+ }
69
+
70
+ static VALUE rb_tcl_interp_allocate(VALUE klass) {
71
+ tcl_interp_struct *tcl_interp;
72
+ VALUE obj = Data_Make_Struct(klass, tcl_interp_struct, NULL, rb_tcl_interp_destroy, tcl_interp);
73
+
74
+ tcl_interp->interp = Tcl_CreateInterp();
75
+ tcl_interp->exit_exception = Qnil;
76
+ Tcl_Init(tcl_interp->interp);
77
+ Tcl_Preserve(tcl_interp->interp);
78
+
79
+ Tcl_CreateObjCommand(tcl_interp->interp, "interp_send", (Tcl_ObjCmdProc *)rb_tcl_interp_send, (ClientData) obj, (Tcl_CmdDeleteProc *)NULL);
80
+
81
+ return obj;
82
+ }
83
+
84
+ static VALUE rb_tcl_safe_interp_allocate(VALUE klass) {
85
+ VALUE obj = rb_tcl_interp_allocate(klass);
86
+
87
+ tcl_interp_struct *tcl_interp;
88
+ Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
89
+
90
+ Tcl_MakeSafe(tcl_interp->interp);
91
+
92
+ return obj;
93
+ }
94
+
95
+ #ifdef TCL_LIMIT_TIME
96
+ static VALUE rb_tcl_interp_eval(VALUE self, VALUE args) {
97
+ VALUE script = rb_ary_entry(args, 0);
98
+
99
+ int timeout = 0;
100
+ if (RARRAY_LEN(args) == 2) {
101
+ timeout = NUM2INT(rb_ary_entry(args, 1));
102
+ }
103
+ #else
104
+ static VALUE rb_tcl_interp_eval(VALUE self, VALUE script) {
105
+ #endif
106
+
107
+ tcl_interp_struct *tcl_interp;
108
+ Data_Get_Struct(self, tcl_interp_struct, tcl_interp);
109
+
110
+ #ifdef TCL_LIMIT_TIME
111
+ if (timeout > 0) {
112
+ Tcl_Time timeout_time;
113
+ Tcl_GetTime(&timeout_time);
114
+ timeout_time.sec += (long) timeout / 1000;
115
+ timeout_time.usec += (long) (timeout % 1000) * 1000;
116
+
117
+ Tcl_LimitSetTime(tcl_interp->interp, &timeout_time);
118
+ Tcl_LimitTypeSet(tcl_interp->interp, TCL_LIMIT_TIME);
119
+ }
120
+ #endif
121
+
122
+ int result = Tcl_Eval(tcl_interp->interp, RSTRING_PTR(rb_value_to_s(script)));
123
+
124
+ VALUE error_class = rb_const_get(rb_const_get(rb_cObject, rb_intern("Tcl")), rb_intern("Error"));
125
+
126
+ #ifdef TCL_LIMIT_TIME
127
+ if (timeout > 0) {
128
+ if (Tcl_LimitTypeExceeded(tcl_interp->interp, TCL_LIMIT_TIME))
129
+ error_class = rb_const_get(rb_const_get(rb_cObject, rb_intern("Tcl")), rb_intern("Timeout"));
130
+
131
+ Tcl_LimitTypeReset(tcl_interp->interp, TCL_LIMIT_TIME);
132
+ }
133
+ #endif
134
+
135
+ switch (result) {
136
+ case TCL_OK:
137
+ return rb_tainted_str_new2(tcl_interp->interp->result);
138
+ case TCL_ERROR:
139
+ if (NIL_P(tcl_interp->exit_exception)) {
140
+ rb_raise(error_class, "%s", tcl_interp->interp->result);
141
+ } else {
142
+ rb_exit(NUM2INT(rb_iv_get(tcl_interp->exit_exception, "status")));
143
+ }
144
+ default:
145
+ return Qnil;
146
+ }
147
+ }
148
+
149
+ static VALUE rb_tcl_interp_list_to_array(VALUE self, VALUE list) {
150
+ tcl_interp_struct *tcl_interp;
151
+ Data_Get_Struct(self, tcl_interp_struct, tcl_interp);
152
+
153
+ Tcl_Obj *string = Tcl_NewStringObj(RSTRING_PTR(rb_value_to_s(list)), -1);
154
+ Tcl_IncrRefCount(string);
155
+
156
+ int list_length, i;
157
+ Tcl_Obj **elements;
158
+
159
+ if (Tcl_ListObjGetElements(tcl_interp->interp, string, &list_length, &elements) != TCL_OK) {
160
+ Tcl_DecrRefCount(string);
161
+ return Qnil;
162
+ }
163
+
164
+ for (i = 0; i < list_length; i++)
165
+ Tcl_IncrRefCount(elements[i]);
166
+
167
+ VALUE result = rb_ary_new2(list_length);
168
+
169
+ for (i = 0; i < list_length; i++) {
170
+ int element_length;
171
+ const char *element;
172
+
173
+ element = Tcl_GetStringFromObj(elements[i], &element_length);
174
+ rb_ary_push(result, element ? rb_tainted_str_new(element, element_length) : rb_str_new2(""));
175
+ Tcl_DecrRefCount(elements[i]);
176
+ }
177
+
178
+ Tcl_DecrRefCount(string);
179
+
180
+ return result;
181
+ }
182
+
183
+ static VALUE rb_tcl_interp_array_to_list(VALUE self, VALUE array) {
184
+ tcl_interp_struct *tcl_interp;
185
+ Data_Get_Struct(self, tcl_interp_struct, tcl_interp);
186
+
187
+ int array_length = RARRAY_LEN(array), i;
188
+
189
+ Tcl_Obj *list = Tcl_NewObj();
190
+ Tcl_IncrRefCount(list);
191
+
192
+ for (i = 0; i < array_length; i++) {
193
+ VALUE element = rb_ary_entry(array, i);
194
+ Tcl_Obj *string = Tcl_NewStringObj(RSTRING_PTR(rb_value_to_s(element)), -1);
195
+
196
+ Tcl_IncrRefCount(string);
197
+ Tcl_ListObjAppendElement(tcl_interp->interp, list, string);
198
+ Tcl_DecrRefCount(string);
199
+ }
200
+
201
+ VALUE result = rb_tainted_str_new2(Tcl_GetStringFromObj(list, NULL));
202
+
203
+ Tcl_DecrRefCount(list);
204
+
205
+ return result;
206
+ }
207
+
208
+ void Init_tcl() {
209
+ VALUE tcl_module = rb_define_module("Tcl");
210
+ VALUE interp_class = rb_define_class_under(tcl_module, "Interp", rb_cObject);
211
+ VALUE safe_interp_class = rb_define_class_under(tcl_module, "SafeInterp", interp_class);
212
+ VALUE error_class = rb_define_class_under(tcl_module, "Error", rb_eStandardError);
213
+
214
+ rb_define_alloc_func(interp_class, rb_tcl_interp_allocate);
215
+ rb_define_alloc_func(safe_interp_class, rb_tcl_safe_interp_allocate);
216
+ rb_define_method(interp_class, "list_to_array", rb_tcl_interp_list_to_array, 1);
217
+ rb_define_method(interp_class, "array_to_list", rb_tcl_interp_array_to_list, 1);
218
+
219
+ #ifdef TCL_LIMIT_TIME
220
+ VALUE timeout_class = rb_define_class_under(tcl_module, "Timeout", error_class);
221
+ rb_define_method(interp_class, "eval", rb_tcl_interp_eval, -2);
222
+ #else
223
+ rb_define_method(interp_class, "eval", rb_tcl_interp_eval, 1);
224
+ #endif
225
+ }
@@ -0,0 +1,7 @@
1
+ require 'tcl'
2
+ require "tcl/version"
3
+ require "tcl/interp_helper"
4
+ require "tcl/interp"
5
+ require "tcl/proc"
6
+ require "tcl/var"
7
+
@@ -0,0 +1,3 @@
1
+ module Tcl
2
+ VERSION = "0.1.0"
3
+ end
@@ -0,0 +1,51 @@
1
+ module Tcl
2
+ class Interp
3
+ include InterpHelper
4
+
5
+ class << self
6
+ def load_from_file(filename)
7
+ interp = new
8
+ interp.eval(IO.read(filename))
9
+ interp
10
+ end
11
+ end
12
+
13
+ def interp
14
+ self
15
+ end
16
+
17
+ def interp_receive(method, *args)
18
+ send("tcl_#{method}", *args)
19
+ end
20
+
21
+ def expose(name)
22
+ _!(:interp, :alias, nil, name, nil, :interp_send, name)
23
+ end
24
+
25
+ def proc(name)
26
+ Tcl::Proc.new(self, name)
27
+ end
28
+
29
+ def var(name)
30
+ Tcl::Var.find(self, name)
31
+ end
32
+
33
+ def procs
34
+ list_to_array _!(:info, :procs)
35
+ end
36
+
37
+ def vars
38
+ list_to_array _!(:info, :vars)
39
+ end
40
+
41
+ def to_tcl
42
+ %w( var proc ).inject([]) do |lines, type|
43
+ send("#{type}s").sort.each do |name|
44
+ object = send(type, name)
45
+ lines << object.to_tcl unless object.builtin?
46
+ end
47
+ lines
48
+ end.join("\n")
49
+ end
50
+ end
51
+ end
@@ -0,0 +1,25 @@
1
+ module Tcl
2
+ module InterpHelper
3
+ def self.included(klass)
4
+ klass.class_eval do
5
+ attr_reader :interp
6
+ end
7
+ end
8
+
9
+ def _(*args)
10
+ interp.array_to_list(args)
11
+ end
12
+
13
+ def _!(*args)
14
+ interp.eval(_(*args))
15
+ end
16
+
17
+ def method_missing(name, *args, &block)
18
+ if interp.respond_to?(name)
19
+ interp.send(name, *args, &block)
20
+ else
21
+ super
22
+ end
23
+ end
24
+ end
25
+ end
@@ -0,0 +1,50 @@
1
+ module Tcl
2
+ class Proc
3
+ BUILTINS = %w(
4
+ auto_execok auto_import auto_load auto_load_index
5
+ auto_qualify tclLog unknown
6
+ )
7
+
8
+ include InterpHelper
9
+
10
+ attr_reader :name
11
+
12
+ def initialize(interp, name)
13
+ @interp = interp
14
+ @name = name.to_s
15
+ to_tcl
16
+ end
17
+
18
+ def arguments
19
+ list_to_array(_!(:info, :args, name)).map do |argument_name|
20
+ begin
21
+ variable_name = "__Tcl_Proc_arguments_#{name}_#{argument_name}"
22
+ if _!(:info, :default, name, argument_name, variable_name) == "0"
23
+ argument_name
24
+ else
25
+ _(argument_name, var(variable_name).value)
26
+ end
27
+ ensure
28
+ _!(:unset, variable_name)
29
+ end
30
+ end
31
+ end
32
+
33
+ def body
34
+ _!(:info, :body, name)
35
+ end
36
+
37
+ def call(*args)
38
+ _!(name, *args.map { |arg| arg.to_s })
39
+ end
40
+
41
+ def to_tcl
42
+ _(:proc, name, _(*arguments), body)
43
+ end
44
+
45
+ def builtin?
46
+ # TODO should also check to see if the definition has changed
47
+ BUILTINS.include?(name)
48
+ end
49
+ end
50
+ end
@@ -0,0 +1,54 @@
1
+ module Tcl
2
+ class Var
3
+ BUILTINS = %w(
4
+ auto_index auto_oldpath auto_path env errorCode errorInfo
5
+ tcl_libPath tcl_library tcl_patchLevel tcl_pkgPath tcl_platform tcl_version
6
+ )
7
+
8
+ include InterpHelper
9
+
10
+ class << self
11
+ def find(interp, name)
12
+ if interp._!(:array, :exists, name) == "1"
13
+ ArrayVar.new(interp, name)
14
+ elsif interp._!(:info, :exists, name) == "1"
15
+ StringVar.new(interp, name)
16
+ else
17
+ raise Tcl::Error, "can't read \"#{name}\": no such variable"
18
+ end
19
+ end
20
+ end
21
+
22
+ attr_reader :name
23
+
24
+ def initialize(interp, name)
25
+ @interp = interp
26
+ @name = name.to_s
27
+ to_tcl
28
+ end
29
+
30
+ def builtin?
31
+ BUILTINS.include?(name)
32
+ end
33
+ end
34
+
35
+ class StringVar < Var
36
+ def value
37
+ _!(:set, name)
38
+ end
39
+
40
+ def to_tcl
41
+ _(:set, name, value)
42
+ end
43
+ end
44
+
45
+ class ArrayVar < Var
46
+ def value
47
+ _!(:array, :get, name)
48
+ end
49
+
50
+ def to_tcl
51
+ _(:array, :set, name, value)
52
+ end
53
+ end
54
+ end
@@ -0,0 +1,35 @@
1
+ $:.push File.expand_path("../lib", __FILE__)
2
+ require 'ruby-tcl/version'
3
+
4
+ Gem::Specification.new do |s|
5
+ s.name = 'ruby-tcl'
6
+ s.version = Tcl::VERSION
7
+ s.platform = Gem::Platform::RUBY
8
+ s.date = "2011-09-23"
9
+ s.authors = ['Sam Stephenson', 'Mark J. Titorenko']
10
+ s.email = 'mark.titorenko@alces-software.com'
11
+ s.homepage = 'http://github.com/mjtko/ruby-tcl'
12
+ s.summary = %Q{A minimal Ruby interface to libtcl.}
13
+ s.description = %Q{Bindings to the Tcl interpreter for use from within ruby.}
14
+ s.extra_rdoc_files = [
15
+ 'LICENSE',
16
+ 'README.rdoc',
17
+ ]
18
+ s.extensions = ["ext/tcl/extconf.rb"]
19
+
20
+ s.required_rubygems_version = Gem::Requirement.new('>= 1.3.7')
21
+ s.rubygems_version = '1.3.7'
22
+ s.specification_version = 3
23
+
24
+ s.files = `git ls-files`.split("\n")
25
+ s.test_files = `git ls-files -- {test,spec,features}/*`.split("\n")
26
+ s.executables = `git ls-files -- bin/*`.split("\n").map{ |f| File.basename(f) }
27
+ s.require_paths = ['lib']
28
+
29
+ s.add_development_dependency 'test-unit'
30
+ s.add_development_dependency 'bundler'
31
+ s.add_development_dependency 'bueller'
32
+ s.add_development_dependency 'rake'
33
+ s.add_development_dependency 'rake-compiler'
34
+ end
35
+
@@ -0,0 +1,6 @@
1
+ set a 0
2
+ set b(a) 1
3
+ set b(b) 2
4
+ proc c args return
5
+ proc d {a {b 0}} {return $b}
6
+ proc e {} {}
@@ -0,0 +1,106 @@
1
+ require "test_helper"
2
+
3
+ class InterpWithNoReceiveMethod < Tcl::Interp
4
+ undef_method :interp_receive
5
+ end
6
+
7
+ class InterpWithDefaultReceiveMethod < Tcl::Interp
8
+ def tcl_no_arguments
9
+ "hello"
10
+ end
11
+
12
+ def tcl_one_argument(arg)
13
+ arg
14
+ end
15
+
16
+ def tcl_variable_arguments(*args)
17
+ _(*args)
18
+ end
19
+
20
+ def tcl_multiply_by_5(n)
21
+ n.to_i * 5
22
+ end
23
+ end
24
+
25
+ class InterpWithCustomReceiveMethod < Tcl::Interp
26
+ def interp_receive(method, *args)
27
+ _(method, *args)
28
+ end
29
+ end
30
+
31
+ class InterpWithExposedMethods < Tcl::Interp
32
+ def initialize
33
+ super
34
+ expose :hello
35
+ end
36
+
37
+ def tcl_hello(who)
38
+ "hello, #{who}"
39
+ end
40
+ end
41
+
42
+ class InterpWithExitMethod < Tcl::Interp
43
+ def tcl_exit
44
+ exit
45
+ end
46
+ end
47
+
48
+ class InterpReceiveTest < Test::Unit::TestCase
49
+ def setup
50
+ @interp = InterpWithDefaultReceiveMethod.new
51
+ end
52
+
53
+ def test_interp_send_on_interp_with_no_interp_receive_method_should_raise
54
+ @interp = InterpWithDefaultReceiveMethod.new
55
+ assert_raises(Tcl::Error) { @interp.eval("interp_send") }
56
+ end
57
+
58
+ def test_interp_send_with_no_arguments_should_raise
59
+ assert_raises(Tcl::Error) { @interp.eval("interp_send") }
60
+ end
61
+
62
+ def test_interp_send_returns_tcl_ok
63
+ assert_equal "0", @interp.eval("catch {interp_send no_arguments}")
64
+ end
65
+
66
+ def test_interp_send_to_method_with_no_arguments
67
+ assert_equal "hello", @interp.eval("interp_send no_arguments")
68
+ assert_raises(Tcl::Error) { @interp.eval("interp_send no_arguments foo") }
69
+ end
70
+
71
+ def test_interp_send_to_method_with_one_argument
72
+ assert_raises(Tcl::Error) { @interp.eval("interp_send one_argument") }
73
+ assert_equal "foo", @interp.eval("interp_send one_argument foo")
74
+ assert_raises(Tcl::Error) { @interp.eval("interp_send one_argument foo bar") }
75
+ end
76
+
77
+ def test_interp_send_to_method_with_variable_arguments
78
+ assert_equal "", @interp.eval("interp_send variable_arguments")
79
+ assert_equal "foo", @interp.eval("interp_send variable_arguments foo")
80
+ assert_equal "foo bar", @interp.eval("interp_send variable_arguments foo bar")
81
+ end
82
+
83
+ def test_interp_send_converts_non_string_results_to_string
84
+ assert_equal "0", @interp.eval("interp_send multiply_by_5 0")
85
+ assert_equal "25", @interp.eval("interp_send multiply_by_5 5")
86
+ end
87
+
88
+ def test_interp_send_with_custom_interp_receive_method
89
+ @interp = InterpWithCustomReceiveMethod.new
90
+ assert_raises(Tcl::Error) { @interp.eval("interp_send") }
91
+ assert_equal "foo", @interp.eval("interp_send foo")
92
+ assert_equal "foo bar", @interp.eval("interp_send foo bar")
93
+ end
94
+
95
+ def test_interp_expose
96
+ @interp = InterpWithExposedMethods.new
97
+ assert_equal "hello, Sam", @interp.eval("interp_send hello Sam")
98
+ assert_equal "hello, Sam", @interp.eval("hello Sam")
99
+ end
100
+
101
+ def test_interp_send_does_not_convert_system_exit_into_tcl_error
102
+ @interp = InterpWithExitMethod.new
103
+ assert_raises(SystemExit) { @interp.eval("interp_send exit") }
104
+ end
105
+ end
106
+
@@ -0,0 +1,109 @@
1
+ STDERR.puts Tcl::Interp.inspect
2
+
3
+ class InterpTest < Test::Unit::TestCase
4
+ def setup
5
+ @interp = Tcl::Interp.new
6
+ @interp.eval('rename clock ""') if @interp.procs.include?('clock')
7
+ end
8
+
9
+ def test_load_from_file
10
+ vars, procs = @interp.vars, @interp.procs
11
+ @interp = Tcl::Interp.load_from_file(path_to_fixture("test.tcl"))
12
+ @interp.eval('rename clock ""') if @interp.procs.include?('clock')
13
+
14
+ assert_equal ["a", "b"], (@interp.vars - vars).sort
15
+ assert_equal ["c", "d", "e"], (@interp.procs - procs).sort
16
+ end
17
+
18
+ def test_eval
19
+ assert_equal "", @interp.eval("")
20
+ assert_equal "0", @interp.eval("return 0")
21
+ assert_equal "", @interp.eval("return \"\"")
22
+ assert_equal "", @interp.eval("return {}")
23
+ assert_equal " ", @interp.eval("return \" \"")
24
+ end
25
+
26
+ def test_eval_raises_on_tcl_exception
27
+ assert_raises(Tcl::Error) { @interp.eval("nonexistent") }
28
+ assert_raises(Tcl::Error) { @interp.eval("{") }
29
+ assert_raises(Tcl::Error) { @interp.eval("error") }
30
+ end
31
+
32
+ def test_eval_with_timeout_argument
33
+ if defined?(Tcl::Timeout)
34
+ assert_raises(Tcl::Timeout) { @interp.eval("while 1 {}", 100) }
35
+ end
36
+ end
37
+
38
+ def test_array_to_list
39
+ assert_equal "", @interp.array_to_list([])
40
+ assert_equal "{}", @interp.array_to_list([nil])
41
+ assert_equal "{}", @interp.array_to_list([""])
42
+ assert_equal "one", @interp.array_to_list(["one"])
43
+ assert_equal "one two", @interp.array_to_list(["one", "two"])
44
+ assert_equal "a { b} c", @interp.array_to_list(["a", " b", "c"])
45
+ assert_equal "\\{", @interp.array_to_list(["{"])
46
+ assert_equal "{\"}", @interp.array_to_list(["\""])
47
+ end
48
+
49
+ def test_list_to_array
50
+ assert_equal [], @interp.list_to_array("")
51
+ assert_equal [""], @interp.list_to_array("{}")
52
+ assert_equal ["one"], @interp.list_to_array("one")
53
+ assert_equal ["one", "two"], @interp.list_to_array("one two")
54
+ assert_equal ["a", " b", "c"], @interp.list_to_array("a { b} c")
55
+ assert_equal ["a", " b", "c"], @interp.list_to_array("a \\ b c")
56
+ assert_equal ["{"], @interp.list_to_array("\\{")
57
+ assert_equal ["["], @interp.list_to_array("\\[")
58
+ assert_equal ["\""], @interp.list_to_array("\\\"")
59
+ end
60
+
61
+ def test_procs
62
+ @interp.clear!
63
+ assert_equal [], @interp.procs
64
+ @interp.eval "proc foo {} {}"
65
+ assert_equal ["foo"], @interp.procs
66
+ @interp.eval "proc bar {} {}"
67
+ assert_equal ["bar", "foo"], @interp.procs.sort
68
+ end
69
+
70
+ def test_vars
71
+ @interp.clear!
72
+ assert_equal [], @interp.vars
73
+ @interp.eval "set a 0"
74
+ assert_equal ["a"], @interp.vars
75
+ @interp.eval "set b(a) 0"
76
+ assert_equal ["a", "b"], @interp.vars.sort
77
+ end
78
+
79
+ def test_proc
80
+ assert_raises(Tcl::Error) { @interp.proc("foo") }
81
+ @interp.eval "proc foo {} {}"
82
+ proc = @interp.proc("foo")
83
+ assert proc.is_a?(Tcl::Proc)
84
+ assert_equal "foo", proc.name
85
+ end
86
+
87
+ def test_var
88
+ assert_raises(Tcl::Error) { @interp.var("foo") }
89
+ @interp.eval "set foo bar"
90
+ var = @interp.var("foo")
91
+ assert var.is_a?(Tcl::Var)
92
+ assert_equal "foo", var.name
93
+ end
94
+
95
+ def test_to_tcl
96
+ @interp.eval IO.read(path_to_fixture("test.tcl"))
97
+ assert_equal <<-EOF.chomp, @interp.to_tcl
98
+ set a 0
99
+ array set b {a 1 b 2}
100
+ proc c args return
101
+ proc d {a {b 0}} {return $b}
102
+ proc e {} {}
103
+ EOF
104
+ end
105
+
106
+ def test_interp_helper_method_missing_super_passthrough
107
+ assert_raises(NoMethodError) { @interp.nonexistent }
108
+ end
109
+ end
@@ -0,0 +1,42 @@
1
+ require "test_helper"
2
+
3
+ class ProcTest < Test::Unit::TestCase
4
+ def setup
5
+ @interp = Tcl::Interp.load_from_file(path_to_fixture("test.tcl"))
6
+ end
7
+
8
+ def test_proc_arguments_for_proc_with_no_arguments
9
+ assert_equal [], @interp.proc("e").arguments
10
+ end
11
+
12
+ def test_proc_arguments_for_proc_with_one_argument
13
+ assert_equal ["args"], @interp.proc("c").arguments
14
+ end
15
+
16
+ def test_proc_arguments_for_proc_with_default_argument
17
+ assert_equal ["a", "b 0"], @interp.proc("d").arguments
18
+ end
19
+
20
+ def test_proc_body
21
+ assert_equal "return", @interp.proc("c").body
22
+ assert_equal "return $b", @interp.proc("d").body
23
+ assert_equal "", @interp.proc("e").body
24
+ end
25
+
26
+ def test_proc_call
27
+ assert_equal "", @interp.proc("c").call
28
+ assert_equal "0", @interp.proc("d").call("a")
29
+ assert_equal "b", @interp.proc("d").call("a", "b")
30
+ assert_equal "", @interp.proc("e").call
31
+ end
32
+
33
+ def test_proc_call_raises_on_missing_argument
34
+ assert_raises(Tcl::Error) { @interp.proc("d").call }
35
+ end
36
+
37
+ def test_proc_to_tcl
38
+ assert_equal "proc c args return", @interp.proc("c").to_tcl
39
+ assert_equal "proc d {a {b 0}} {return $b}", @interp.proc("d").to_tcl
40
+ assert_equal "proc e {} {}", @interp.proc("e").to_tcl
41
+ end
42
+ end
@@ -0,0 +1,15 @@
1
+ require "test/unit"
2
+ require File.join(File.dirname(__FILE__), *%w".. lib ruby-tcl")
3
+
4
+ class Tcl::Interp
5
+ def clear!
6
+ procs.each { |p| _! :rename, p, "" }
7
+ vars.each { |v| _! :unset, v }
8
+ end
9
+ end
10
+
11
+ class Test::Unit::TestCase
12
+ def path_to_fixture(*path_pieces)
13
+ File.join(File.dirname(__FILE__), "fixtures", *path_pieces)
14
+ end
15
+ end
@@ -0,0 +1,58 @@
1
+ require "test_helper"
2
+
3
+ class VarTest < Test::Unit::TestCase
4
+ def setup
5
+ @interp = Tcl::Interp.load_from_file(path_to_fixture("test.tcl"))
6
+ end
7
+
8
+ def test_var_find_raises_when_var_does_not_exist
9
+ assert_raises(Tcl::Error) { Tcl::Var.find(@interp, "nonexistent") }
10
+ end
11
+
12
+ def test_var_find_returns_string_var
13
+ var = Tcl::Var.find(@interp, "a")
14
+ assert_equal "a", var.name
15
+ assert var.is_a?(Tcl::StringVar)
16
+ end
17
+
18
+ def test_var_find_returns_array_var
19
+ var = Tcl::Var.find(@interp, "b")
20
+ assert_equal "b", var.name
21
+ assert var.is_a?(Tcl::ArrayVar)
22
+ end
23
+
24
+ def test_string_var_value
25
+ assert_equal "0", @interp.var("a").value
26
+ end
27
+
28
+ def test_array_var_value
29
+ assert_equal "a 1 b 2", @interp.var("b").value
30
+ end
31
+
32
+ def test_string_var_to_tcl
33
+ assert_equal "set a 0", @interp.var("a").to_tcl
34
+ end
35
+
36
+ def test_array_var_to_tcl
37
+ assert_equal "array set b {a 1 b 2}", @interp.var("b").to_tcl
38
+ end
39
+
40
+ def test_array_var_to_tcl_does_not_modify_errorInfo
41
+ assert_errorinfo ""
42
+ Tcl::Var.find(@interp, "b")
43
+ assert_errorinfo ""
44
+ end
45
+
46
+ def test_attempting_to_find_nonexistent_variable_does_not_modify_errorInfo
47
+ assert_errorinfo ""
48
+ assert_raises(Tcl::Error) { Tcl::Var.find(@interp, "nonexistent") }
49
+ assert_errorinfo ""
50
+ end
51
+
52
+ protected
53
+ def assert_errorinfo(value)
54
+ if @interp.vars.include?("errorInfo")
55
+ assert_equal value, @interp.var("errorInfo").value
56
+ end
57
+ end
58
+ end
metadata ADDED
@@ -0,0 +1,133 @@
1
+ --- !ruby/object:Gem::Specification
2
+ name: ruby-tcl
3
+ version: !ruby/object:Gem::Version
4
+ version: 0.1.0
5
+ prerelease:
6
+ platform: ruby
7
+ authors:
8
+ - Sam Stephenson
9
+ - Mark J. Titorenko
10
+ autorequire:
11
+ bindir: bin
12
+ cert_chain: []
13
+ date: 2011-09-23 00:00:00.000000000Z
14
+ dependencies:
15
+ - !ruby/object:Gem::Dependency
16
+ name: test-unit
17
+ requirement: &70242944619420 !ruby/object:Gem::Requirement
18
+ none: false
19
+ requirements:
20
+ - - ! '>='
21
+ - !ruby/object:Gem::Version
22
+ version: '0'
23
+ type: :development
24
+ prerelease: false
25
+ version_requirements: *70242944619420
26
+ - !ruby/object:Gem::Dependency
27
+ name: bundler
28
+ requirement: &70242944606500 !ruby/object:Gem::Requirement
29
+ none: false
30
+ requirements:
31
+ - - ! '>='
32
+ - !ruby/object:Gem::Version
33
+ version: '0'
34
+ type: :development
35
+ prerelease: false
36
+ version_requirements: *70242944606500
37
+ - !ruby/object:Gem::Dependency
38
+ name: bueller
39
+ requirement: &70242944605720 !ruby/object:Gem::Requirement
40
+ none: false
41
+ requirements:
42
+ - - ! '>='
43
+ - !ruby/object:Gem::Version
44
+ version: '0'
45
+ type: :development
46
+ prerelease: false
47
+ version_requirements: *70242944605720
48
+ - !ruby/object:Gem::Dependency
49
+ name: rake
50
+ requirement: &70242944605000 !ruby/object:Gem::Requirement
51
+ none: false
52
+ requirements:
53
+ - - ! '>='
54
+ - !ruby/object:Gem::Version
55
+ version: '0'
56
+ type: :development
57
+ prerelease: false
58
+ version_requirements: *70242944605000
59
+ - !ruby/object:Gem::Dependency
60
+ name: rake-compiler
61
+ requirement: &70242944604280 !ruby/object:Gem::Requirement
62
+ none: false
63
+ requirements:
64
+ - - ! '>='
65
+ - !ruby/object:Gem::Version
66
+ version: '0'
67
+ type: :development
68
+ prerelease: false
69
+ version_requirements: *70242944604280
70
+ description: Bindings to the Tcl interpreter for use from within ruby.
71
+ email: mark.titorenko@alces-software.com
72
+ executables: []
73
+ extensions:
74
+ - ext/tcl/extconf.rb
75
+ extra_rdoc_files:
76
+ - LICENSE
77
+ - README.rdoc
78
+ files:
79
+ - .document
80
+ - .gitignore
81
+ - Gemfile
82
+ - LICENSE
83
+ - README.rdoc
84
+ - Rakefile
85
+ - ext/tcl/extconf.rb
86
+ - ext/tcl/tcl.c
87
+ - lib/ruby-tcl.rb
88
+ - lib/ruby-tcl/version.rb
89
+ - lib/tcl/interp.rb
90
+ - lib/tcl/interp_helper.rb
91
+ - lib/tcl/proc.rb
92
+ - lib/tcl/var.rb
93
+ - ruby-tcl.gemspec
94
+ - test/fixtures/test.tcl
95
+ - test/interp_receive_test.rb
96
+ - test/interp_test.rb
97
+ - test/proc_test.rb
98
+ - test/test_helper.rb
99
+ - test/var_test.rb
100
+ homepage: http://github.com/mjtko/ruby-tcl
101
+ licenses: []
102
+ post_install_message:
103
+ rdoc_options: []
104
+ require_paths:
105
+ - lib
106
+ required_ruby_version: !ruby/object:Gem::Requirement
107
+ none: false
108
+ requirements:
109
+ - - ! '>='
110
+ - !ruby/object:Gem::Version
111
+ version: '0'
112
+ segments:
113
+ - 0
114
+ hash: 3606260369119369042
115
+ required_rubygems_version: !ruby/object:Gem::Requirement
116
+ none: false
117
+ requirements:
118
+ - - ! '>='
119
+ - !ruby/object:Gem::Version
120
+ version: 1.3.7
121
+ requirements: []
122
+ rubyforge_project:
123
+ rubygems_version: 1.8.6
124
+ signing_key:
125
+ specification_version: 3
126
+ summary: A minimal Ruby interface to libtcl.
127
+ test_files:
128
+ - test/fixtures/test.tcl
129
+ - test/interp_receive_test.rb
130
+ - test/interp_test.rb
131
+ - test/proc_test.rb
132
+ - test/test_helper.rb
133
+ - test/var_test.rb