#!/usr/bin/perl

use strict;
use lib qw(tcl/lib ./lib ../lib ../../lib ../../../lib);
use Parrot::Test tests => 5;
use Test::More;

language_output_is("tcl", <<'TCL', <<'OUT', 'upvar $command');
  proc test {} {uplevel {set a 42}}
  test
  puts $a
TCL
42
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel - bad args");
  uplevel
TCL
wrong # args: should be "uplevel ?level? command ?arg ...?"
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel - bad level");
  uplevel a b
TCL
bad level "a"
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel 0");
  proc test {} {uplevel 0 {set a 42}; puts $a}
  test
TCL
42
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel #0");
  proc a {} {uplevel #0 {set a 42}}
  proc b {} {a}
  a
  puts $a
TCL
42
OUT

#!/usr/bin/perl

use strict;
use lib qw(tcl/lib ./lib ../lib ../../lib ../../../lib);
use Parrot::Test tests => 6;
use Test::More;

language_output_is("tcl", <<'TCL', <<'OUT', 'upvar $command');
  proc test {} {uplevel {set a 42}}
  test
  puts $a
TCL
42
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel - bad args");
  uplevel
TCL
wrong # args: should be "uplevel ?level? command ?arg ...?"
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel - bad level");
  uplevel a b
TCL
bad level "a"
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel 0");
  proc test {} {uplevel 0 {set a 42}; puts $a}
  test
TCL
42
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel #0");
  proc a {} {uplevel #0 {set a 42}}
  proc b {} {a}
  a
  puts $a
TCL
42
OUT

language_output_is("tcl", <<'TCL', <<'OUT', "uplevel - from one lexical to another");
  proc add2to_a {} {uplevel {set a [expr {$a+2}]}}
  proc test {} { set a 1; add2to_a; puts $a }
  test
TCL
3
OUT


Add a failing [uplevel] test that mimicks the failing [upvar] one.
[tcl]: Add a failing [uplevel] test that mimicks the failing [upvar] one.

git-svn-id: 6e74a02f85675cec270f5d931b0f6998666294a3@13311 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
