regtest.tcl

   1 # REGTEST 1
   2 # 27Jan2005 - SIGSEGV for bug on Jim_DuplicateObj().
   3
   4 for {set i 0} {$i < 100} {incr i} {
   5     set a "x"
   6     lappend a n
   7 }
   8 puts "TEST 1 PASSED"
   9
  10 # REGTEST 2
  11 # 29Jan2005 - SEGFAULT parsing script composed of just one comment.
  12 eval {#foobar}
  13 puts "TEST 2 PASSED"
  14
  15 # REGTEST 3
  16 # 29Jan2005 - "Error in Expression" with correct expression
  17 set x 5
  18 expr {$x-5}
  19 puts "TEST 3 PASSED"
  20
  21 # REGTEST 4
  22 # 29Jan2005 - SIGSEGV when run this code, due to expr's bug.
  23 proc fibonacci {x} {
  24     if {$x <= 1} {
  25     expr 1
  26     } else {
  27     expr {[fibonacci [expr {$x-1}]] + [fibonacci [expr {$x-2}]]}
  28     }
  29 }
  30 fibonacci 6
  31 puts "TEST 4 PASSED"
  32
  33 # REGTEST 5
  34 # 06Mar2005 - This looped forever...
  35 for {set i 0} {$i < 10} {incr i} {continue}
  36 puts "TEST 5 PASSED"
  37
  38 # REGTEST 6
  39 # 07Mar2005 - Unset create variable + dict is using dict syntax sugar at
  40 #             currently non-existing variable
  41 catch {unset thisvardoesnotexists(thiskeytoo)}
  42 if {[catch {set thisvardoesnotexists}] == 0} {
  43   puts "TEST 6 FAILED - unset created dict for non-existing variable"
  44   break
  45 }
  46 puts "TEST 6 PASSED"
  47
  48 # REGTEST 7
  49 # 04Nov2008 - variable parsing does not eat last brace
  50 set a 1
  51 list ${a}
  52 puts "TEST 7 PASSED"
  53
  54 # REGTEST 8
  55 # 04Nov2008 - string toupper/tolower do not convert to string rep
  56 string tolower [list a]
  57 string toupper [list a]
  58 puts "TEST 8 PASSED"
  59
  60 # REGTEST 9
  61 # 04Nov2008 - crash on exit when replacing Tcl proc with C command.
  62 # Requires the clock extension to be built as a loadable module.
  63 proc clock {args} {}
  64 catch {package require clock}
  65 # Note, crash on exit, so don't say we passed!
  66
  67 # REGTEST 10
  68 # 05Nov2008 - incorrect lazy expression evaluation with unary not
  69 expr {1 || !0}
  70 puts "TEST 10 PASSED"
  71
  72 # REGTEST 11
  73 # 14 Feb 2010 - access static variable in deleted proc
  74 proc a {} {{x 1}} { rename a ""; incr x }
  75 a
  76 puts "TEST 11 PASSED"
  77
  78 # REGTEST 12
  79 # 13 Sep 2010 - reference with invalid tag
  80 set a b[ref value "tag name"]
  81 getref [string range $a 1 end]
  82 puts "TEST 12 PASSED"
  83
  84 # REGTEST 13
  85 # 14 Sep 2010 - parse list with trailing backslash
  86 set x "switch -0 \$on \\"
  87 lindex $x 1
  88 puts "TEST 13 PASSED"
  89
  90 # REGTEST 14
  91 # 14 Sep 2010 - command expands to nothing
  92 eval "{*}{}"
  93 puts "TEST 14 PASSED"
  94
  95 # REGTEST 15
  96 # 24 Feb 2010 - bad reference counting of the stack trace in 'error'
  97 proc a {msg stack} {
  98     tailcall error $msg $stack
  99 }
 100 catch {fail} msg opts
 101 catch {a $msg $opts(-errorinfo)}
 102
 103 # REGTEST 16
 104 # 24 Feb 2010 - rename the current proc
 105 # Leaves unfreed objects on the stack
 106 proc a {} { rename a newa}
 107 a
 108
 109 # REGTEST 17
 110 # 26 Nov 2010 - crashes on invalid dict sugar
 111 catch {eval {$x(}}
 112 puts "TEST 17 PASSED"
 113
 114 # REGTEST 18
 115 # 12 Apr 2011 - crashes on unset for loop var
 116 catch {
 117     for {set i 0} {$i < 5} {incr i} {unset i}
 118 }
 119 puts "TEST 18 PASSED"
 120
 121 # REGTEST 19
 122 # 25 May 2011 - crashes with double colon
 123 catch {
 124     expr {5 ne ::}
 125 }
 126 puts "TEST 19 PASSED"
 127
 128 # REGTEST 20
 129 # 26 May 2011 - infinite recursion
 130 proc a {} { global ::blah; set ::blah test }
 131 a
 132 puts "TEST 20 PASSED"
 133
 134 # REGTEST 21
 135 # 26 May 2011 - infinite loop with null byte in subst
 136 subst "abc\0def"
 137 puts "TEST 21 PASSED"
 138
 139 # REGTEST 22
 140 # 21 June 2011 - crashes on lappend to to value with script rep
 141 set x rand
 142 eval $x
 143 lappend x b
 144 puts "TEST 22 PASSED"
 145
 146 # REGTEST 23
 147 # 27 July 2011 - unfreed objects on exit
 148 catch {
 149     set x abc
 150     subst $x
 151     regexp $x $x
 152 }
 153 # Actually, the test passes if no objects leaked on exit
 154 puts "TEST 23 PASSED"
 155
 156 # REGTEST 24
 157 # 13 Nov 2011 - invalid cached global var
 158 proc a {} {
 159     foreach i {1 2} {
 160         incr z [set ::t]
 161         unset ::t
 162     }
 163 }
 164 set t 6
 165 catch a
 166 puts "TEST 24 PASSED"
 167
 168 # REGTEST 25
 169 # 14 Nov 2011 - link global var to proc var
 170 proc a {} {
 171     set x 3
 172     upvar 0 x ::globx
 173 }
 174 set globx 0
 175 catch {
 176     a
 177 }
 178 incr globx
 179 puts "TEST 25 PASSED"
 180
 181 # TAKE THE FOLLOWING puts AS LAST LINE
 182
 183 puts "--- ALL TESTS PASSED ---"