Author: coke
Date: Tue Aug 9 10:13:17 2005
New Revision: 8890
Added:
trunk/languages/tcl/t/cmd_switch.t (contents, props changed)
Modified:
trunk/MANIFEST
Log:
tcl: add some tests for the non-existant [switch]
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Tue Aug 9 10:13:17 2005
@@ -1464,6 +1464,7 @@ languages/tcl/t/cmd_return.t
languages/tcl/t/cmd_set.t [tcl]
languages/tcl/t/cmd_source.t [tcl]
languages/tcl/t/cmd_string.t [tcl]
+languages/tcl/t/cmd_switch.t [tcl]
languages/tcl/t/cmd_time.t [tcl]
languages/tcl/t/cmd_unset.t [tcl]
languages/tcl/t/cmd_while.t [tcl]
Added: trunk/languages/tcl/t/cmd_switch.t
==============================================================================
--- (empty file)
+++ trunk/languages/tcl/t/cmd_switch.t Tue Aug 9 10:13:17 2005
@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use strict;
+use lib qw(tcl/t t . ../lib ../../lib ../../../lib);
+use Parrot::Test tests => 6;
+use Test::More;
+use vars qw($TODO);
+
+TODO: {
+ local $TODO = "switch not written yet."
+
+language_output_is("tcl",<<'TCL',<<OUT,"too few args, 0");
+ switch
+TCL
+wrong # args: should be "switch ?switches? string pattern body ... ?default
body?"
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"too few args, 1");
+ switch a
+TCL
+wrong # args: should be "switch ?switches? string pattern body ... ?default
body?"
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"implied exact, singleton");
+ switch a a {puts a}
+TCL
+a
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"implied exact, two choices");
+ switch b a {
+ puts a
+ } b {
+ puts b
+ }
+TCL
+b
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"implied exact, --");
+ switch -- -a -a {puts -a}
+TCL
+-a
+OUT
+
+language_output_is("tcl",<<'TCL',<<OUT,"implied exact, --, two choices");
+ switch -b -a {
+ puts a
+ } -b {
+ puts b
+ }
+TCL
+b
+OUT
+
+}
