tcl 0.0.1

Sign up to get free protection for your applications and to get access to all the features.
@@ -0,0 +1 @@
1
+ pkg
data/LICENSE ADDED
@@ -0,0 +1,20 @@
1
+ Copyright (c) 2009 Sam Stephenson
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,18 @@
1
+ = tcl
2
+
3
+ A minimal Ruby interface to libtcl.
4
+ The library is written by Sam Stephenson. Aslak Helles√ły forked it to gemify it.
5
+
6
+ == Note on Patches/Pull Requests
7
+
8
+ * Fork the project.
9
+ * Make your feature addition or bug fix.
10
+ * Add tests for it. This is important so I don't break it in a
11
+ future version unintentionally.
12
+ * Commit, do not mess with rakefile, version, or history.
13
+ (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)
14
+ * Send me a pull request. Bonus points for topic branches.
15
+
16
+ == Copyright
17
+
18
+ Copyright (c) 2009 Sam Stephenson. See LICENSE for details.
@@ -0,0 +1,58 @@
1
+ require 'rubygems'
2
+ require 'rake'
3
+
4
+ begin
5
+ require 'jeweler'
6
+ Jeweler::Tasks.new do |gem|
7
+ gem.name = "tcl"
8
+ gem.summary = %Q{Tcl bindings for Ruby}
9
+ gem.description = %Q{A minimal Ruby interface to libtcl}
10
+ gem.email = "sstephenson@gmail.com"
11
+ gem.homepage = "http://github.com/sstephenson/ruby-tcl"
12
+ gem.authors = ["Sam Stephenson"]
13
+
14
+ gem.extensions = FileList['ext/tcl_ruby/extconf.rb']
15
+ # gem is a Gem::Specification... see http://www.rubygems.org/read/chapter/20 for additional settings
16
+ end
17
+ Jeweler::GemcutterTasks.new
18
+ rescue LoadError
19
+ puts "Jeweler (or a dependency) not available. Install it with: gem install jeweler"
20
+ end
21
+
22
+ require 'rake/testtask'
23
+ Rake::TestTask.new(:test) do |test|
24
+ test.libs << 'lib' << 'test'
25
+ test.pattern = 'test/*.rb'
26
+ test.verbose = true
27
+ end
28
+
29
+ begin
30
+ require 'rcov/rcovtask'
31
+ Rcov::RcovTask.new do |test|
32
+ test.libs << 'test'
33
+ test.pattern = 'test/*.rb'
34
+ test.verbose = true
35
+ end
36
+ rescue LoadError
37
+ task :rcov do
38
+ abort "RCov is not available. In order to run rcov, you must: sudo gem install spicycode-rcov"
39
+ end
40
+ end
41
+
42
+ task :test => [:check_dependencies, :compile]
43
+
44
+ task :default => :test
45
+
46
+ require 'rake/rdoctask'
47
+ Rake::RDocTask.new do |rdoc|
48
+ version = File.exist?('VERSION') ? File.read('VERSION') : ""
49
+
50
+ rdoc.rdoc_dir = 'rdoc'
51
+ rdoc.title = "tcl #{version}"
52
+ rdoc.rdoc_files.include('README*')
53
+ rdoc.rdoc_files.include('lib/**/*.rb')
54
+ end
55
+
56
+ require 'rake/extensiontask'
57
+ Rake::ExtensionTask.new("tcl_ruby")
58
+ CLEAN.include ['**/*.{o,bundle,jar,so,obj,pdb,lib,def,exp,log}']
data/TODO ADDED
@@ -0,0 +1,2 @@
1
+ * Tcl::Proc#builtin? should return false if the procedure has been overridden
2
+ * Tcl::Interp#to_tcl should account for interpreter aliases (see http://wiki.tcl.tk/8766) and namespaces.
data/VERSION ADDED
@@ -0,0 +1 @@
1
+ 0.0.1
@@ -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_ruby")
@@ -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(interp_receive_args)->len, RARRAY(interp_receive_args)->ptr);
24
+
25
+ tcl_interp_struct *tcl_interp;
26
+ Data_Get_Struct(obj, tcl_interp_struct, tcl_interp);
27
+
28
+ char *tcl_result = strdup(RSTRING(rb_value_to_s(result))->ptr);
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(rb_value_to_s(error_info))->ptr);
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(args)->len == 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(rb_value_to_s(script))->ptr);
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(rb_value_to_s(list))->ptr, -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(array)->len, 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(rb_value_to_s(element))->ptr, -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_ruby() {
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,2 @@
1
+ *.bundle
2
+ *.so
@@ -0,0 +1,5 @@
1
+ require "tcl_ruby"
2
+ require "tcl/interp_helper"
3
+ require "tcl/interp"
4
+ require "tcl/proc"
5
+ require "tcl/var"
@@ -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,46 @@
1
+ #!/usr/bin/env ruby
2
+
3
+ require File.join(File.dirname(__FILE__), *%w".. lib tcl")
4
+
5
+ class ConsoleInterp < Tcl::Interp
6
+ def initialize
7
+ super
8
+ expose :ruby_eval
9
+ expose :exit
10
+ end
11
+
12
+ def tcl_ruby_eval(script)
13
+ Kernel.eval(script)
14
+ end
15
+
16
+ def tcl_exit(code = 0)
17
+ exit(code.to_i)
18
+ end
19
+ end
20
+
21
+ filename = ARGV.shift || File.join(File.dirname(__FILE__), *%w".. .state.dat")
22
+ interp = ConsoleInterp.load_from_file(filename) rescue ConsoleInterp.new
23
+ script = ""
24
+
25
+ at_exit do
26
+ File.open(filename, "w") do |file|
27
+ file.write(interp.to_tcl)
28
+ end
29
+ end
30
+
31
+ print ">> "
32
+ $stdin.each_line do |line|
33
+ script << line
34
+ if interp.list_to_array(script)
35
+ begin
36
+ result = interp.eval(script)
37
+ puts result unless result.length.zero?
38
+ rescue Tcl::Error => e
39
+ puts "error: #{e}"
40
+ end
41
+ script = ""
42
+ print ">> "
43
+ else
44
+ print "?> "
45
+ end
46
+ end
@@ -0,0 +1,70 @@
1
+ # Generated by jeweler
2
+ # DO NOT EDIT THIS FILE DIRECTLY
3
+ # Instead, edit Jeweler::Tasks in Rakefile, and run the gemspec command
4
+ # -*- encoding: utf-8 -*-
5
+
6
+ Gem::Specification.new do |s|
7
+ s.name = %q{tcl}
8
+ s.version = "0.0.1"
9
+
10
+ s.required_rubygems_version = Gem::Requirement.new(">= 0") if s.respond_to? :required_rubygems_version=
11
+ s.authors = ["Sam Stephenson"]
12
+ s.date = %q{2009-12-01}
13
+ s.description = %q{A minimal Ruby interface to libtcl}
14
+ s.email = %q{sstephenson@gmail.com}
15
+ s.extensions = ["ext/tcl_ruby/extconf.rb"]
16
+ s.extra_rdoc_files = [
17
+ "LICENSE",
18
+ "README.rdoc",
19
+ "TODO"
20
+ ]
21
+ s.files = [
22
+ ".gitignore",
23
+ "LICENSE",
24
+ "README.rdoc",
25
+ "Rakefile",
26
+ "TODO",
27
+ "VERSION",
28
+ "ext/tcl_ruby/extconf.rb",
29
+ "ext/tcl_ruby/tcl_ruby.c",
30
+ "lib/.gitignore",
31
+ "lib/tcl.rb",
32
+ "lib/tcl/interp.rb",
33
+ "lib/tcl/interp_helper.rb",
34
+ "lib/tcl/proc.rb",
35
+ "lib/tcl/var.rb",
36
+ "script/console",
37
+ "tcl.gemspec",
38
+ "test/fixtures/test.tcl",
39
+ "test/helper.rb",
40
+ "test/interp_receive_test.rb",
41
+ "test/interp_test.rb",
42
+ "test/proc_test.rb",
43
+ "test/test_helper.rb",
44
+ "test/var_test.rb"
45
+ ]
46
+ s.homepage = %q{http://github.com/sstephenson/ruby-tcl}
47
+ s.rdoc_options = ["--charset=UTF-8"]
48
+ s.require_paths = ["lib"]
49
+ s.rubygems_version = %q{1.3.5}
50
+ s.summary = %q{Tcl bindings for Ruby}
51
+ s.test_files = [
52
+ "test/helper.rb",
53
+ "test/interp_receive_test.rb",
54
+ "test/interp_test.rb",
55
+ "test/proc_test.rb",
56
+ "test/test_helper.rb",
57
+ "test/var_test.rb"
58
+ ]
59
+
60
+ if s.respond_to? :specification_version then
61
+ current_version = Gem::Specification::CURRENT_SPECIFICATION_VERSION
62
+ s.specification_version = 3
63
+
64
+ if Gem::Version.new(Gem::RubyGemsVersion) >= Gem::Version.new('1.2.0') then
65
+ else
66
+ end
67
+ else
68
+ end
69
+ end
70
+
@@ -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,9 @@
1
+ require 'rubygems'
2
+ require 'test/unit'
3
+
4
+ $LOAD_PATH.unshift(File.dirname(__FILE__))
5
+ $LOAD_PATH.unshift(File.join(File.dirname(__FILE__), '..', 'lib'))
6
+ require 'tcl'
7
+
8
+ class Test::Unit::TestCase
9
+ end
@@ -0,0 +1,106 @@
1
+ require File.join(File.dirname(__FILE__), "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,107 @@
1
+ require File.join(File.dirname(__FILE__), "test_helper")
2
+
3
+ class InterpTest < Test::Unit::TestCase
4
+ def setup
5
+ @interp = Tcl::Interp.new
6
+ end
7
+
8
+ def test_load_from_file
9
+ vars, procs = @interp.vars, @interp.procs
10
+ @interp = Tcl::Interp.load_from_file(path_to_fixture("test.tcl"))
11
+
12
+ assert_equal ["a", "b"], (@interp.vars - vars).sort
13
+ assert_equal ["c", "d", "e"], (@interp.procs - procs).sort
14
+ end
15
+
16
+ def test_eval
17
+ assert_equal "", @interp.eval("")
18
+ assert_equal "0", @interp.eval("return 0")
19
+ assert_equal "", @interp.eval("return \"\"")
20
+ assert_equal "", @interp.eval("return {}")
21
+ assert_equal " ", @interp.eval("return \" \"")
22
+ end
23
+
24
+ def test_eval_raises_on_tcl_exception
25
+ assert_raises(Tcl::Error) { @interp.eval("nonexistent") }
26
+ assert_raises(Tcl::Error) { @interp.eval("{") }
27
+ assert_raises(Tcl::Error) { @interp.eval("error") }
28
+ end
29
+
30
+ def test_eval_with_timeout_argument
31
+ if defined?(Tcl::Timeout)
32
+ assert_raises(Tcl::Timeout) { @interp.eval("while 1 {}", 100) }
33
+ end
34
+ end
35
+
36
+ def test_array_to_list
37
+ assert_equal "", @interp.array_to_list([])
38
+ assert_equal "{}", @interp.array_to_list([nil])
39
+ assert_equal "{}", @interp.array_to_list([""])
40
+ assert_equal "one", @interp.array_to_list(["one"])
41
+ assert_equal "one two", @interp.array_to_list(["one", "two"])
42
+ assert_equal "a { b} c", @interp.array_to_list(["a", " b", "c"])
43
+ assert_equal "\\{", @interp.array_to_list(["{"])
44
+ assert_equal "{\"}", @interp.array_to_list(["\""])
45
+ end
46
+
47
+ def test_list_to_array
48
+ assert_equal [], @interp.list_to_array("")
49
+ assert_equal [""], @interp.list_to_array("{}")
50
+ assert_equal ["one"], @interp.list_to_array("one")
51
+ assert_equal ["one", "two"], @interp.list_to_array("one two")
52
+ assert_equal ["a", " b", "c"], @interp.list_to_array("a { b} c")
53
+ assert_equal ["a", " b", "c"], @interp.list_to_array("a \\ b c")
54
+ assert_equal ["{"], @interp.list_to_array("\\{")
55
+ assert_equal ["["], @interp.list_to_array("\\[")
56
+ assert_equal ["\""], @interp.list_to_array("\\\"")
57
+ end
58
+
59
+ def test_procs
60
+ @interp.clear!
61
+ assert_equal [], @interp.procs
62
+ @interp.eval "proc foo {} {}"
63
+ assert_equal ["foo"], @interp.procs
64
+ @interp.eval "proc bar {} {}"
65
+ assert_equal ["bar", "foo"], @interp.procs.sort
66
+ end
67
+
68
+ def test_vars
69
+ @interp.clear!
70
+ assert_equal [], @interp.vars
71
+ @interp.eval "set a 0"
72
+ assert_equal ["a"], @interp.vars
73
+ @interp.eval "set b(a) 0"
74
+ assert_equal ["a", "b"], @interp.vars.sort
75
+ end
76
+
77
+ def test_proc
78
+ assert_raises(Tcl::Error) { @interp.proc("foo") }
79
+ @interp.eval "proc foo {} {}"
80
+ proc = @interp.proc("foo")
81
+ assert proc.is_a?(Tcl::Proc)
82
+ assert_equal "foo", proc.name
83
+ end
84
+
85
+ def test_var
86
+ assert_raises(Tcl::Error) { @interp.var("foo") }
87
+ @interp.eval "set foo bar"
88
+ var = @interp.var("foo")
89
+ assert var.is_a?(Tcl::Var)
90
+ assert_equal "foo", var.name
91
+ end
92
+
93
+ def test_to_tcl
94
+ @interp.eval IO.read(path_to_fixture("test.tcl"))
95
+ assert_equal <<-EOF.chomp, @interp.to_tcl
96
+ set a 0
97
+ array set b {a 1 b 2}
98
+ proc c args return
99
+ proc d {a {b 0}} {return $b}
100
+ proc e {} {}
101
+ EOF
102
+ end
103
+
104
+ def test_interp_helper_method_missing_super_passthrough
105
+ assert_raises(NoMethodError) { @interp.nonexistent }
106
+ end
107
+ end
@@ -0,0 +1,42 @@
1
+ require File.join(File.dirname(__FILE__), "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 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,56 @@
1
+ require File.join(File.dirname(__FILE__), "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
+ assert_equal value, @interp.var("errorInfo").value
55
+ end
56
+ end
metadata ADDED
@@ -0,0 +1,84 @@
1
+ --- !ruby/object:Gem::Specification
2
+ name: tcl
3
+ version: !ruby/object:Gem::Version
4
+ version: 0.0.1
5
+ platform: ruby
6
+ authors:
7
+ - Sam Stephenson
8
+ autorequire:
9
+ bindir: bin
10
+ cert_chain: []
11
+
12
+ date: 2009-12-01 00:00:00 +01:00
13
+ default_executable:
14
+ dependencies: []
15
+
16
+ description: A minimal Ruby interface to libtcl
17
+ email: sstephenson@gmail.com
18
+ executables: []
19
+
20
+ extensions:
21
+ - ext/tcl_ruby/extconf.rb
22
+ extra_rdoc_files:
23
+ - LICENSE
24
+ - README.rdoc
25
+ - TODO
26
+ files:
27
+ - .gitignore
28
+ - LICENSE
29
+ - README.rdoc
30
+ - Rakefile
31
+ - TODO
32
+ - VERSION
33
+ - ext/tcl_ruby/extconf.rb
34
+ - ext/tcl_ruby/tcl_ruby.c
35
+ - lib/.gitignore
36
+ - lib/tcl.rb
37
+ - lib/tcl/interp.rb
38
+ - lib/tcl/interp_helper.rb
39
+ - lib/tcl/proc.rb
40
+ - lib/tcl/var.rb
41
+ - script/console
42
+ - tcl.gemspec
43
+ - test/fixtures/test.tcl
44
+ - test/helper.rb
45
+ - test/interp_receive_test.rb
46
+ - test/interp_test.rb
47
+ - test/proc_test.rb
48
+ - test/test_helper.rb
49
+ - test/var_test.rb
50
+ has_rdoc: true
51
+ homepage: http://github.com/sstephenson/ruby-tcl
52
+ licenses: []
53
+
54
+ post_install_message:
55
+ rdoc_options:
56
+ - --charset=UTF-8
57
+ require_paths:
58
+ - lib
59
+ required_ruby_version: !ruby/object:Gem::Requirement
60
+ requirements:
61
+ - - ">="
62
+ - !ruby/object:Gem::Version
63
+ version: "0"
64
+ version:
65
+ required_rubygems_version: !ruby/object:Gem::Requirement
66
+ requirements:
67
+ - - ">="
68
+ - !ruby/object:Gem::Version
69
+ version: "0"
70
+ version:
71
+ requirements: []
72
+
73
+ rubyforge_project:
74
+ rubygems_version: 1.3.5
75
+ signing_key:
76
+ specification_version: 3
77
+ summary: Tcl bindings for Ruby
78
+ test_files:
79
+ - test/helper.rb
80
+ - test/interp_receive_test.rb
81
+ - test/interp_test.rb
82
+ - test/proc_test.rb
83
+ - test/test_helper.rb
84
+ - test/var_test.rb