1# Commands covered: regexp, regsub 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 © 1991-1993 The Regents of the University of California. 8# Copyright © 1998 Sun Microsystems, Inc. 9# Copyright © 1998-1999 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 14if {"::tcltest" ni [namespace children]} { 15 package require tcltest 2.5 16 namespace import -force ::tcltest::* 17} 18 19testConstraint nodep [info exists tcl_precision] 20 21# Procedure to evaluate a script within a proc, to test compilation 22# functionality 23 24proc evalInProc { script } { 25 proc testProc {} $script 26 set status [catch { 27 testProc 28 } result] 29 rename testProc {} 30 return $result 31 #return [list $status $result] 32} 33 34unset -nocomplain foo 35 36test regexpComp-1.1 {basic regexp operation} { 37 evalInProc { 38 regexp ab*c abbbc 39 } 40} 1 41test regexpComp-1.2 {basic regexp operation} { 42 evalInProc { 43 regexp ab*c ac 44 } 45} 1 46test regexpComp-1.3 {basic regexp operation} { 47 evalInProc { 48 regexp ab*c ab 49 } 50} 0 51test regexpComp-1.4 {basic regexp operation} { 52 evalInProc { 53 regexp -- -gorp abc-gorpxxx 54 } 55} 1 56test regexpComp-1.5 {basic regexp operation} { 57 evalInProc { 58 regexp {^([^ ]*)[ ]*([^ ]*)} "" a 59 } 60} 1 61test regexpComp-1.6 {basic regexp operation} { 62 list [catch {regexp {} abc} msg] $msg 63} {0 1} 64test regexpComp-1.7 {regexp utf compliance} { 65 # if not UTF-8 aware, result is "0 1" 66 evalInProc { 67 set foo "乎b q" 68 regexp "乎b q" "a乎b qw幎N wq" bar 69 list [string compare $foo $bar] [regexp 4 $bar] 70 } 71} {0 0} 72 73test regexpComp-1.8 {regexp ***= metasyntax} { 74 evalInProc { 75 regexp -- "***=o" "aeiou" 76 } 77} 1 78test regexpComp-1.9 {regexp ***= metasyntax} { 79 evalInProc { 80 set string "aeiou" 81 regexp -- "***=o" $string 82 } 83} 1 84test regexpComp-1.10 {regexp ***= metasyntax} { 85 evalInProc { 86 set string "aeiou" 87 set re "***=o" 88 regexp -- $re $string 89 } 90} 1 91test regexpComp-1.11 {regexp ***= metasyntax} { 92 evalInProc { 93 regexp -- "***=y" "aeiou" 94 } 95} 0 96test regexpComp-1.12 {regexp ***= metasyntax} { 97 evalInProc { 98 set string "aeiou" 99 regexp -- "***=y" $string 100 } 101} 0 102test regexpComp-1.13 {regexp ***= metasyntax} { 103 evalInProc { 104 set string "aeiou" 105 set re "***=y" 106 regexp -- $re $string 107 } 108} 0 109test regexpComp-1.14 {regexp ***= metasyntax} { 110 evalInProc { 111 set string "aeiou" 112 set re "***=e*o" 113 regexp -- $re $string 114 } 115} 0 116test regexpComp-1.15 {regexp ***= metasyntax} { 117 evalInProc { 118 set string "ae*ou" 119 set re "***=e*o" 120 regexp -- $re $string 121 } 122} 1 123test regexpComp-1.16 {regexp ***= metasyntax} { 124 evalInProc { 125 set string {ae*[o]?ua} 126 set re {***=e*[o]?u} 127 regexp -- $re $string 128 } 129} 1 130 131test regexpComp-2.1 {getting substrings back from regexp} { 132 evalInProc { 133 set foo {} 134 list [regexp ab*c abbbbc foo] $foo 135 } 136} {1 abbbbc} 137test regexpComp-2.2 {getting substrings back from regexp} { 138 evalInProc { 139 set foo {} 140 set f2 {} 141 list [regexp a(b*)c abbbbc foo f2] $foo $f2 142 } 143} {1 abbbbc bbbb} 144test regexpComp-2.3 {getting substrings back from regexp} { 145 evalInProc { 146 set foo {} 147 set f2 {} 148 list [regexp a(b*)(c) abbbbc foo f2] $foo $f2 149 } 150} {1 abbbbc bbbb} 151test regexpComp-2.4 {getting substrings back from regexp} { 152 evalInProc { 153 set foo {} 154 set f2 {} 155 set f3 {} 156 list [regexp a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 157 } 158} {1 abbbbc bbbb c} 159test regexpComp-2.5 {getting substrings back from regexp} { 160 evalInProc { 161 set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; 162 set f6 {}; set f7 {}; set f8 {}; set f9 {}; set fa {}; set fb {}; 163 list [regexp (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*)(a*)(b*) \ 164 12223345556789999aabbb \ 165 foo f1 f2 f3 f4 f5 f6 f7 f8 f9 fa fb] $foo $f1 $f2 $f3 $f4 $f5 \ 166 $f6 $f7 $f8 $f9 $fa $fb 167 } 168} {1 12223345556789999aabbb 1 222 33 4 555 6 7 8 9999 aa bbb} 169test regexpComp-2.6 {getting substrings back from regexp} { 170 evalInProc { 171 set foo 2; set f2 2; set f3 2; set f4 2 172 list [regexp (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 173 } 174} {1 a a {} {}} 175test regexpComp-2.7 {getting substrings back from regexp} { 176 evalInProc { 177 set foo 1; set f2 1; set f3 1; set f4 1 178 list [regexp (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 179 } 180} {1 ac a {} c} 181test regexpComp-2.8 {getting substrings back from regexp} { 182 evalInProc { 183 set match {} 184 list [regexp {^a*b} aaaab match] $match 185 } 186} {1 aaaab} 187 188test regexpComp-3.1 {-indices option to regexp} { 189 evalInProc { 190 set foo {} 191 list [regexp -indices ab*c abbbbc foo] $foo 192 } 193} {1 {0 5}} 194test regexpComp-3.2 {-indices option to regexp} { 195 evalInProc { 196 set foo {} 197 set f2 {} 198 list [regexp -indices a(b*)c abbbbc foo f2] $foo $f2 199 } 200} {1 {0 5} {1 4}} 201test regexpComp-3.3 {-indices option to regexp} { 202 evalInProc { 203 set foo {} 204 set f2 {} 205 list [regexp -indices a(b*)(c) abbbbc foo f2] $foo $f2 206 } 207} {1 {0 5} {1 4}} 208test regexpComp-3.4 {-indices option to regexp} { 209 evalInProc { 210 set foo {} 211 set f2 {} 212 set f3 {} 213 list [regexp -indices a(b*)(c) abbbbc foo f2 f3] $foo $f2 $f3 214 } 215} {1 {0 5} {1 4} {5 5}} 216test regexpComp-3.5 {-indices option to regexp} { 217 evalInProc { 218 set foo {}; set f1 {}; set f2 {}; set f3 {}; set f4 {}; set f5 {}; 219 set f6 {}; set f7 {}; set f8 {}; set f9 {} 220 list [regexp -indices (1*)(2*)(3*)(4*)(5*)(6*)(7*)(8*)(9*) \ 221 12223345556789999 \ 222 foo f1 f2 f3 f4 f5 f6 f7 f8 f9] $foo $f1 $f2 $f3 $f4 $f5 \ 223 $f6 $f7 $f8 $f9 224 } 225} {1 {0 16} {0 0} {1 3} {4 5} {6 6} {7 9} {10 10} {11 11} {12 12} {13 16}} 226test regexpComp-3.6 {getting substrings back from regexp} { 227 evalInProc { 228 set foo 2; set f2 2; set f3 2; set f4 2 229 list [regexp -indices (a)(b)? xay foo f2 f3 f4] $foo $f2 $f3 $f4 230 } 231} {1 {1 1} {1 1} {-1 -1} {-1 -1}} 232test regexpComp-3.7 {getting substrings back from regexp} { 233 evalInProc { 234 set foo 1; set f2 1; set f3 1; set f4 1 235 list [regexp -indices (a)(b)?(c) xacy foo f2 f3 f4] $foo $f2 $f3 $f4 236 } 237} {1 {1 2} {1 1} {-1 -1} {2 2}} 238 239test regexpComp-4.1 {-nocase option to regexp} { 240 evalInProc { 241 regexp -nocase foo abcFOo 242 } 243} 1 244test regexpComp-4.2 {-nocase option to regexp} { 245 evalInProc { 246 set f1 22 247 set f2 33 248 set f3 44 249 list [regexp -nocase {a(b*)([xy]*)z} aBbbxYXxxZ22 f1 f2 f3] $f1 $f2 $f3 250 } 251} {1 aBbbxYXxxZ Bbb xYXxx} 252test regexpComp-4.3 {-nocase option to regexp} { 253 evalInProc { 254 regexp -nocase FOo abcFOo 255 } 256} 1 257set ::x abcdefghijklmnopqrstuvwxyz1234567890 258set ::x $x$x$x$x$x$x$x$x$x$x$x$x 259test regexpComp-4.4 {case conversion in regexp} { 260 evalInProc { 261 list [regexp -nocase $::x $::x foo] $foo 262 } 263} "1 $x" 264unset -nocomplain ::x 265 266test regexpComp-5.1 {exercise cache of compiled expressions} { 267 evalInProc { 268 regexp .*a b 269 regexp .*b c 270 regexp .*c d 271 regexp .*d e 272 regexp .*e f 273 regexp .*a bbba 274 } 275} 1 276test regexpComp-5.2 {exercise cache of compiled expressions} { 277 evalInProc { 278 regexp .*a b 279 regexp .*b c 280 regexp .*c d 281 regexp .*d e 282 regexp .*e f 283 regexp .*b xxxb 284 } 285} 1 286test regexpComp-5.3 {exercise cache of compiled expressions} { 287 evalInProc { 288 regexp .*a b 289 regexp .*b c 290 regexp .*c d 291 regexp .*d e 292 regexp .*e f 293 regexp .*c yyyc 294 } 295} 1 296test regexpComp-5.4 {exercise cache of compiled expressions} { 297 evalInProc { 298 regexp .*a b 299 regexp .*b c 300 regexp .*c d 301 regexp .*d e 302 regexp .*e f 303 regexp .*d 1d 304 } 305} 1 306test regexpComp-5.5 {exercise cache of compiled expressions} { 307 evalInProc { 308 regexp .*a b 309 regexp .*b c 310 regexp .*c d 311 regexp .*d e 312 regexp .*e f 313 regexp .*e xe 314 } 315} 1 316 317test regexpComp-6.1 {regexp errors} { 318 evalInProc { 319 list [catch {regexp a} msg] $msg 320 } 321} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} 322test regexpComp-6.2 {regexp errors} { 323 evalInProc { 324 list [catch {regexp -nocase a} msg] $msg 325 } 326} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}} 327test regexpComp-6.3 {regexp errors} { 328 evalInProc { 329 list [catch {regexp -gorp a} msg] $msg 330 } 331} {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} 332test regexpComp-6.4 {regexp errors} { 333 evalInProc { 334 list [catch {regexp a( b} msg] $msg 335 } 336} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} 337test regexpComp-6.5 {regexp errors} { 338 evalInProc { 339 list [catch {regexp a( b} msg] $msg 340 } 341} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} 342test regexpComp-6.6 {regexp errors} { 343 evalInProc { 344 list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg 345 } 346} {0 1} 347test regexpComp-6.7 {regexp errors} { 348 evalInProc { 349 list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg 350 } 351} {0 0} 352test regexpComp-6.8 {regexp errors} { 353 evalInProc { 354 unset -nocomplain f1 355 set f1 44 356 list [catch {regexp abc abc f1(f2)} msg] $msg 357 } 358} {1 {can't set "f1(f2)": variable isn't array}} 359test regexpComp-6.9 {regexp errors, -start bad int check} { 360 evalInProc { 361 list [catch {regexp -start bogus {^$} {}} msg] $msg 362 } 363} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} 364 365test regexpComp-7.1 {basic regsub operation} { 366 evalInProc { 367 list [regsub aa+ xaxaaaxaa 111&222 foo] $foo 368 } 369} {1 xax111aaa222xaa} 370test regexpComp-7.2 {basic regsub operation} { 371 evalInProc { 372 list [regsub aa+ aaaxaa &111 foo] $foo 373 } 374} {1 aaa111xaa} 375test regexpComp-7.3 {basic regsub operation} { 376 evalInProc { 377 list [regsub aa+ xaxaaa 111& foo] $foo 378 } 379} {1 xax111aaa} 380test regexpComp-7.4 {basic regsub operation} { 381 evalInProc { 382 list [regsub aa+ aaa 11&2&333 foo] $foo 383 } 384} {1 11aaa2aaa333} 385test regexpComp-7.5 {basic regsub operation} { 386 evalInProc { 387 list [regsub aa+ xaxaaaxaa &2&333 foo] $foo 388 } 389} {1 xaxaaa2aaa333xaa} 390test regexpComp-7.6 {basic regsub operation} { 391 evalInProc { 392 list [regsub aa+ xaxaaaxaa 1&22& foo] $foo 393 } 394} {1 xax1aaa22aaaxaa} 395test regexpComp-7.7 {basic regsub operation} { 396 evalInProc { 397 list [regsub a(a+) xaxaaaxaa {1\122\1} foo] $foo 398 } 399} {1 xax1aa22aaxaa} 400test regexpComp-7.8 {basic regsub operation} { 401 evalInProc { 402 list [regsub a(a+) xaxaaaxaa {1\\\122\1} foo] $foo 403 } 404} "1 {xax1\\aa22aaxaa}" 405test regexpComp-7.9 {basic regsub operation} { 406 evalInProc { 407 list [regsub a(a+) xaxaaaxaa {1\\122\1} foo] $foo 408 } 409} "1 {xax1\\122aaxaa}" 410test regexpComp-7.10 {basic regsub operation} { 411 evalInProc { 412 list [regsub a(a+) xaxaaaxaa {1\\&\1} foo] $foo 413 } 414} "1 {xax1\\aaaaaxaa}" 415test regexpComp-7.11 {basic regsub operation} { 416 evalInProc { 417 list [regsub a(a+) xaxaaaxaa {1\&\1} foo] $foo 418 } 419} {1 xax1&aaxaa} 420test regexpComp-7.12 {basic regsub operation} { 421 evalInProc { 422 list [regsub a(a+) xaxaaaxaa {\1\1\1\1&&} foo] $foo 423 } 424} {1 xaxaaaaaaaaaaaaaaxaa} 425test regexpComp-7.13 {basic regsub operation} { 426 evalInProc { 427 set foo xxx 428 list [regsub abc xyz 111 foo] $foo 429 } 430} {0 xyz} 431test regexpComp-7.14 {basic regsub operation} { 432 evalInProc { 433 set foo xxx 434 list [regsub ^ xyz "111 " foo] $foo 435 } 436} {1 {111 xyz}} 437test regexpComp-7.15 {basic regsub operation} { 438 evalInProc { 439 set foo xxx 440 list [regsub -- -foo abc-foodef "111 " foo] $foo 441 } 442} {1 {abc111 def}} 443test regexpComp-7.16 {basic regsub operation} { 444 evalInProc { 445 set foo xxx 446 list [regsub x "" y foo] $foo 447 } 448} {0 {}} 449test regexpComp-7.17 {regsub utf compliance} { 450 evalInProc { 451 # if not UTF-8 aware, result is "0 1" 452 set foo "xyz555ijka乎bpqr" 453 regsub a乎b xyza乎bijka乎bpqr 555 bar 454 list [string compare $foo $bar] [regexp 4 $bar] 455 } 456} {0 0} 457 458test regexpComp-8.1 {case conversion in regsub} { 459 evalInProc { 460 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo 461 } 462} {1 xaAAaAAay} 463test regexpComp-8.2 {case conversion in regsub} { 464 evalInProc { 465 list [regsub -nocase a(a+) xaAAaAAay & foo] $foo 466 } 467} {1 xaAAaAAay} 468test regexpComp-8.3 {case conversion in regsub} { 469 evalInProc { 470 set foo 123 471 list [regsub a(a+) xaAAaAAay & foo] $foo 472 } 473} {0 xaAAaAAay} 474test regexpComp-8.4 {case conversion in regsub} { 475 evalInProc { 476 set foo 123 477 list [regsub -nocase a CaDE b foo] $foo 478 } 479} {1 CbDE} 480test regexpComp-8.5 {case conversion in regsub} { 481 evalInProc { 482 set foo 123 483 list [regsub -nocase XYZ CxYzD b foo] $foo 484 } 485} {1 CbD} 486test regexpComp-8.6 {case conversion in regsub} { 487 evalInProc { 488 set x abcdefghijklmnopqrstuvwxyz1234567890 489 set x $x$x$x$x$x$x$x$x$x$x$x$x 490 set foo 123 491 list [regsub -nocase $x $x b foo] $foo 492 } 493} {1 b} 494 495test regexpComp-9.1 {-all option to regsub} { 496 evalInProc { 497 set foo 86 498 list [regsub -all x+ axxxbxxcxdx |&| foo] $foo 499 } 500} {4 a|xxx|b|xx|c|x|d|x|} 501test regexpComp-9.2 {-all option to regsub} { 502 evalInProc { 503 set foo 86 504 list [regsub -nocase -all x+ aXxXbxxcXdx |&| foo] $foo 505 } 506} {4 a|XxX|b|xx|c|X|d|x|} 507test regexpComp-9.3 {-all option to regsub} { 508 evalInProc { 509 set foo 86 510 list [regsub x+ axxxbxxcxdx |&| foo] $foo 511 } 512} {1 a|xxx|bxxcxdx} 513test regexpComp-9.4 {-all option to regsub} { 514 evalInProc { 515 set foo 86 516 list [regsub -all bc axxxbxxcxdx |&| foo] $foo 517 } 518} {0 axxxbxxcxdx} 519test regexpComp-9.5 {-all option to regsub} { 520 evalInProc { 521 set foo xxx 522 list [regsub -all node "node node more" yy foo] $foo 523 } 524} {2 {yy yy more}} 525test regexpComp-9.6 {-all option to regsub} { 526 evalInProc { 527 set foo xxx 528 list [regsub -all ^ xxx 123 foo] $foo 529 } 530} {1 123xxx} 531test regexpComp-9.7 {Bug 84af1192f5: -all option to regsub} { 532 evalInProc { 533 regsub -all {\(.*} 123(qwe) "" 534 } 535} 123 536 537test regexpComp-10.1 {expanded syntax in regsub} { 538 evalInProc { 539 set foo xxx 540 list [regsub -expanded ". \#comment\n . \#comment2" abc def foo] $foo 541 } 542} {1 defc} 543test regexpComp-10.2 {newline sensitivity in regsub} { 544 evalInProc { 545 set foo xxx 546 list [regsub -line {^a.*b$} "dabc\naxyb\n" 123 foo] $foo 547 } 548} "1 {dabc\n123\n}" 549test regexpComp-10.3 {newline sensitivity in regsub} { 550 evalInProc { 551 set foo xxx 552 list [regsub -line {^a.*b$} "dabc\naxyb\nxb" 123 foo] $foo 553 } 554} "1 {dabc\n123\nxb}" 555test regexpComp-10.4 {partial newline sensitivity in regsub} { 556 evalInProc { 557 set foo xxx 558 list [regsub -lineanchor {^a.*b$} "da\naxyb\nxb" 123 foo] $foo 559 } 560} "1 {da\n123}" 561test regexpComp-10.5 {inverse partial newline sensitivity in regsub} { 562 evalInProc { 563 set foo xxx 564 list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo 565 } 566} "1 {da\nb123\nxb}" 567 568test regexpComp-11.1 {regsub errors} { 569 evalInProc { 570 list [catch {regsub a b} msg] $msg 571 } 572} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} 573test regexpComp-11.2 {regsub errors} { 574 evalInProc { 575 list [catch {regsub -nocase a b} msg] $msg 576 } 577} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} 578test regexpComp-11.3 {regsub errors} { 579 evalInProc { 580 list [catch {regsub -nocase -all a b} msg] $msg 581 } 582} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} 583test regexpComp-11.4 {regsub errors} { 584 evalInProc { 585 list [catch {regsub a b c d e f} msg] $msg 586 } 587} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}} 588test regexpComp-11.5 {regsub errors} { 589 evalInProc { 590 list [catch {regsub -gorp a b c} msg] $msg 591 } 592} {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}} 593test regexpComp-11.6 {regsub errors} { 594 evalInProc { 595 list [catch {regsub -nocase a( b c d} msg] $msg 596 } 597} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} 598test regexpComp-11.7 {regsub errors} { 599 evalInProc { 600 unset -nocomplain f1 601 set f1 44 602 list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg 603 } 604} {1 {can't set "f1(f2)": variable isn't array}} 605test regexpComp-11.8 {regsub errors, -start bad int check} { 606 evalInProc { 607 list [catch {regsub -start bogus pattern string rep var} msg] $msg 608 } 609} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}} 610 611# This test crashes on the Mac unless you increase the Stack Space to about 1 612# Meg. This is probably bigger than most users want... 613# 8.2.3 regexp reduced stack space requirements, but this should be 614# tested again 615test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} { 616 evalInProc { 617 list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z 618 } 619} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z} 620 621test regexpComp-13.1 {regsub of a very large string} { 622 # This test is designed to stress the memory subsystem in order 623 # to catch Bug #933. It only fails if the Tcl memory allocator 624 # is in use. 625 626 set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE} 627 set filedata [string repeat $line 200] 628 for {set i 1} {$i<10} {incr i} { 629 regsub -all "BEGIN_TABLE " $filedata "" newfiledata 630 } 631 set x done 632} {done} 633 634test regexpComp-14.1 {CompileRegexp: regexp cache} { 635 evalInProc { 636 regexp .*a b 637 regexp .*b c 638 regexp .*c d 639 regexp .*d e 640 regexp .*e f 641 set x . 642 append x *a 643 regexp $x bbba 644 } 645} 1 646test regexpComp-14.2 {CompileRegexp: regexp cache, different flags} { 647 evalInProc { 648 regexp .*a b 649 regexp .*b c 650 regexp .*c d 651 regexp .*d e 652 regexp .*e f 653 set x . 654 append x *a 655 regexp -nocase $x bbba 656 } 657} 1 658 659testConstraint exec [llength [info commands exec]] 660test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints { 661 exec 662} -setup { 663 set junk [makeFile {puts [regexp {} foo]} junk.tcl] 664} -body { 665 exec [interpreter] $junk 666} -cleanup { 667 removeFile junk.tcl 668} -result 1 669 670test regexpComp-15.1 {regexp -start} -body { 671 unset -nocomplain x 672 list [regexp -start -10 {\d} 1abc2de3 x] $x 673} -result {1 1} 674test regexpComp-15.2 {regexp -start} -body { 675 unset -nocomplain x 676 list [regexp -start 2 {\d} 1abc2de3 x] $x 677} -result {1 2} 678test regexpComp-15.3 {regexp -start} -body { 679 unset -nocomplain x 680 list [regexp -start 4 {\d} 1abc2de3 x] $x 681} -result {1 2} 682test regexpComp-15.4 {regexp -start} -body { 683 unset -nocomplain x 684 list [regexp -start 5 {\d} 1abc2de3 x] $x 685} -result {1 3} 686test regexpComp-15.5 {regexp -start, over end of string} -body { 687 unset -nocomplain x 688 list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x] 689} -result {0 0} 690test regexpComp-15.6 {regexp -start, loss of ^$ behavior} -body { 691 list [regexp -start 2 {^$} {}] 692} -result {0} 693 694test regexpComp-16.1 {regsub -start} -body { 695 unset -nocomplain x 696 list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x 697} -result {4 a1b/2c/3d/4e/5} 698test regexpComp-16.2 {regsub -start} -body { 699 unset -nocomplain x 700 list [regsub -all -start -25 {z} hello {/&} x] $x 701} -result {0 hello} 702test regexpComp-16.3 {regsub -start} -body { 703 unset -nocomplain x 704 list [regsub -all -start 3 {z} hello {/&} x] $x 705} -result {0 hello} 706test regexpComp-16.4 {regsub -start, \A behavior} -body { 707 set out {} 708 lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x 709 lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x 710} -result {5 /a/b/c/d/e 3 ab/c/d/e} 711 712test regexpComp-17.1 {regexp -inline} -body { 713 regexp -inline b ababa 714} -result {b} 715test regexpComp-17.2 {regexp -inline} -body { 716 regexp -inline (b) ababa 717} -result {b b} 718test regexpComp-17.3 {regexp -inline -indices} { 719 regexp -inline -indices (b) ababa 720} {{1 1} {1 1}} 721test regexpComp-17.4 {regexp -inline} { 722 regexp -inline {\w(\d+)\w} " hello 23 there456def " 723} {e456d 456} 724test regexpComp-17.5 {regexp -inline no matches} { 725 regexp -inline {\w(\d+)\w} "" 726} {} 727test regexpComp-17.6 {regexp -inline no matches} { 728 regexp -inline hello goodbye 729} {} 730test regexpComp-17.7 {regexp -inline, no matchvars allowed} { 731 list [catch {regexp -inline b abc match} msg] $msg 732} {1 {regexp match variables not allowed when using -inline}} 733 734test regexpComp-18.1 {regexp -all} { 735 regexp -all b bbbbb 736} {5} 737test regexpComp-18.2 {regexp -all} { 738 regexp -all b abababbabaaaaaaaaaab 739} {6} 740test regexpComp-18.3 {regexp -all -inline} { 741 regexp -all -inline b abababbabaaaaaaaaaab 742} {b b b b b b} 743test regexpComp-18.4 {regexp -all -inline} { 744 regexp -all -inline {\w(\w)} abcdefg 745} {ab b cd d ef f} 746test regexpComp-18.5 {regexp -all -inline} { 747 regexp -all -inline {\w(\w)$} abcdefg 748} {fg g} 749test regexpComp-18.6 {regexp -all -inline} { 750 regexp -all -inline {\d+} 10:20:30:40 751} {10 20 30 40} 752test regexpComp-18.7 {regexp -all -inline} { 753 list [catch {regexp -all -inline b abc match} msg] $msg 754} {1 {regexp match variables not allowed when using -inline}} 755test regexpComp-18.8 {regexp -all} { 756 # This should not cause an infinite loop 757 regexp -all -inline {a*} a 758} {a} 759test regexpComp-18.9 {regexp -all} { 760 # Yes, the expected result is {a {}}. Here's why: 761 # Start at index 0; a* matches the "a" there then stops. 762 # Go to index 1; a* matches the lambda (or {}) there then stops. Recall 763 # that a* matches zero or more "a"'s; thus it matches the string "b", as 764 # there are zero or more "a"'s there. 765 # Go to index 2; this is past the end of the string, so stop. 766 regexp -all -inline {a*} ab 767} {a {}} 768test regexpComp-18.10 {regexp -all} { 769 # Yes, the expected result is {a {} a}. Here's why: 770 # Start at index 0; a* matches the "a" there then stops. 771 # Go to index 1; a* matches the lambda (or {}) there then stops. Recall 772 # that a* matches zero or more "a"'s; thus it matches the string "b", as 773 # there are zero or more "a"'s there. 774 # Go to index 2; a* matches the "a" there then stops. 775 # Go to index 3; this is past the end of the string, so stop. 776 regexp -all -inline {a*} aba 777} {a {} a} 778test regexpComp-18.11 {regexp -all} { 779 evalInProc { 780 regexp -all -inline {^a} aaaa 781 } 782} {a} 783test regexpComp-18.12 {regexp -all -inline -indices} { 784 evalInProc { 785 regexp -all -inline -indices a(b(c)d|e(f)g)h abcdhaefgh 786 } 787} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}} 788 789test regexpComp-19.1 {regsub null replacement} { 790 evalInProc { 791 regsub -all {@} {@hel@lo@} "\0a\0" result 792 list $result [string length $result] 793 } 794} "\0a\0hel\0a\0lo\0a\0 14" 795 796test regexpComp-20.1 {regsub shared object shimmering} nodep { 797 evalInProc { 798 # Bug #461322 799 set a abcdefghijklmnopqurstuvwxyz 800 set b $a 801 set c abcdefghijklmnopqurstuvwxyz0123456789 802 regsub $a $c $b d 803 list $d [string length $d] [string bytelength $d] 804 } 805} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] 806test regexpComp-20.2 {regsub shared object shimmering with -about} { 807 evalInProc { 808 eval regexp -about abc 809 } 810} {0 {}} 811 812test regexpComp-21.1 {regexp command compiling tests} { 813 evalInProc { 814 regexp foo bar 815 } 816} 0 817test regexpComp-21.2 {regexp command compiling tests} { 818 evalInProc { 819 regexp {^foo$} dogfood 820 } 821} 0 822test regexpComp-21.3 {regexp command compiling tests} { 823 evalInProc { 824 set a foo 825 regexp {^foo$} $a 826 } 827} 1 828test regexpComp-21.4 {regexp command compiling tests} { 829 evalInProc { 830 regexp foo dogfood 831 } 832} 1 833test regexpComp-21.5 {regexp command compiling tests} { 834 evalInProc { 835 regexp -nocase FOO dogfod 836 } 837} 0 838test regexpComp-21.6 {regexp command compiling tests} { 839 evalInProc { 840 regexp -n foo dogfoOd 841 } 842} 1 843test regexpComp-21.7 {regexp command compiling tests} { 844 evalInProc { 845 regexp -no -- FoO dogfood 846 } 847} 1 848test regexpComp-21.8 {regexp command compiling tests} { 849 evalInProc { 850 regexp -- foo dogfod 851 } 852} 0 853test regexpComp-21.9 {regexp command compiling tests} { 854 evalInProc { 855 list [catch {regexp -- -nocase foo dogfod} msg] $msg 856 } 857} {0 0} 858test regexpComp-21.10 {regexp command compiling tests} { 859 evalInProc { 860 list [regsub -all "" foo bar str] $str 861 } 862} {3 barfbarobaro} 863test regexpComp-21.11 {regexp command compiling tests} { 864 evalInProc { 865 list [regsub -all "" "" bar str] $str 866 } 867} {0 {}} 868 869test regexpComp-22.0.1 {Bug 1810038} { 870 evalInProc { 871 regexp ($|^X)* {} 872 } 873} 1 874 875test regexpComp-22.0.2 {regexp compile and backrefs, Bug 1857126} { 876 evalInProc { 877 regexp -- {([bc])\1} bb 878 } 879} 1 880 881set i 0 882foreach {str exp result} { 883 foo ^foo 1 884 foobar ^foobar$ 1 885 foobar bar$ 1 886 foobar ^$ 0 887 "" ^$ 1 888 anything $ 1 889 anything ^.*$ 1 890 anything ^.*a$ 0 891 anything ^.*a.*$ 1 892 anything ^.*.*$ 1 893 anything ^.*..*$ 1 894 anything ^.*b$ 0 895 anything ^a.*$ 1 896} { 897 test regexpComp-22.[incr i] {regexp command compiling tests} \ 898 [subst {evalInProc {set a "$str"; regexp {$exp} \$a}}] $result 899} 900 901set i 0 902foreach {str exp result} { 903 foo ^foo 1 904 foobar ^foobar$ 1 905 foobar bar$ 1 906 foobar ^$ 0 907 "" ^$ 1 908 anything $ 1 909 anything ^.*$ 1 910 anything ^.*a$ 0 911 anything ^.*a.*$ 1 912 anything ^.*.*$ 1 913 anything ^.*..*$ 1 914 anything ^.*b$ 0 915 anything ^a.*$ 1 916} { 917 test regexpComp-23.[incr i] {regexp command compiling tests INST_REGEXP} \ 918 [subst {evalInProc {set a "$str"; set re "$exp"; regexp \$re \$a}}] $result 919} 920 921test regexpComp-24.1 {regexp command compiling tests} { 922 evalInProc { 923 set re foo 924 regexp -nocase $re bar 925 } 926} 0 927test regexpComp-24.2 {regexp command compiling tests} { 928 evalInProc { 929 set re {^foo$} 930 regexp $re dogfood 931 } 932} 0 933test regexpComp-24.3 {regexp command compiling tests} { 934 evalInProc { 935 set a foo 936 set re {^foo$} 937 regexp $re $a 938 } 939} 1 940test regexpComp-24.4 {regexp command compiling tests} { 941 evalInProc { 942 set re foo 943 regexp $re dogfood 944 } 945} 1 946test regexpComp-24.5 {regexp command compiling tests} { 947 evalInProc { 948 set re FOO 949 regexp -nocase $re dogfod 950 } 951} 0 952test regexpComp-24.6 {regexp command compiling tests} { 953 evalInProc { 954 set re foo 955 regexp -n $re dogfoOd 956 } 957} 1 958test regexpComp-24.7 {regexp command compiling tests} { 959 evalInProc { 960 set re FoO 961 regexp -no -- $re dogfood 962 } 963} 1 964test regexpComp-24.8 {regexp command compiling tests} { 965 evalInProc { 966 set re foo 967 regexp -- $re dogfod 968 } 969} 0 970test regexpComp-24.9 {regexp command compiling tests} { 971 evalInProc { 972 set re "(" 973 list [catch {regexp -- $re dogfod} msg] $msg 974 } 975} {1 {couldn't compile regular expression pattern: parentheses () not balanced}} 976test regexpComp-24.10 {regexp command compiling tests} { 977 # Bug 1902436 - last * escaped 978 evalInProc { 979 set text {this is *bold* !} 980 set re {\*bold\*} 981 regexp -- $re $text 982 } 983} 1 984test regexpComp-24.11 {regexp command compiling tests} { 985 # Bug 1902436 - last * escaped 986 evalInProc { 987 set text {this is *bold* !} 988 set re {\*bold\*.*!} 989 regexp -- $re $text 990 } 991} 1 992 993# cleanup 994::tcltest::cleanupTests 995return 996 997# Local Variables: 998# mode: tcl 999# End: 1000