cvsuser 04/09/22 05:33:19
Added: languages/tcl/t cmd_array.t cmd_catch.t cmd_error.t
cmd_string.t
Log:
More tests
Revision Changes Path
1.1 parrot/languages/tcl/t/cmd_array.t
Index: cmd_array.t
===================================================================
#!/usr/bin/perl
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
use Parrot::Test tests => 7;
my($tcl,$expected);
$tcl = <<'EOTCL';
set b(c) 2
puts [array exists b]
EOTCL
$expected = "1\n";
language_output_is("tcl",$tcl,$expected,"array exists yes");
$tcl = <<'EOTCL';
set a 2
puts [array exists a]
EOTCL
$expected = "0\n";
language_output_is("tcl",$tcl,$expected,"array exists no");
$tcl = <<'EOTCL';
puts [array exists a]
EOTCL
$expected = "0\n";
language_output_is("tcl",$tcl,$expected,"array exists missing");
$tcl = <<'EOTCL';
set a(1) 1
puts [array size a]
EOTCL
$expected = "1\n";
language_output_is("tcl",$tcl,$expected,"array size 1");
$tcl = <<'EOTCL';
set a(1) 1; set a(2) 2
puts [array size a]
EOTCL
$expected = "2\n";
language_output_is("tcl",$tcl,$expected,"array size 2");
$tcl = <<'EOTCL';
set a 1
puts [array size a]
EOTCL
$expected = "0\n";
language_output_is("tcl",$tcl,$expected,"array size not array");
$tcl = <<'EOTCL';
puts [array size a]
EOTCL
$expected = "0\n";
language_output_is("tcl",$tcl,$expected,"array size no var");
1.1 parrot/languages/tcl/t/cmd_catch.t
Index: cmd_catch.t
===================================================================
#!/usr/bin/perl
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
use Parrot::Test tests => 9;
language_output_is("tcl",<<'TCL',<<OUT,"discard error");
catch {
error dead
}
TCL
OUT
language_output_is("tcl",<<'TCL',<<OUT,"error message");
catch {
error dead
} var
puts $var
TCL
dead
OUT
language_output_is("tcl",<<'TCL',<<OUT,"error type: none");
set a [catch {
set b 0
}]
puts $a
TCL
0
OUT
language_output_is("tcl",<<'TCL',<<OUT,"error type: error");
set a [catch {
error dead
}]
puts $a
TCL
1
OUT
language_output_is("tcl",<<'TCL',<<OUT,"error type: return");
set a [catch {
return
}]
puts $a
TCL
2
OUT
language_output_is("tcl",<<'TCL',<<OUT,"error type: break");
set a [catch {
break
}]
puts $a
TCL
3
OUT
language_output_is("tcl",<<'TCL',<<OUT,"error type: continue");
set a [catch {
continue
}]
puts $a
TCL
4
OUT
language_output_is("tcl",<<'TCL',<<OUT,"error, invalid command");
catch perl var
puts $var
TCL
invalid command name "perl"
OUT
language_output_is("tcl",<<'TCL',<<OUT,"bad args");
catch
TCL
wrong # args: should be "catch command ?varName?"
OUT
1.1 parrot/languages/tcl/t/cmd_error.t
Index: cmd_error.t
===================================================================
#!/usr/bin/perl
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
use Parrot::Test tests => 1;
# Should check xit value. needs updating for stacktrace,
# Also needs TODO tests for missing functionality.
language_output_is("tcl",<<'TCL',<<OUT,"simple error");
error "dead\n"
TCL
dead
OUT
1.1 parrot/languages/tcl/t/cmd_string.t
Index: cmd_string.t
===================================================================
#!/usr/bin/perl
use strict;
use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
use Parrot::Test tests => 24; #1
my($tcl,$expected);
$tcl = <<'EOTCL';
puts -nonewline [string first a abcdef]
EOTCL
$expected = "0";
language_output_is("tcl",$tcl,$expected,"first, initial");
$tcl = <<'EOTCL';
puts -nonewline [string first a federal]
EOTCL
$expected = "5";
language_output_is("tcl",$tcl,$expected,"first, middle");
$tcl = <<'EOTCL';
puts -nonewline [string first c green ]
EOTCL
$expected = "-1";
language_output_is("tcl",$tcl,$expected,"first, failure");
$tcl = <<'EOTCL';
puts -nonewline [string first c green 0]
EOTCL
$expected = "-1";
language_output_is("tcl",$tcl,$expected,"first, index, failure");
$tcl = <<'EOTCL';
puts -nonewline [string first c abcd end-3]
EOTCL
$expected = "2";
language_output_is("tcl",$tcl,$expected,"first, index, end");
$tcl = <<'EOTCL';
puts -nonewline [string first c abcd 20]
EOTCL
$expected = "-1";
language_output_is("tcl",$tcl,$expected,"first, index, overshot");
$tcl = <<'EOTCL';
puts -nonewline [string first c abcd 1]
EOTCL
$expected = "2";
language_output_is("tcl",$tcl,$expected,"first, index");
$tcl = <<'EOTCL';
puts -nonewline [string first c abcd joe]
EOTCL
$expected = "bad index \"joe\": must be integer or end?-integer?";
language_output_is("tcl",$tcl,$expected,"first, index, invalid index");
$tcl = <<'EOTCL';
puts -nonewline [string first]
EOTCL
$expected = "wrong # args: should be \"string first subString string ?startIndex?\"";
language_output_is("tcl",$tcl,$expected,"first, too few args");
$tcl = <<'EOTCL';
puts -nonewline [string first a b c d]
EOTCL
$expected = "wrong # args: should be \"string first subString string ?startIndex?\"";
language_output_is("tcl",$tcl,$expected,"first, too many args");
$tcl = <<'EOTCL';
puts -nonewline [string index a b c]
EOTCL
$expected = "wrong # args: should be \"string index string charIndex\"";
language_output_is("tcl",$tcl,$expected,"index, too many args");
$tcl = <<'EOTCL';
puts -nonewline [string index]
EOTCL
$expected = "wrong # args: should be \"string index string charIndex\"";
language_output_is("tcl",$tcl,$expected,"index, too few args");
$tcl = <<'EOTCL';
puts -nonewline [string index abcde 0]
EOTCL
$expected = "a";
language_output_is("tcl",$tcl,$expected,"index, initial");
$tcl = <<'EOTCL';
puts -nonewline [string index abcde end]
EOTCL
$expected = "e";
language_output_is("tcl",$tcl,$expected,"index, end");
$tcl = <<'EOTCL';
puts -nonewline [string index abcde 10]
EOTCL
$expected = "";
language_output_is("tcl",$tcl,$expected,"index, too far");
=for TODO
TODO: {
local $::TODO = "don't handle negative indices yet.";
$tcl = <<'EOTCL';
puts -nonewline [string index abcde -1]
EOTCL
$expected = "";
language_output_is("tcl",$tcl,$expected,"index, too near?");
}
=cut
$tcl = <<'EOTCL';
puts -nonewline [string length a b]
EOTCL
$expected = "wrong # args: should be \"string length string\"";
language_output_is("tcl",$tcl,$expected,"length, too many args");
$tcl = <<'EOTCL';
puts -nonewline [string length]
EOTCL
$expected = "wrong # args: should be \"string length string\"";
language_output_is("tcl",$tcl,$expected,"length, too few args");
$tcl = <<'EOTCL';
puts -nonewline [string length 10]
EOTCL
$expected = "2";
language_output_is("tcl",$tcl,$expected,"length, simple");
$tcl = <<'EOTCL';
puts -nonewline [string length ""]
EOTCL
$expected = "0";
language_output_is("tcl",$tcl,$expected,"length, simple");
$tcl = <<'EOTCL';
puts -nonewline [string range a b]
EOTCL
$expected = "wrong # args: should be \"string range string first last\"";
language_output_is("tcl",$tcl,$expected,"range, too many args");
$tcl = <<'EOTCL';
puts -nonewline [string range a b c d]
EOTCL
$expected = "wrong # args: should be \"string range string first last\"";
language_output_is("tcl",$tcl,$expected,"range, too few args");
$tcl = <<'EOTCL';
puts -nonewline [string range abcde 0 end]
EOTCL
$expected = "abcde";
language_output_is("tcl",$tcl,$expected,"range, total");
$tcl = <<'EOTCL';
puts -nonewline [string range abcde 1 end-1]
EOTCL
$expected = "bcd";
language_output_is("tcl",$tcl,$expected,"range, partial");
$tcl = <<'EOTCL';
puts -nonewline [string range abcde end-20 20]
EOTCL
$expected = "abcde";
language_output_is("tcl",$tcl,$expected,"range, overextended");
