tests/rename.test

   1 # Commands covered:  rename
   2 #
   3 # This file contains a collection of tests for one or more of the Tcl
   4 # built-in commands.  Sourcing this file into Tcl runs the tests and
   5 # generates output for errors.  No output means no errors were found.
   6 #
   7 # Copyright (c) 1991-1993 The Regents of the University of California.
   8 # Copyright (c) 1994 Sun Microsystems, Inc.
   9 # Copyright (c) 1998-1999 by Scriptics Corporation.
  10 #
  11 # See the file "license.terms" for information on usage and redistribution
  12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13 #
  14 # RCS: @(#) $Id: rename.test,v 1.8.2.1 2001/09/12 20:34:59 dgp Exp $
  15
  16 source [file dirname [info script]]/testing.tcl
  17
  18 # Must eliminate the "unknown" command while the test is running,
  19 # especially if the test is being run in a program with its
  20 # own special-purpose unknown command.
  21
  22 catch {rename unknown unknown.old}
  23
  24 catch {rename r2 {}}
  25 proc r1 {} {return "procedure r1"}
  26 rename r1 r2
  27 test rename-1.1 {simple renaming} {
  28     r2
  29 } {procedure r1}
  30 test rename-1.2 {simple renaming} {
  31     list [catch r1 msg] $msg
  32 } {1 {invalid command name "r1"}}
  33 rename r2 {}
  34 test rename-1.3 {simple renaming} {
  35     list [catch r2 msg] $msg
  36 } {1 {invalid command name "r2"}}
  37
  38 # The test below is tricky because it renames a built-in command.
  39 # It's possible that the test procedure uses this command, so must
  40 # restore the command before calling test again.
  41
  42 rename list l.new
  43 set a [catch list msg1]
  44 set b [l.new a b c]
  45 rename l.new list
  46 set c [catch l.new msg2]
  47 set d [list 111 222]
  48 test rename-2.1 {renaming built-in command} {
  49     list $a $msg1 $b $c $msg2 $d
  50 } {1 {invalid command name "list"} {a b c} 1 {invalid command name "l.new"} {111 222}}
  51
  52 test rename-3.1 {error conditions} {
  53     list [catch {rename r1} msg] $msg
  54 } {1 {wrong # args: should be "rename oldName newName"}}
  55 test rename-3.2 {error conditions} {
  56     list [catch {rename r1 r2 r3} msg] $msg
  57 } {1 {wrong # args: should be "rename oldName newName"}}
  58 test rename-3.3 {error conditions} {
  59     proc r1 {} {}
  60     proc r2 {} {}
  61     list [catch {rename r1 r2} msg] $msg
  62 } {1 {can't rename to "r2": command already exists}}
  63 test rename-3.4 {error conditions} {
  64     catch {rename r1 {}}
  65     catch {rename r2 {}}
  66     list [catch {rename r1 r2} msg] $msg
  67 } {1 {can't rename "r1": command doesn't exist}}
  68 test rename-3.5 {error conditions} {
  69     catch {rename _non_existent_command {}}
  70     list [catch {rename _non_existent_command {}} msg] $msg
  71 } {1 {can't delete "_non_existent_command": command doesn't exist}}
  72
  73 catch {rename unknown {}}
  74 catch {rename unknown.old unknown}
  75
  76 if {[info command testdel] == "testdel"} {
  77     test rename-4.1 {reentrancy issues with command deletion and renaming} {
  78         set x {}
  79         testdel {} foo {lappend x deleted; rename bar {}; lappend x [info command bar]}
  80         rename foo bar
  81         lappend x |
  82         rename bar {}
  83         set x
  84     } {| deleted {}}
  85     test rename-4.2 {reentrancy issues with command deletion and renaming} {
  86         set x {}
  87         testdel {} foo {lappend x deleted; rename foo bar}
  88         rename foo {}
  89         set x
  90     } {deleted}
  91     test rename-4.3 {reentrancy issues with command deletion and renaming} {
  92         set x {}
  93         testdel {} foo {lappend x deleted; testdel {} foo {lappend x deleted2}}
  94         rename foo {}
  95         lappend x |
  96         rename foo {}
  97         set x
  98     } {deleted | deleted2}
  99     test rename-4.4 {reentrancy issues with command deletion and renaming} {
 100         set x {}
 101         testdel {} foo {lappend x deleted; rename foo bar}
 102         rename foo {}
 103         lappend x | [info command bar]
 104     } {deleted | {}}
 105     test rename-4.5 {reentrancy issues with command deletion and renaming} {
 106         set env(value) before
 107         interp create foo
 108         testdel foo cmd {set env(value) deleted}
 109         interp delete foo
 110         set env(value)
 111     } {deleted}
 112     test rename-4.6 {reentrancy issues with command deletion and renaming} {
 113         proc killx args {
 114             interp delete foo
 115         }
 116         set env(value) before
 117         interp create foo
 118         foo alias killx killx
 119         testdel foo cmd {set env(value) deleted; killx}
 120         list [catch {foo eval {rename cmd {}}} msg] $msg $env(value)
 121     } {0 {} deleted}
 122     test rename-4.7 {reentrancy issues with command deletion and renaming} {
 123         proc killx args {
 124             interp delete foo
 125         }
 126         set env(value) before
 127         interp create foo
 128         foo alias killx killx
 129         testdel foo cmd {set env(value) deleted; killx}
 130         list [catch {interp delete foo} msg] $msg $env(value)
 131     } {0 {} deleted}
 132     if {[info exists env(value)]} {
 133         unset env(value)
 134     }
 135 }
 136
 137 test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
 138     proc x {} {
 139         set a 123
 140         set b [split a 2]
 141     }
 142     x
 143     rename split split.old
 144     proc split {} {puts "new split called!"}
 145     catch {x} msg
 146 } 1
 147
 148 if {[info commands split.old] != {}} {
 149     catch {rename split {}}
 150     catch {rename split.old split}
 151 }
 152 catch {rename x {}}
 153 catch {rename killx {}}
 154
 155 testreport