languages/tcl/t/cmd_rename.t

   1 #!perl
   2
   3 # Copyright (C) 2004-2007, The Perl Foundation.
   4 # $Id$
   5
   6 use strict;
   7 use warnings;
   8 use lib qw(tcl/lib ./lib ../lib ../../lib ../../../lib);
   9
  10 use Parrot::Test tests => 9;
  11 use Test::More;
  12
  13 language_output_is( "tcl", <<'TCL', <<OUT, "rename" );
  14  set a 2
  15  rename puts fnord
  16  fnord $a
  17 TCL
  18 2
  19 OUT
  20
  21 language_output_is( "tcl", <<'TCL', <<OUT, "remove" );
  22  rename puts ""
  23  puts "Whee"
  24 TCL
  25 invalid command name "puts"
  26 OUT
  27
  28 language_output_is( "tcl", <<'TCL', <<'OUT', "rename non-existant command" );
  29  rename foo blah
  30 TCL
  31 can't rename "foo": command doesn't exist
  32 OUT
  33
  34 language_output_is( "tcl", <<'TCL', <<'OUT', "delete non-existant command" );
  35  rename foo ""
  36 TCL
  37 can't delete "foo": command doesn't exist
  38 OUT
  39
  40 language_output_is( 'tcl', <<'TCL', <<'OUT', 'new command already exists' );
  41   rename if incr
  42 TCL
  43 can't rename to "incr": command already exists
  44 OUT
  45
  46 language_output_is( "tcl",
  47     <<'TCL', <<'OUT', "test fallback to interpreted versions of normally inlined commands." );
  48  set a 1
  49  incr a
  50  rename if {}
  51  incr a
  52  puts $a
  53 TCL
  54 3
  55 OUT
  56
  57 language_output_is( "tcl", <<'TCL', <<'OUT', "delete inlined sub" );
  58  set a 1
  59  incr a
  60  puts $a
  61  rename incr {}
  62  incr a
  63 TCL
  64 2
  65 invalid command name "incr"
  66 OUT
  67
  68 language_output_is( "tcl", <<'TCL', <<'OUT', "rename inlined sub" );
  69  set a 1
  70  rename incr foo
  71  foo a
  72  puts $a
  73 TCL
  74 2
  75 OUT
  76
  77 language_output_is( "tcl", <<'TCL', <<'OUT', "rename in a namespace" );
  78 proc puts2 {args} {puts {*}$args}
  79
  80 namespace eval joe {
  81     proc puts2 {args} {puts "HELLO WORLD"}
  82 }
  83
  84 namespace eval joe {
  85     puts2 "HI THERE"
  86     rename puts2 {}
  87 }
  88
  89 puts2 "HI THERE"
  90
  91 namespace eval joe {
  92     puts "HI THERE"
  93 }
  94 TCL
  95 HELLO WORLD
  96 HI THERE
  97 HI THERE
  98 OUT
  99
 100 # Local Variables:
 101 #   mode: cperl
 102 #   cperl-indent-level: 4
 103 #   fill-column: 100
 104 # End:
 105 # vim: expandtab shiftwidth=4: