1# Commands covered: none 2# 3# This file contains a collection of tests for Tcl's dynamic string library 4# procedures. Sourcing this file into Tcl runs the tests and generates output 5# for errors. No output means no errors were found. 6# 7# Copyright © 1993 The Regents of the University of California. 8# Copyright © 1994 Sun Microsystems, Inc. 9# Copyright © 1998-1999 Scriptics Corporation. 10# 11# See the file "license.terms" for information on usage and redistribution of 12# 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 19::tcltest::loadTestedCommands 20catch [list package require -exact tcl::test [info patchlevel]] 21 22testConstraint testdstring [llength [info commands testdstring]] 23if {[testConstraint testdstring]} { 24 testdstring free 25} 26 27test dstring-1.1 {appending and retrieving} -constraints testdstring -setup { 28 testdstring free 29} -body { 30 testdstring append "abc" -1 31 list [testdstring get] [testdstring length] 32} -cleanup { 33 testdstring free 34} -result {abc 3} 35test dstring-1.2 {appending and retrieving} -constraints testdstring -setup { 36 testdstring free 37} -body { 38 testdstring append "abc" -1 39 testdstring append " xyzzy" 3 40 testdstring append " 12345" -1 41 list [testdstring get] [testdstring length] 42} -cleanup { 43 testdstring free 44} -result {{abc xy 12345} 12} 45test dstring-1.3 {appending and retrieving} -constraints testdstring -setup { 46 testdstring free 47} -body { 48 foreach l {a b c d e f g h i j k l m n o p} { 49 testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 50 } 51 list [testdstring get] [testdstring length] 52} -cleanup { 53 testdstring free 54} -result {{aaaaaaaaaaaaaaaaaaaaa 55bbbbbbbbbbbbbbbbbbbbb 56ccccccccccccccccccccc 57ddddddddddddddddddddd 58eeeeeeeeeeeeeeeeeeeee 59fffffffffffffffffffff 60ggggggggggggggggggggg 61hhhhhhhhhhhhhhhhhhhhh 62iiiiiiiiiiiiiiiiiiiii 63jjjjjjjjjjjjjjjjjjjjj 64kkkkkkkkkkkkkkkkkkkkk 65lllllllllllllllllllll 66mmmmmmmmmmmmmmmmmmmmm 67nnnnnnnnnnnnnnnnnnnnn 68ooooooooooooooooooooo 69ppppppppppppppppppppp 70} 352} 71 72test dstring-2.1 {appending list elements} -constraints testdstring -setup { 73 testdstring free 74} -body { 75 testdstring element "abc" 76 testdstring element "d e f" 77 list [testdstring get] [testdstring length] 78} -cleanup { 79 testdstring free 80} -result {{abc {d e f}} 11} 81test dstring-2.2 {appending list elements} -constraints testdstring -setup { 82 testdstring free 83} -body { 84 testdstring element "x" 85 testdstring element "\{" 86 testdstring element "ab\}" 87 testdstring get 88} -cleanup { 89 testdstring free 90} -result {x \{ ab\}} 91test dstring-2.3 {appending list elements} -constraints testdstring -setup { 92 testdstring free 93} -body { 94 foreach l {a b c d e f g h i j k l m n o p} { 95 testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l 96 } 97 testdstring get 98} -cleanup { 99 testdstring free 100} -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp} 101test dstring-2.4 {appending list elements} -constraints testdstring -setup { 102 testdstring free 103} -body { 104 testdstring append "a\{" -1 105 testdstring element abc 106 testdstring append " \{" -1 107 testdstring element xyzzy 108 testdstring get 109} -cleanup { 110 testdstring free 111} -result "a{ abc {xyzzy" 112test dstring-2.5 {appending list elements} -constraints testdstring -setup { 113 testdstring free 114} -body { 115 testdstring append " \{" -1 116 testdstring element abc 117 testdstring get 118} -cleanup { 119 testdstring free 120} -result " {abc" 121test dstring-2.6 {appending list elements} -constraints testdstring -setup { 122 testdstring free 123} -body { 124 testdstring append " " -1 125 testdstring element abc 126 testdstring get 127} -cleanup { 128 testdstring free 129} -result { abc} 130test dstring-2.7 {appending list elements} -constraints testdstring -setup { 131 testdstring free 132} -body { 133 testdstring append "\\ " -1 134 testdstring element abc 135 testdstring get 136} -cleanup { 137 testdstring free 138} -result "\\ abc" 139test dstring-2.8 {appending list elements} -constraints testdstring -setup { 140 testdstring free 141} -body { 142 testdstring append "x " -1 143 testdstring element abc 144 testdstring get 145} -cleanup { 146 testdstring free 147} -result {x abc} 148test dstring-2.9 {appending list elements} -constraints testdstring -setup { 149 testdstring free 150} -body { 151 testdstring element # 152 testdstring get 153} -cleanup { 154 testdstring free 155} -result {{#}} 156test dstring-2.10 {appending list elements} -constraints testdstring -setup { 157 testdstring free 158} -body { 159 testdstring append " " -1 160 testdstring element # 161 testdstring get 162} -cleanup { 163 testdstring free 164} -result { {#}} 165test dstring-2.11 {appending list elements} -constraints testdstring -setup { 166 testdstring free 167} -body { 168 testdstring append \t -1 169 testdstring element # 170 testdstring get 171} -cleanup { 172 testdstring free 173} -result \t{#} 174test dstring-2.12 {appending list elements} -constraints testdstring -setup { 175 testdstring free 176} -body { 177 testdstring append x -1 178 testdstring element # 179 testdstring get 180} -cleanup { 181 testdstring free 182} -result {x #} 183test dstring-2.13 {appending list elements} -constraints testdstring -setup { 184 testdstring free 185} -body { 186 # This test checks the sophistication in Tcl_DStringAppendElement's 187 # decision about whether #-quoting can be disabled. 188 testdstring append "x " -1 189 testdstring element # 190 testdstring get 191} -cleanup { 192 testdstring free 193} -result {x #} 194test dstring-2.14 {appending list elements} -constraints testdstring -setup { 195 testdstring free 196} -body { 197 testdstring append " " -1 198 testdstring element # 199 testdstring get 200} -cleanup { 201 testdstring free 202} -result { {#}} 203test dstring-2.15 {appending list elements} -constraints testdstring -setup { 204 testdstring free 205} -body { 206 # This test checks the sophistication in Tcl_DStringAppendElement's 207 # decision about whether #-quoting can be disabled. 208 testdstring append "x " -1 209 testdstring element # 210 testdstring get 211} -cleanup { 212 testdstring free 213} -result {x #} 214 215test dstring-3.1 {nested sublists} -constraints testdstring -setup { 216 testdstring free 217} -body { 218 testdstring start 219 testdstring element foo 220 testdstring element bar 221 testdstring end 222 testdstring element another 223 testdstring get 224} -cleanup { 225 testdstring free 226} -result {{foo bar} another} 227test dstring-3.2 {nested sublists} -constraints testdstring -setup { 228 testdstring free 229} -body { 230 testdstring start 231 testdstring start 232 testdstring element abc 233 testdstring element def 234 testdstring end 235 testdstring end 236 testdstring element ghi 237 testdstring get 238} -cleanup { 239 testdstring free 240} -result {{{abc def}} ghi} 241test dstring-3.3 {nested sublists} -constraints testdstring -setup { 242 testdstring free 243} -body { 244 testdstring start 245 testdstring start 246 testdstring start 247 testdstring element foo 248 testdstring element foo2 249 testdstring end 250 testdstring end 251 testdstring element foo3 252 testdstring end 253 testdstring element foo4 254 testdstring get 255} -cleanup { 256 testdstring free 257} -result {{{{foo foo2}} foo3} foo4} 258test dstring-3.4 {nested sublists} -constraints testdstring -setup { 259 testdstring free 260} -body { 261 testdstring element before 262 testdstring start 263 testdstring element during 264 testdstring element more 265 testdstring end 266 testdstring element last 267 testdstring get 268} -cleanup { 269 testdstring free 270} -result {before {during more} last} 271test dstring-3.5 {nested sublists} -constraints testdstring -setup { 272 testdstring free 273} -body { 274 testdstring element "\{" 275 testdstring start 276 testdstring element first 277 testdstring element second 278 testdstring end 279 testdstring get 280} -cleanup { 281 testdstring free 282} -result {\{ {first second}} 283test dstring-3.6 {appending list elements} -constraints testdstring -setup { 284 testdstring free 285} -body { 286 testdstring append x -1 287 testdstring start 288 testdstring element # 289 testdstring end 290 testdstring get 291} -cleanup { 292 testdstring free 293} -result {x {{#}}} 294test dstring-3.7 {appending list elements} -constraints testdstring -setup { 295 testdstring free 296} -body { 297 testdstring append x -1 298 testdstring start 299 testdstring append " " -1 300 testdstring element # 301 testdstring end 302 testdstring get 303} -cleanup { 304 testdstring free 305} -result {x { {#}}} 306test dstring-3.8 {appending list elements} -constraints testdstring -setup { 307 testdstring free 308} -body { 309 testdstring append x -1 310 testdstring start 311 testdstring append \t -1 312 testdstring element # 313 testdstring end 314 testdstring get 315} -cleanup { 316 testdstring free 317} -result "x {\t{#}}" 318test dstring-3.9 {appending list elements} -constraints testdstring -setup { 319 testdstring free 320} -body { 321 testdstring append x -1 322 testdstring start 323 testdstring append x -1 324 testdstring element # 325 testdstring end 326 testdstring get 327} -cleanup { 328 testdstring free 329} -result {x {x #}} 330test dstring-3.10 {appending list elements} -constraints testdstring -setup { 331 testdstring free 332} -body { 333 # This test checks the sophistication in Tcl_DStringAppendElement's 334 # decision about whether #-quoting can be disabled. 335 testdstring append x -1 336 testdstring start 337 testdstring append "x " -1 338 testdstring element # 339 testdstring end 340 testdstring get 341} -cleanup { 342 testdstring free 343} -result {x {x #}} 344test dstring-3.11 {appending list elements} -constraints testdstring -setup { 345 testdstring free 346} -body { 347 testdstring append x -1 348 testdstring start 349 testdstring append " " -1 350 testdstring element # 351 testdstring end 352 testdstring get 353} -cleanup { 354 testdstring free 355} -result {x { {#}}} 356test dstring-3.12 {appending list elements} -constraints testdstring -setup { 357 testdstring free 358} -body { 359 # This test checks the sophistication in Tcl_DStringAppendElement's 360 # decision about whether #-quoting can be disabled. 361 testdstring append x -1 362 testdstring start 363 testdstring append "x " -1 364 testdstring element # 365 testdstring end 366 testdstring get 367} -cleanup { 368 testdstring free 369} -result {x {x #}} 370 371test dstring-4.1 {truncation} -constraints testdstring -setup { 372 testdstring free 373} -body { 374 testdstring append "abcdefg" -1 375 testdstring trunc 3 376 list [testdstring get] [testdstring length] 377} -cleanup { 378 testdstring free 379} -result {abc 3} 380test dstring-4.2 {truncation} -constraints testdstring -setup { 381 testdstring free 382} -body { 383 testdstring append "xyzzy" -1 384 testdstring trunc 0 385 list [testdstring get] [testdstring length] 386} -cleanup { 387 testdstring free 388} -result {{} 0} 389 390test dstring-5.1 {copying to result} -constraints testdstring -setup { 391 testdstring free 392} -body { 393 testdstring append xyz -1 394 testdstring result 395} -cleanup { 396 testdstring free 397} -result xyz 398test dstring-5.2 {copying to result} -constraints testdstring -setup { 399 testdstring free 400 unset -nocomplain a 401} -body { 402 foreach l {a b c d e f g h i j k l m n o p} { 403 testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 404 } 405 set a [testdstring result] 406 testdstring append abc -1 407 list $a [testdstring get] 408} -cleanup { 409 testdstring free 410} -result {{aaaaaaaaaaaaaaaaaaaaa 411bbbbbbbbbbbbbbbbbbbbb 412ccccccccccccccccccccc 413ddddddddddddddddddddd 414eeeeeeeeeeeeeeeeeeeee 415fffffffffffffffffffff 416ggggggggggggggggggggg 417hhhhhhhhhhhhhhhhhhhhh 418iiiiiiiiiiiiiiiiiiiii 419jjjjjjjjjjjjjjjjjjjjj 420kkkkkkkkkkkkkkkkkkkkk 421lllllllllllllllllllll 422mmmmmmmmmmmmmmmmmmmmm 423nnnnnnnnnnnnnnnnnnnnn 424ooooooooooooooooooooo 425ppppppppppppppppppppp 426} abc} 427 428test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup { 429 testdstring free 430} -body { 431 list [testdstring gresult staticsmall] [testdstring get] 432} -cleanup { 433 testdstring free 434} -result {{} short} 435test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup { 436 testdstring free 437} -body { 438 foreach l {a b c d e f g h i j k l m n o p} { 439 testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1 440 } 441 list [testdstring gresult staticsmall] [testdstring get] 442} -cleanup { 443 testdstring free 444} -result {{} short} 445test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body { 446 set result {} 447 lappend result [testdstring gresult staticlarge] 448 testdstring append x 1 449 lappend result [testdstring get] 450} -cleanup { 451 testdstring free 452} -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9 453second0 second1 second2 second3 second4 second5 second6 second7 second8 second9 454third0 third1 third2 third3 third4 third5 third6 third7 third8 third9 455fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9 456fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9 457sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9 458seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9 459x}} 460test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body { 461 set result {} 462 lappend result [testdstring gresult free] 463 testdstring append y 1 464 lappend result [testdstring get] 465} -cleanup { 466 testdstring free 467} -result {{} {This is a malloc-ed stringy}} 468test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body { 469 set result {} 470 lappend result [testdstring gresult special] 471 testdstring append z 1 472 lappend result [testdstring get] 473} -cleanup { 474 testdstring free 475} -result {{} {This is a specially-allocated stringz}} 476 477# cleanup 478if {[testConstraint testdstring]} { 479 testdstring free 480} 481::tcltest::cleanupTests 482return 483 484# Local Variables: 485# mode: tcl 486# fill-column: 78 487# End: 488