1# This file contains a collection of tests for the procedures in the file 2# tclCompExpr.c. Sourcing this file into Tcl runs the tests and generates 3# output for errors. No output means no errors were found. 4# 5# Copyright © 1997 Sun Microsystems, Inc. 6# Copyright © 1998-1999 Scriptics Corporation. 7# 8# See the file "license.terms" for information on usage and redistribution of 9# this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 11if {"::tcltest" ni [namespace children]} { 12 package require tcltest 2.5 13 namespace import -force ::tcltest::* 14} 15 16::tcltest::loadTestedCommands 17catch [list package require -exact tcl::test [info patchlevel]] 18 19# Constrain memory leak tests 20testConstraint memory [llength [info commands memory]] 21 22catch {unset a} 23 24test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} { 25 expr 1+2 26} 3 27test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} -body { 28 expr 1+2+ 29} -returnCodes error -match glob -result * 30test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} -body { 31 list [catch {expr "foo(123)"} msg] $msg 32} -match glob -result {1 {* "*foo"}} 33test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} { 34 set a {0o00123} 35 expr {$a} 36} 83 37 38test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} -setup { 39 unset -nocomplain a 40} -body { 41 set a 27 42 expr {"foo$a" < "bar"} 43} -result 0 44test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} -body { 45 expr {"00[expr 1+]" + 17} 46} -returnCodes error -match glob -result * 47test compExpr-2.3 {CompileSubExpr procedure, TCL_TOKEN_TEXT parse token} { 48 expr {{12345}} 49} 12345 50test compExpr-2.4 {CompileSubExpr procedure, empty TCL_TOKEN_TEXT parse token} { 51 expr {{}} 52} {} 53test compExpr-2.5 {CompileSubExpr procedure, TCL_TOKEN_BS parse token} { 54 expr "\{ \\ 55 +123 \}" 56} 123 57test compExpr-2.6 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} { 58 expr {[info tclversion] != ""} 59} 1 60test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} { 61 expr {[]} 62} {} 63test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} -body { 64 expr {[foo "bar"xxx] + 17} 65} -returnCodes error -match glob -result * 66test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup { 67 unset -nocomplain a 68} -body { 69 set a 123 70 expr {$a*2} 71} -result 246 72test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup { 73 unset -nocomplain a 74 unset -nocomplain b 75} -body { 76 set a(george) martha 77 set b geo 78 expr {$a(${b}rge)} 79} -result martha 80test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} -body { 81 unset -nocomplain a 82 expr {$a + 17} 83} -returnCodes error -result {can't read "a": no such variable} 84test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} { 85 expr {27||3? 3<<(1+4) : 4&&9} 86} 96 87test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { 88 unset -nocomplain a 89} -body { 90 set a 15 91 list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg 92} -result {0 1} 93test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} { 94 expr {5*6} 95} 30 96test compExpr-2.15 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function found} { 97 format %.6g [expr {sin(2.0)}] 98} 0.909297 99test compExpr-2.16 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function not found} -body { 100 list [catch {expr {fred(2.0)}} msg] $msg 101} -match glob -result {1 {* "*fred"}} 102test compExpr-2.17 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 103 expr {4*2} 104} 8 105test compExpr-2.18 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 106 expr {4/2} 107} 2 108test compExpr-2.19 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 109 expr {4%2} 110} 0 111test compExpr-2.20 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 112 expr {4<<2} 113} 16 114test compExpr-2.21 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 115 expr {4>>2} 116} 1 117test compExpr-2.22 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 118 expr {4<2} 119} 0 120test compExpr-2.23 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 121 expr {4>2} 122} 1 123test compExpr-2.24 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 124 expr {4<=2} 125} 0 126test compExpr-2.25 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 127 expr {4>=2} 128} 1 129test compExpr-2.26 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 130 expr {4==2} 131} 0 132test compExpr-2.27 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 133 expr {4!=2} 134} 1 135test compExpr-2.28 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 136 expr {4&2} 137} 0 138test compExpr-2.29 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 139 expr {4^2} 140} 6 141test compExpr-2.30 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator} { 142 expr {4|2} 143} 6 144test compExpr-2.31 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} { 145 expr {!4} 146} 0 147test compExpr-2.32 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} { 148 expr {~4} 149} -5 150test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} -setup { 151 unset -nocomplain a 152} -body { 153 set a 15 154 expr {$a==15} ;# compiled out-of-line to runtime call on Tcl_ExprObjCmd 155} -result 1 156test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { 157 expr {+2} 158} 2 159test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body { 160 expr {+[expr 1+]} 161} -returnCodes error -match glob -result * 162test compExpr-2.36 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { 163 expr {4+2} 164} 6 165test compExpr-2.37 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body { 166 expr {[expr 1+]+5} 167} -returnCodes error -match glob -result * 168test compExpr-2.38 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body { 169 expr {5+[expr 1+]} 170} -returnCodes error -match glob -result * 171test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { 172 expr {-2} 173} -2 174test compExpr-2.40 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} { 175 expr {4-2} 176} 2 177test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { 178 unset -nocomplain a 179} -body { 180 set a true 181 expr {0||$a} 182} -result 1 183test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { 184 unset -nocomplain a 185} -body { 186 set a 15 187 list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg 188} -result {0 1} 189test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { 190 unset -nocomplain a 191} -body { 192 set a false 193 expr {3&&$a} 194} -result 0 195test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup { 196 unset -nocomplain a 197} -body { 198 set a false 199 expr {$a||1? 1 : 0} 200} -result 1 201test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup { 202 unset -nocomplain a 203} -body { 204 set a 15 205 list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg 206} -result {0 54} 207 208test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} -setup { 209 unset -nocomplain a 210} -body { 211 set a 2 212 expr {[set a]||0} 213} -result 1 214test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} -setup { 215 unset -nocomplain a 216} -body { 217 set a no 218 expr {$a&&1} 219} -result 0 220test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} -body { 221 expr {[expr *2]||0} 222} -returnCodes error -match glob -result * 223test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} -setup { 224 unset -nocomplain a 225 unset -nocomplain b 226} -body { 227 set a no 228 set b true 229 expr {$a || $b} 230} -result 1 231test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup { 232 unset -nocomplain a 233} -body { 234 set a yes 235 expr {$a || [exit]} 236} -result 1 237test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup { 238 unset -nocomplain a 239} -body { 240 set a no 241 expr {$a && [exit]} 242} -result 0 243test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} -setup { 244 unset -nocomplain a 245} -body { 246 set a 2 247 expr {0||[set a]} 248} -result 1 249test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} -setup { 250 unset -nocomplain a 251} -body { 252 set a no 253 expr {1&&$a} 254} -result 0 255test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} -body { 256 expr {0||[expr %2]} 257} -returnCodes error -match glob -result * 258test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} { 259 set a "abcdefghijkl" 260 set i 7 261 expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 262} 1 263 264test compExpr-4.1 {CompileCondExpr procedure, simple test} -setup { 265 unset -nocomplain a 266} -body { 267 set a 2 268 expr {($a > 1)? "ok" : "nope"} 269} -result ok 270test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} -setup { 271 unset -nocomplain a 272} -body { 273 set a no 274 expr {[set a]? 27 : -54} 275} -result -54 276test compExpr-4.3 {CompileCondExpr procedure, error in test} -body { 277 expr {[expr *2]? +1 : -1} 278} -returnCodes error -match glob -result * 279test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} -setup { 280 unset -nocomplain a 281} -body { 282 set a no 283 expr {1? (27-2) : -54} 284} -result 25 285test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} -setup { 286 unset -nocomplain a 287} -body { 288 set a no 289 expr {1? $a : -54} 290} -result no 291test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} -body { 292 expr {1? [expr *2] : -127} 293} -returnCodes error -match glob -result * 294test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} -setup { 295 unset -nocomplain a 296} -body { 297 set a no 298 expr {(2-2)? -3.14159 : "nope"} 299} -result nope 300test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} -setup { 301 unset -nocomplain a 302} -body { 303 set a 0o0123 304 expr {0? 42 : $a} 305} -result 83 306test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} { 307 list [catch {expr {1? 15 : [expr *2]}} msg] $msg 308} {0 15} 309 310test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { 311 format %.6g [expr {atan2(1.0, 2.0)}] 312} 0.463648 313test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body { 314 expr {do_it()} 315} -returnCodes error -match glob -result {* "*do_it"} 316test compExpr-5.5 {CompileMathFuncCall procedure, not enough arguments} -body { 317 expr {atan2(1.0)} 318} -returnCodes error -match glob -result {not enough arguments for math function*} 319test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} { 320 format %.6g [expr {pow(2.1, 27.5-(24.4*(5%2)))}] 321} 9.97424 322test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body { 323 expr {sinh(2.*)} 324} -returnCodes error -match glob -result * 325test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body { 326 expr {sinh(2.0, 3.0)} 327} -returnCodes error -match glob -result {too many arguments for math function*} 328test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} -body { 329 expr {0 <= rand(5.2)} 330} -returnCodes error -match glob -result {too many arguments for math function*} 331 332test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -body { 333 expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3 334} -returnCodes error -match glob -result * 335 336test compExpr-7.1 {Memory Leak} -constraints memory -setup { 337 proc getbytes {} { 338 set lines [split [memory info] \n] 339 lindex $lines 3 3 340 } 341} -body { 342 set end [getbytes] 343 for {set i 0} {$i < 5} {incr i} { 344 interp create child 345 child eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13 346 interp delete child 347 set tmp $end 348 set end [getbytes] 349 } 350 set leakedBytes [expr {$end - $tmp}] 351} -cleanup { 352 unset end i tmp 353 rename getbytes {} 354} -result 0 355 356test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setup { 357 proc getbytes {} { 358 set lines [split [memory info] \n] 359 lindex $lines 3 3 360 } 361} -body { 362 set i 5 363 set end [getbytes] 364 while {[incr i -1]} { 365 expr ${i}000 366 set tmp $end 367 set end [getbytes] 368 } 369 set leakedBytes [expr {$end - $tmp}] 370} -cleanup { 371 unset end i tmp 372 rename getbytes {} 373} -result 0 374 375proc extract {opcodes descriptor} { 376 set instructions [dict values [dict get $descriptor instructions]] 377 return [lmap i $instructions { 378 if {[lindex $i 0] in $opcodes} {string cat $i} else continue 379 }] 380} 381 382test compExpr-8.1 {TIP 582: expression comments} -setup {} -body { 383 extract {loadStk add} [tcl::unsupported::getbytecode script {expr { 384 $abc 385 # + $def 386 + $ghi 387 }}] 388} -result {loadStk loadStk add} 389test compExpr-8.2 {TIP 582: expression comments} -setup {} -body { 390 extract {loadStk add} [tcl::unsupported::getbytecode script {expr { 391 $abc 392 # + $def 393 # + $ghi }}] 394} -result loadStk 395test compExpr-8.3 {TIP 582: expression comments} -setup {} -body { 396 extract {loadStk add} [tcl::unsupported::getbytecode script {expr { 397 $abc 398 # + $def\ 399 + $ghi 400 }}] 401} -result loadStk 402test compExpr-8.4 {TIP 582: expression comments} -setup {} -body { 403 extract {loadStk add} [tcl::unsupported::getbytecode script {expr { 404 $abc 405 # + $def\\ 406 + $ghi 407 }}] 408} -result {loadStk loadStk add} 409 410# cleanup 411catch {unset a} 412catch {unset b} 413catch {rename extract ""} 414::tcltest::cleanupTests 415return 416 417# Local Variables: 418# mode: tcl 419# fill-column: 78 420# End: 421