Return to parse.test CVS log

Up to [Research Unix] / researchv10no / cmd / worm / scsi / tcl / tests

Annotation of researchv10no/cmd/worm/scsi/tcl/tests/parse.test, revision 1.1

1.1     ! root        1: # This file contains contains a collection of tests for the basic
        !             2: # command-parsing mechanisms of Tcl (such as how braces and brackets
        !             3: # and variable substitutions are handled)..  If everything is OK
        !             4: # then it finishes silently.  If a problem is detected then it
        !             5: # generates a Tcl error with a cryptic message.  To trace the error
        !             6: # you'll have to read through the commands in this file.
        !             7: #
        !             8: # $Header: /sprite/src/lib/tcl/tests/RCS/parse.test,v 1.1 90/03/21 13:27:48 ouster Exp $ (Berkeley)
        !             9: 
        !            10: proc check {a b num} {
        !            11:     if {[string compare $a $b] != 0} {
        !            12:        error [format {Parse error %s: wanted "%s", got "%s"} $num $b $a]}
        !            13: }
        !            14: 
        !            15: proc fourArgs {a b c d} {
        !            16:     global arg1 arg2 arg3 arg4
        !            17:     set arg1 $a
        !            18:     set arg2 $b
        !            19:     set arg3 $c
        !            20:     set arg4 $d
        !            21: }
        !            22: 
        !            23: proc getArgs args {
        !            24:     global argv
        !            25:     set argv $args
        !            26: }
        !            27: 
        !            28: # Basic argument parsing.
        !            29: 
        !            30: fourArgs a b   c                d
        !            31: check $arg1 a 1.1
        !            32: check $arg2 b 1.2
        !            33: check $arg3 c 1.3
        !            34: check $arg4 d 1.4
        !            35: 
        !            36: # Quotes.
        !            37: 
        !            38: getArgs "a b c" d
        !            39: check $argv {{a b c} d} 2.1
        !            40: set a 101
        !            41: getArgs "a$a b c"
        !            42: check $argv {{a101 b c}} 2.2
        !            43: set argv "xy[format xabc]"
        !            44: check $argv {xyxabc} 2.3
        !            45: set argv "xy\t"
        !            46: check $argv xy\t 2.4
        !            47: set argv "a b  c
        !            48: d e f"
        !            49: check $argv a\ b\tc\nd\ e\ f 2.5
        !            50: set argv a"bcd"e
        !            51: check $argv {a"bcd"e} 2.6
        !            52: 
        !            53: # Braces.
        !            54: 
        !            55: getArgs {a b c} d
        !            56: check $argv "{a b c} d" 3.1
        !            57: set a 101
        !            58: set argv {a$a b c}
        !            59: set b [index $argv 1 chars]
        !            60: check $b {$} 3.2
        !            61: set argv {a[format xyz] b}
        !            62: check [length $argv chars] 15 3.3
        !            63: set argv {a\nb\}}
        !            64: check [length $argv chars] 6 3.4
        !            65: set argv {{{{}}}}
        !            66: check $argv "{{{}}}" 3.5
        !            67: set argv a{{}}b
        !            68: check $argv "a{{}}b" 3.6
        !            69: 
        !            70: # Command substitution.
        !            71: 
        !            72: set a [format xyz]
        !            73: check $a xyz 4.1
        !            74: set a a[format xyz]b[format q]
        !            75: check $a axyzbq 4.2
        !            76: set a a[
        !            77: format
        !            78: xyz
        !            79: ]b
        !            80: check $a axyzb 4.3
        !            81: 
        !            82: # Variable substitution.
        !            83: 
        !            84: set a 123
        !            85: set _123z xx
        !            86: check $a 123 5.1
        !            87: check x$a.b x123.b 5.2
        !            88: check $_123z^ xx^ 5.3
        !            89: check a${a}b a123b 5.4
        !            90: check [catch {$_non_existent_} msg] 1 5.5
        !            91: check $msg {couldn't find variable "_non_existent_"} 5.6
        !            92: 
        !            93: # Backslash substitution.
        !            94: 
        !            95: proc bsCheck {char num errNum} {
        !            96:     scan $char %c value
        !            97:     if {$value != $num} {
        !            98:        error [format {History error %s: wanted "%s", got "%s"}
        !            99:                $errNum $num $value]
        !           100:     }
        !           101: }
        !           102: 
        !           103: bsCheck \b     0x8     6.1
        !           104: bsCheck \e     0x1b    6.2
        !           105: bsCheck \n     0xa     6.3
        !           106: bsCheck \r     0xd     6.4
        !           107: bsCheck \t     0x9     6.5
        !           108: bsCheck \{     0x7b    6.6
        !           109: bsCheck \}     0x7d    6.7
        !           110: bsCheck \[     0x5b    6.8
        !           111: bsCheck \]     0x5d    6.9
        !           112: bsCheck \$     0x24    6.10
        !           113: bsCheck \      0x20    6.11
        !           114: bsCheck \;     0x3b    6.12
        !           115: bsCheck \\     0x5c    6.13
        !           116: bsCheck \Ca    0x1     6.14
        !           117: bsCheck \Ma    0xe1    6.15
        !           118: bsCheck \CMa   0x81    6.16
        !           119: bsCheck \14    0xc     6.17
        !           120: bsCheck \x     0x5c    6.18
        !           121: set a "\a\c\n\]\}"
        !           122: check [length $a chars] 7 6.19
        !           123: set a {\a\c\n\]\}}
        !           124: check [length $a chars] 10 6.20
        !           125: 
        !           126: # Semi-colon.
        !           127: 
        !           128: set b 0
        !           129: getArgs a;set b 2
        !           130: check $argv a 7.1
        !           131: check $b 2 7.2
        !           132: getArgs a b ; set b 1
        !           133: check $argv {a b} 7.3
        !           134: check $b 1 7.4
        !           135: 
        !           136: # The following checks are to ensure that the interpreter's result
        !           137: # gets re-initialized by Tcl_Eval in all the right places.
        !           138: 
        !           139: check [concat abc] abc 8.1
        !           140: check [concat abc; set a 2] {} 8.2
        !           141: check [concat abc; set a $a] {} 8.3
        !           142: check [set a [concat abc]] {} 8.4
        !           143: 
        !           144: # Syntax errors.
        !           145: 
        !           146: check [catch "set a {bcd" msg] 1 9.1
        !           147: check $msg "unmatched brace: 'set a  => {bcd'" 9.2
        !           148: check [catch {set a "bcd} msg] 1 9.3
        !           149: check $msg {unmatched quote: 'set a  => "bcd'} 9.4
        !           150: check [catch {set a "bcd"xy} msg] 1 9.5
        !           151: check $msg {extra characters after close-quote: 'set a "bcd => "xy'} 9.6
        !           152: check [catch "set a {bcd}xy" msg] 1 9.7
        !           153: check $msg "extra characters after close-brace: 'set a {bcd => }xy'" 9.8
        !           154: check [catch {set a [format abc} msg] 1 9.9
        !           155: check $msg "missing close-bracket: ' => format abc'" 9.10
        !           156: check [catch gorp-a-lot msg] 1 9.11
        !           157: check $msg {"gorp-a-lot" is an invalid command name or ambiguous abbreviation} 9.12

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.