1# -*- tcl -*- 2# Tests for fileutil commands. 'test'. 3# 4# Sourcing this file into Tcl runs the tests and generates output for errors. 5# No output means no errors were found. 6# 7# Copyright (c) 1998-2000 by Ajuba Solutions. 8# Copyright (c) 2001 by ActiveState Tool Corp. 9# Copyright (c) 2005-2007 by Andreas Kupries <andreas_kupries@users.sourceforge.net> 10# All rights reserved. 11# 12# RCS: @(#) $Id: test.test,v 1.1 2007/08/03 23:07:25 andreas_kupries Exp $ 13 14# ------------------------------------------------------------------------- 15 16source [file join \ 17 [file dirname [file dirname [file join [pwd] [info script]]]] \ 18 devtools testutilities.tcl] 19 20testsNeedTcl 8.2 21testsNeedTcltest 1.0 22 23testing { 24 useLocal fileutil.tcl fileutil 25} 26 27# ------------------------------------------------------------------------- 28# In 8.3+ we can use symbolic permissions, i.e. strings like u+r, or 29# ugo-r when invoking 'file attributes'. This feature is however not 30# available in Tcl 8.2, the lowest revision supported by the 31# package. So we make do without them and use absolute permissions 32# instead. 33 34# 644 = -rw-r--r-- 35# 700 = -rwx------ 36# 600 = -rw------- 37# 500 = -r-x------ 38# 300 = --wx------ 39 40# ------------------------------------------------------------------------- 41 42set xpath [makeFile {} x] ; removeFile x 43 44# ------------------------------------------------------------------------- 45 46proc makewritable {path enable} { 47 global tcl_platform 48 if {[string equal $tcl_platform(platform) windows]} { 49 set ro [expr {!$enable}] 50 file attributes $path -readonly $ro 51 } else { 52 set mode [expr {$enable ? "700" : "500"}] 53 file attributes $path -permissions 00$mode 54 } 55 return 56} 57 58proc makereadable {path enable} { 59 global tcl_platform 60 if {[string equal $tcl_platform(platform) windows]} { 61 return -code error "Can't do that on Windows" 62 } else { 63 set mode [expr {$enable ? "700" : "300"}] 64 file attributes $path -permissions 00$mode 65 } 66 return 67} 68 69proc makeexecutable {path enable} { 70 global tcl_platform 71 if {[string equal $tcl_platform(platform) windows]} { 72 return -code error "Can't do that on Windows" 73 } else { 74 set mode [expr {$enable ? "700" : "600"}] 75 file attributes $path -permissions 00$mode 76 } 77 return 78} 79 80# ------------------------------------------------------------------------- 81 82test test-1.0.0 {test read} {unixOnly} { 83 set path [makeFile {} x] 84 makereadable $path 1 85 86 set x PRE 87 set res [list [fileutil::test $path read x TEST] $x] 88 removeFile x 89 set res 90} {1 PRE} 91 92test test-1.0.1 {test read, no variable} {unixOnly} { 93 set path [makeFile {} x] 94 makereadable $path 1 95 96 set x PRE 97 set res [list [fileutil::test $path read] $x] 98 removeFile x 99 set res 100} {1 PRE} 101 102test test-1.0.2 {test !read} {unixOnly notRoot} { 103 set path [makeFile {} x] 104 makereadable $path 0 105 106 set x PRE 107 set res [list [fileutil::test $path read x TEST] $x] 108 removeFile x 109 set res 110} [list 0 "TEST \"$xpath\": Read access is denied"] 111 112test test-1.0.3 {test !read, no variable} {unixOnly notRoot} { 113 set path [makeFile {} x] 114 makereadable $path 0 115 116 set x PRE 117 set res [list [fileutil::test $path read] $x] 118 removeFile x 119 set res 120} {0 PRE} 121 122test test-1.0.4 {test !read, no label} {unixOnly notRead} { 123 set path [makeFile {} x] 124 makereadable $path 0 125 126 set x PRE 127 set res [list [fileutil::test $path read x] $x] 128 removeFile x 129 set res 130} [list 0 "\"$xpath\": Read access is denied"] 131 132test test-2.0.0 {test write} { 133 set path [makeFile {} x] 134 makewritable $path 1 135 136 set x PRE 137 set res [list [fileutil::test $path write x TEST] $x] 138 removeFile x 139 set res 140} {1 PRE} 141 142test test-2.0.1 {test write, no variable} { 143 set path [makeFile {} x] 144 makewritable $path 1 145 146 set x PRE 147 set res [list [fileutil::test $path write] $x] 148 removeFile x 149 set res 150} {1 PRE} 151 152test test-2.0.2 {test !write} notRoot { 153 set path [makeFile {} x] 154 makewritable $path 0 155 156 set x PRE 157 set res [list [fileutil::test $path write x TEST] $x] 158 removeFile x 159 set res 160} [list 0 "TEST \"$xpath\": Write access is denied"] 161 162test test-2.0.3 {test !write, no variable} notRoot { 163 set path [makeFile {} x] 164 makewritable $path 0 165 166 set x PRE 167 set res [list [fileutil::test $path write] $x] 168 removeFile x 169 set res 170} {0 PRE} 171 172test test-2.0.4 {test !write, no label} notRoot { 173 set path [makeFile {} x] 174 makewritable $path 0 175 176 set x PRE 177 set res [list [fileutil::test $path write x] $x] 178 removeFile x 179 set res 180} [list 0 "\"$xpath\": Write access is denied"] 181 182test test-3.0.0 {test exists} { 183 set path [makeFile {} x] 184 185 set x PRE 186 set res [list [fileutil::test $path exists x TEST] $x] 187 removeFile x 188 set res 189} {1 PRE} 190 191test test-3.0.1 {test exists, no variable} { 192 set path [makeFile {} x] 193 194 set x PRE 195 set res [list [fileutil::test $path exists] $x] 196 removeFile x 197 set res 198} {1 PRE} 199 200test test-3.0.2 {test !exists} { 201 set path [makeFile {} x] 202 removeFile x 203 204 set x PRE 205 set res [list [fileutil::test $path exists x TEST] $x] 206 set res 207} [list 0 "TEST \"$xpath\": Does not exist"] 208 209test test-3.0.3 {test !exists, no variable} { 210 set path [makeFile {} x] 211 removeFile x 212 213 set x PRE 214 set res [list [fileutil::test $path exists] $x] 215 set res 216} {0 PRE} 217 218test test-3.0.4 {test !exists, no label} { 219 set path [makeFile {} x] 220 removeFile x 221 222 set x PRE 223 set res [list [fileutil::test $path exists x] $x] 224 set res 225} [list 0 "\"$xpath\": Does not exist"] 226 227test test-4.0.0 {test file} { 228 set path [makeFile {} x] 229 230 set x PRE 231 set res [list [fileutil::test $path file x TEST] $x] 232 removeFile x 233 set res 234} {1 PRE} 235 236test test-4.0.1 {test file, no variable} { 237 set path [makeFile {} x] 238 239 set x PRE 240 set res [list [fileutil::test $path file] $x] 241 removeFile x 242 set res 243} {1 PRE} 244 245test test-4.0.2 {test !file} { 246 set path [makeDirectory x] 247 248 set x PRE 249 set res [list [fileutil::test $path file x TEST] $x] 250 removeDirectory x 251 set res 252} [list 0 "TEST \"$xpath\": Is not a file"] 253 254test test-4.0.3 {test !file, no variable} { 255 set path [makeDirectory x] 256 257 set x PRE 258 set res [list [fileutil::test $path file] $x] 259 removeDirectory x 260 set res 261} {0 PRE} 262 263test test-4.0.4 {test !file, no label} { 264 set path [makeDirectory x] 265 266 set x PRE 267 set res [list [fileutil::test $path file x] $x] 268 removeDirectory x 269 set res 270} [list 0 "\"$xpath\": Is not a file"] 271 272test test-5.0.0 {test dir} { 273 set path [makeDirectory x] 274 275 set x PRE 276 set res [list [fileutil::test $path dir x TEST] $x] 277 removeDirectory x 278 set res 279} {1 PRE} 280 281test test-5.0.1 {test dir, no variable} { 282 set path [makeDirectory x] 283 284 set x PRE 285 set res [list [fileutil::test $path dir] $x] 286 removeDirectory x 287 set res 288} {1 PRE} 289 290test test-5.0.2 {test !dir} { 291 set path [makeFile {} x] 292 293 set x PRE 294 set res [list [fileutil::test $path dir x TEST] $x] 295 removeFile x 296 set res 297} [list 0 "TEST \"$xpath\": Is not a directory"] 298 299test test-5.0.3 {test !dir, no variable} { 300 set path [makeFile {} x] 301 302 set x PRE 303 set res [list [fileutil::test $path dir] $x] 304 removeFile x 305 set res 306} {0 PRE} 307 308test test-5.0.4 {test !dir, no label} { 309 set path [makeFile {} x] 310 311 set x PRE 312 set res [list [fileutil::test $path dir x] $x] 313 removeFile x 314 set res 315} [list 0 "\"$xpath\": Is not a directory"] 316 317test test-6.0.0 {test exec} {unixOnly} { 318 set path [makeFile {} x] 319 makeexecutable $path 1 320 321 set x PRE 322 set res [list [fileutil::test $path exec x TEST] $x] 323 removeFile x 324 set res 325} {1 PRE} 326 327test test-6.0.1 {test exec, no variable} {unixOnly} { 328 set path [makeFile {} x] 329 makeexecutable $path 1 330 331 set x PRE 332 set res [list [fileutil::test $path exec] $x] 333 removeFile x 334 set res 335} {1 PRE} 336 337test test-6.0.2 {test !exec} {unixOnly} { 338 set path [makeFile {} x] 339 makeexecutable $path 0 340 341 set x PRE 342 set res [list [fileutil::test $path exec x TEST] $x] 343 removeFile x 344 set res 345} [list 0 "TEST \"$xpath\": Is not executable"] 346 347test test-6.0.3 {test !exec, no variable} {unixOnly} { 348 set path [makeFile {} x] 349 makeexecutable $path 0 350 351 set x PRE 352 set res [list [fileutil::test $path exec] $x] 353 removeFile x 354 set res 355} {0 PRE} 356 357test test-6.0.4 {test !exec, no label} {unixOnly} { 358 set path [makeFile {} x] 359 makeexecutable $path 0 360 361 set x PRE 362 set res [list [fileutil::test $path exec x] $x] 363 removeFile x 364 set res 365} [list 0 "\"$xpath\": Is not executable"] 366 367 368 369test test-1.1.0 {test read} {unixOnly} { 370 set path [makeFile {} x] 371 makereadable $path 1 372 373 set x PRE 374 set res [list [fileutil::test $path r x TEST] $x] 375 removeFile x 376 set res 377} {1 PRE} 378 379test test-1.1.1 {test read, no variable} {unixOnly} { 380 set path [makeFile {} x] 381 makereadable $path 1 382 383 set x PRE 384 set res [list [fileutil::test $path r] $x] 385 removeFile x 386 set res 387} {1 PRE} 388 389test test-1.1.2 {test !read} {unixOnly notRoot} { 390 set path [makeFile {} x] 391 makereadable $path 0 392 393 set x PRE 394 set res [list [fileutil::test $path r x TEST] $x] 395 removeFile x 396 set res 397} [list 0 "TEST \"$xpath\": Read access is denied"] 398 399test test-1.1.3 {test !read, no variable} {unixOnly notRoot} { 400 set path [makeFile {} x] 401 makereadable $path 0 402 403 set x PRE 404 set res [list [fileutil::test $path r] $x] 405 removeFile x 406 set res 407} {0 PRE} 408 409test test-1.1.4 {test !read, no label} {unixOnly notRoot} { 410 set path [makeFile {} x] 411 makereadable $path 0 412 413 set x PRE 414 set res [list [fileutil::test $path r x] $x] 415 removeFile x 416 set res 417} [list 0 "\"$xpath\": Read access is denied"] 418 419test test-2.1.0 {test write} { 420 set path [makeFile {} x] 421 makewritable $path 1 422 423 set x PRE 424 set res [list [fileutil::test $path w x TEST] $x] 425 removeFile x 426 set res 427} {1 PRE} 428 429test test-2.1.1 {test write, no variable} { 430 set path [makeFile {} x] 431 makewritable $path 1 432 433 set x PRE 434 set res [list [fileutil::test $path w] $x] 435 removeFile x 436 set res 437} {1 PRE} 438 439test test-2.1.2 {test !write} notRoot { 440 set path [makeFile {} x] 441 makewritable $path 0 442 443 set x PRE 444 set res [list [fileutil::test $path w x TEST] $x] 445 removeFile x 446 set res 447} [list 0 "TEST \"$xpath\": Write access is denied"] 448 449test test-2.1.3 {test !write, no variable} notRoot { 450 set path [makeFile {} x] 451 makewritable $path 0 452 453 set x PRE 454 set res [list [fileutil::test $path w] $x] 455 removeFile x 456 set res 457} {0 PRE} 458 459test test-2.1.4 {test !write, no label} notRoot { 460 set path [makeFile {} x] 461 makewritable $path 0 462 463 set x PRE 464 set res [list [fileutil::test $path w x] $x] 465 removeFile x 466 set res 467} [list 0 "\"$xpath\": Write access is denied"] 468 469test test-3.1.0 {test exists} { 470 set path [makeFile {} x] 471 472 set x PRE 473 set res [list [fileutil::test $path e x TEST] $x] 474 removeFile x 475 set res 476} {1 PRE} 477 478test test-3.1.1 {test exists, no variable} { 479 set path [makeFile {} x] 480 481 set x PRE 482 set res [list [fileutil::test $path e] $x] 483 removeFile x 484 set res 485} {1 PRE} 486 487test test-3.1.2 {test !exists} { 488 set path [makeFile {} x] 489 removeFile x 490 491 set x PRE 492 set res [list [fileutil::test $path e x TEST] $x] 493 set res 494} [list 0 "TEST \"$xpath\": Does not exist"] 495 496test test-3.1.3 {test !exists, no variable} { 497 set path [makeFile {} x] 498 removeFile x 499 500 set x PRE 501 set res [list [fileutil::test $path e] $x] 502 set res 503} {0 PRE} 504 505test test-3.1.4 {test !exists, no label} { 506 set path [makeFile {} x] 507 removeFile x 508 509 set x PRE 510 set res [list [fileutil::test $path e x] $x] 511 set res 512} [list 0 "\"$xpath\": Does not exist"] 513 514test test-4.1.0 {test file} { 515 set path [makeFile {} x] 516 517 set x PRE 518 set res [list [fileutil::test $path f x TEST] $x] 519 removeFile x 520 set res 521} {1 PRE} 522 523test test-4.1.1 {test file, no variable} { 524 set path [makeFile {} x] 525 526 set x PRE 527 set res [list [fileutil::test $path f] $x] 528 removeFile x 529 set res 530} {1 PRE} 531 532test test-4.1.2 {test !file} { 533 set path [makeDirectory x] 534 535 set x PRE 536 set res [list [fileutil::test $path f x TEST] $x] 537 removeDirectory x 538 set res 539} [list 0 "TEST \"$xpath\": Is not a file"] 540 541test test-4.1.3 {test !file, no variable} { 542 set path [makeDirectory x] 543 544 set x PRE 545 set res [list [fileutil::test $path f] $x] 546 removeDirectory x 547 set res 548} {0 PRE} 549 550test test-4.1.4 {test !file, no label} { 551 set path [makeDirectory x] 552 553 set x PRE 554 set res [list [fileutil::test $path f x] $x] 555 removeDirectory x 556 set res 557} [list 0 "\"$xpath\": Is not a file"] 558 559test test-5.1.0 {test dir} { 560 set path [makeDirectory x] 561 562 set x PRE 563 set res [list [fileutil::test $path d x TEST] $x] 564 removeDirectory x 565 set res 566} {1 PRE} 567 568test test-5.1.1 {test dir, no variable} { 569 set path [makeDirectory x] 570 571 set x PRE 572 set res [list [fileutil::test $path d] $x] 573 removeDirectory x 574 set res 575} {1 PRE} 576 577test test-5.1.2 {test !dir} { 578 set path [makeFile {} x] 579 580 set x PRE 581 set res [list [fileutil::test $path d x TEST] $x] 582 removeFile x 583 set res 584} [list 0 "TEST \"$xpath\": Is not a directory"] 585 586test test-5.1.3 {test !dir, no variable} { 587 set path [makeFile {} x] 588 589 set x PRE 590 set res [list [fileutil::test $path d] $x] 591 removeFile x 592 set res 593} {0 PRE} 594 595test test-5.1.4 {test !dir, no label} { 596 set path [makeFile {} x] 597 598 set x PRE 599 set res [list [fileutil::test $path d x] $x] 600 removeFile x 601 set res 602} [list 0 "\"$xpath\": Is not a directory"] 603 604test test-6.1.0 {test exec} {unixOnly} { 605 set path [makeFile {} x] 606 makeexecutable $path 1 607 608 set x PRE 609 set res [list [fileutil::test $path x x TEST] $x] 610 removeFile x 611 set res 612} {1 PRE} 613 614test test-6.1.1 {test exec, no variable} {unixOnly} { 615 set path [makeFile {} x] 616 makeexecutable $path 1 617 618 set x PRE 619 set res [list [fileutil::test $path x] $x] 620 removeFile x 621 set res 622} {1 PRE} 623 624test test-6.1.2 {test !exec} {unixOnly} { 625 set path [makeFile {} x] 626 makeexecutable $path 0 627 628 set x PRE 629 set res [list [fileutil::test $path x x TEST] $x] 630 removeFile x 631 set res 632} [list 0 "TEST \"$xpath\": Is not executable"] 633 634test test-6.1.3 {test !exec, no variable} {unixOnly} { 635 set path [makeFile {} x] 636 makeexecutable $path 0 637 638 set x PRE 639 set res [list [fileutil::test $path x] $x] 640 removeFile x 641 set res 642} {0 PRE} 643 644test test-6.1.4 {test !exec, no label} {unixOnly} { 645 set path [makeFile {} x] 646 makeexecutable $path 0 647 648 set x PRE 649 set res [list [fileutil::test $path x x] $x] 650 removeFile x 651 set res 652} [list 0 "\"$xpath\": Is not executable"] 653 654# ------------------------------------------------------------------------- 655 656rename makewritable {} 657rename makereadable {} 658rename makeexecutable {} 659unset xpath 660unset path 661unset res 662unset x 663 664testsuiteCleanup 665return 666