tests/coverage.test

   1 # various tests to improve code coverage
   2
   3 source [file dirname [info script]]/testing.tcl
   4
   5 testCmdConstraints ref rand
   6
   7 testConstraint debug-invstr 0
   8 catch {
   9         debug -commands
  10         testConstraint debug-invstr 1
  11 }
  12
  13 test dupobj-1 {duplicate script object} {
  14         set y {expr 2}
  15         # make y a script
  16         eval $y
  17         # Now treat it as a list that needs duplicating
  18         lset y 0 abc
  19         set y
  20 } {abc 2}
  21
  22 test dupobj-2 {duplicate expr object} {
  23         set y {2 + 1}
  24         # make y an expression
  25         expr $y
  26         # Now treat it as a list that needs duplicating
  27         lset y 0 abc
  28         set y
  29 } {abc + 1}
  30
  31 test dupobj-3 {duplicate interpolated object} {
  32         set w 4
  33         set y def($w)
  34         # Now treat it as a namespace object that needs duplicating
  35         namespace eval $y {}
  36         apply [list x {set x 1} $y] x
  37 } {1}
  38
  39 test dupobj-4 {duplicate dict subst object} {
  40         # make y a dict subst
  41         set def(4) 5
  42         set y def(4)
  43         incr $y
  44         # Now treat it as a namespace object that needs duplicating
  45         namespace eval $y {}
  46         apply [list x {set x 1} $y] x
  47 } {1}
  48
  49 test dupobj-5 {duplicate object with no string rep} {
  50         # A sorted list has no string rep
  51         set y [lsort {abc def}]
  52         # Now treat it as a namespace object that needs duplicating
  53         namespace eval $y {}
  54         apply [list x {set x 1} $y] x
  55 } {1}
  56
  57 test dupobj-6 {duplicate object with no type dup proc} {
  58         set x 6
  59         incr x
  60         # x is now an int, an object with no dup proc
  61         # using as a namespace requires the object to be duplicated
  62         namespace eval $x {
  63                 proc a {} {}
  64                 rename a ""
  65         }
  66 } {}
  67
  68 test dupobj-7 {duplicate scan obj} {
  69         set x "%d %d"
  70         scan "1 4" $x y z
  71         # Now treat it as a namespace object that needs duplicating
  72         namespace eval $x {}
  73         apply [list x {set x 1} $x] x
  74 } {1}
  75
  76
  77 test script-1 {convert empty object to script} {
  78         set empty [foreach a {} {}]
  79         eval $empty
  80 } {}
  81
  82 test ref-1 {treat something as a reference} ref {
  83         set ref [ref abc tag]
  84         append ref "  "
  85         getref "  $ref "
  86 } {abc}
  87
  88 test ref-2 {getref invalid reference} -constraints ref -body {
  89         getref "<reference.<tag____>.99999999999999000000>"
  90 } -returnCodes error -match glob -result {invalid reference id *}
  91
  92 test ref-3 {getref invalid reference tag} -constraints ref -body {
  93         getref "<reference.<tag!%(*>.99999999999999000000>"
  94 } -returnCodes error -match glob -result {expected reference but got "<reference.<tag!%(*>.99999999999999000000>"}
  95
  96 test ref-4 {finalize} ref {
  97         finalize $ref
  98 } {}
  99
 100 test ref-5 {finalize} ref {
 101         finalize $ref cleanup
 102         finalize $ref cleanup2
 103         finalize $ref
 104 } {cleanup2}
 105
 106 test ref-6 {finalize get invalid reference} -constraints ref -body {
 107         finalize "<reference.<tag____>.99999999999999000000>"
 108 } -returnCodes error -match glob -result {invalid reference id *}
 109
 110 test ref-7 {finalize set invalid reference} -constraints ref -body {
 111         finalize "<reference.<tag____>.99999999999999000000>" cleanup
 112 } -returnCodes error -match glob -result {invalid reference id *}
 113
 114 test collect-1 {recursive collect} ref {
 115         set ref2 [ref dummy cleanup2]
 116         unset ref2
 117         proc cleanup2 {ref value} {
 118                 # Try to call collect
 119                 stdout puts "in cleanup2: ref=$ref, value=$value"
 120                 if {[collect]} {
 121                         error "Should return 0"
 122                 }
 123         }
 124         collect
 125 } {1}
 126
 127 test scan-1 {update string of scan obj} debug-invstr {
 128         set x "%d %d"
 129         scan "1 4" $x y z
 130         debug invstr $x
 131         # x is now of scanfmt type with no string rep
 132         set x
 133 } {%d %d}
 134
 135 # It is too hard to do this one without debug invstr
 136 test index-1 {update string of index} debug-invstr {
 137         set x end-1
 138         lindex {a b c} $x
 139         debug invstr $x
 140         # x is now of index type with no string rep
 141         set x
 142 } {end-1}
 143
 144 test index-2 {update string of index} debug-invstr {
 145         set x end
 146         lindex {a b c} $x
 147         debug invstr $x
 148         # x is now of index type with no string rep
 149         set x
 150 } {end}
 151
 152 test index-3 {update string of index} debug-invstr {
 153         set x 2
 154         lindex {a b c} $x
 155         debug invstr $x
 156         # x is now of index type with no string rep
 157         set x
 158 } {2}
 159
 160 test index-4 {index > INT_MAX} debug-invstr {
 161         set x 99999999999
 162         incr x
 163         # x is now of int type > INT_MAX
 164         lindex {a b c} $x
 165 } {}
 166
 167 test index-5 {update string of index} debug-invstr {
 168         set x -1
 169         lindex {a b c} $x
 170         debug invstr $x
 171         # x is now of index type with no string rep
 172         set x
 173 } {-2147483647}
 174
 175 test cmd-1 {standard -commands} jim {
 176         expr {"length" in [string -commands]}
 177 } {1}
 178
 179 test rand-1 {rand} -constraints rand -body {
 180         rand 1 2 3
 181 } -returnCodes error -result {wrong # args: should be "rand ?min? max"}
 182
 183 test rand-2 {rand} -constraints rand -body {
 184         rand foo
 185 } -returnCodes error -result {expected integer but got "foo"}
 186
 187 test rand-3 {rand} -constraints rand -body {
 188         rand 2 bar
 189 } -returnCodes error -result {expected integer but got "bar"}
 190
 191 test rand-4 {rand} rand {
 192         string is integer [rand]
 193 } {1}
 194
 195 test rand-5 {srand} rand {
 196         set x [expr {srand(123)}]
 197         if {$x >= 0 && $x <= 1} {
 198                 return 1
 199         } else {
 200                 return 0
 201         }
 202 } {1}
 203
 204 test lreverse-1 {lreverse} -body {
 205         lreverse
 206 } -returnCodes error -result {wrong # args: should be "lreverse list"}
 207
 208 test divide-1 {expr} -constraints jim -body {
 209         / 2 0
 210 } -returnCodes error -result {Division by zero}
 211
 212 test package-1 {package names} jim {
 213         expr {"stdlib" in [package names]}
 214 } {1}
 215
 216 test variable-1 {upvar to invalid name} -constraints jim -body {
 217         proc a {} {
 218                 upvar var\0null abc
 219                 incr abc
 220         }
 221         a
 222 } -returnCodes error -result {variable name contains embedded null}
 223
 224 test variable-2 {upvar to global name} {
 225         set ::globalvar 1
 226         proc a {} {
 227                 upvar ::globalvar abc
 228                 incr abc
 229         }
 230         a
 231 } {2}
 232
 233 test unknown-1 {recursive unknown} -body {
 234         # unknown will call itself a maximum of 50 times before simply returning an error
 235         proc unknown {args} {
 236                 nonexistent 3
 237         }
 238         nonexistent 4
 239 } -returnCodes error -result {invalid command name "nonexistent"} -cleanup {
 240         rename unknown {}
 241 }
 242
 243 test interpolate-1 {interpolate} -body {
 244         unset -nocomplain a
 245         for {set i 0} {$i < 10} {incr i} {
 246                 set a($i) $i
 247         }
 248         set x "$a(0)$a(1)$a(2)$a(3)$a(4)$a(5)$a(6)$a(7)$a(8)$a(9)$nonexistent"
 249         set x
 250 } -returnCodes error -result {can't read "nonexistent": no such variable}
 251
 252
 253 testreport