Tcl Library Source Code

Check-in [cbd7732a08]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:pt::pgen test cases for error handling updated and tweaked. Pass for all Tcl backends. Fail for the generated C backend. To be fixed.
Timelines: family | ancestors | descendants | both | pt-work
Files: files | file ages | folders
SHA1: cbd7732a087b324db6d1008c8be3a13481e2a499
User & Date: aku 2014-06-27 06:04:38
Context
2014-06-28
05:04
char - Modified internals to accept strings and varargs strings as arguments, not just single char. Drops the need for externa split/join combos to handle strings. Extended the testsuite to match. Further refactored the argument handling into a single helper command. check-in: 570945bf84 user: aku tags: pt-work
2014-06-27
06:04
pt::pgen test cases for error handling updated and tweaked. Pass for all Tcl backends. Fail for the generated C backend. To be fixed. check-in: cbd7732a08 user: aku tags: pt-work
06:03
pt::util - Expansion of error details for readability added, plus fusion of terminals and char-sets into single char-set. check-in: 88105b2ae2 user: aku tags: pt-work
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/pt/tests/pt_pgen.tests.

77
78
79
80
81
82
83

84
85
86
87
88
89
90
91
92
93

94
95
96
97
98
99

100
101
102
103
104
105
106

107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127










128
129
130
131
132
133
134
    # characters, for characters special to Tcl, C, and
    # PEGs. I.e. ensure that the various forms of quoting are done
    # correctly.

    # Grammar for all test cases below, with the actual character
    # mapped in (replacing @).
    set gtemplate "PEG a_pe_grammar ('@') END;"


    # Table of test cases ...
    #             Id PEG     InText Error detail
    lappend chars  0 \{      \{     [list t \{]
    lappend chars  1 \[      \[     [list t \[]
    lappend chars  2 \"      \"     [list t \"]
    lappend chars  3 \\033   \033   [list t ESC]  ;# See below, WIBNI \e escape
    lappend chars  4 \\n     \n     [list t LF]
    lappend chars  5 \\r     \r     [list t CR]
    lappend chars  6 \\t     \t     [list t TAB]

    lappend chars  7 \\010   \b     [list t BS]   ;# TODO extend PEG grammar to recognize these.
    lappend chars  8 \\014   \f     [list t FF]   ;#
    lappend chars  9 \\013   \v     [list t VTAB] ;#
    lappend chars 10 \\007   \a     [list t BEL]
    lappend chars 11 { }     { }    [list t SPACE]
    lappend chars 12 \\\\    \\     [list t \\]

    lappend chars 13 \\u229b \u229b [list t \u229b] ;# math symbol, circled asterix
    # test all control characters ... (and DEL)
    # more characters: above ascii = unicode BMP.

    foreach {n peg input message} $chars {
	set glabel "x:$message"
	set grdata [string map [list @ $peg] $gtemplate]


	# Make parser instance. Shared across tests.
	# Amortize the time spent on dynamically making it.
	set p [make-parser $format $glabel $grdata]

	test pt-pgen-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-f:${format}-g:${glabel}-3.$n \
	    "$format parser $glabel, good input" -setup {
	    } -body {
		$p parset $input
	    } -result {}


	test pt-pgen-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-f:${format}-g:${glabel}-4.$n \
	    "$format parser $glabel, bad input - \\000" -setup {
	    } -body {
		set code [catch {
		    $p parset \000
		} msg]
		lassign $msg tag loc mlist
		list $tag $loc [lsort -dict $mlist]
	    } -result [list pt::rde 0 [list $message]]











	# Kill shared parser instance.
	$p destroy
    }

}








>



|
|
|
|
|
|
|
>
|
|
|
|
|
|
>
|



|
|
|
>











<

|


|




>
>
>
>
>
>
>
>
>
>







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
    # characters, for characters special to Tcl, C, and
    # PEGs. I.e. ensure that the various forms of quoting are done
    # correctly.

    # Grammar for all test cases below, with the actual character
    # mapped in (replacing @).
    set gtemplate "PEG a_pe_grammar ('@') END;"
    set etemplate "Parse error at position 0 (Line 0, column 0).\n... X ...\n    ^\nExpected one of\n* The character '@'\n"

    # Table of test cases ...
    #             Id PEG     InText Error detail
    lappend chars  0 \{      \{     [list t \{]     \{
    lappend chars  1 \[      \[     [list t \[]     \[
    lappend chars  2 \"      \"     [list t \"]     \"
    lappend chars  3 \\033   \033   [list t \33]    <ESC>
    lappend chars  4 \\n     \n     [list t \n]     <LF>
    lappend chars  5 \\r     \r     [list t \r]     <CR>
    lappend chars  6 \\t     \t     [list t \t]     <TAB>
    # \b, \f, \v - Extend PEG grammar to recognize. Also \e = \33
    lappend chars  7 \\010   \b     [list t \b]     <BS>
    lappend chars  8 \\014   \f     [list t \f]     <FF>
    lappend chars  9 \\013   \v     [list t \v]     <VTAB>
    lappend chars 10 \\007   \a     [list t \a]     <BEL>
    lappend chars 11 { }     { }    [list t { }]    <SPACE>
    lappend chars 12 \\\\    \\     [list t \\]     \\
    # math symbol, circled asterix
    lappend chars 13 \\u229b \u229b [list t \u229b] \u229b
    # test all control characters ... (and DEL)
    # more characters: above ascii = unicode BMP.

    foreach {n peg input message hmsg} $chars {
	set glabel "T_$hmsg"
	set grdata [string map [list @ $peg]  $gtemplate]
	set edata  [string map [list @ $hmsg] $etemplate]

	# Make parser instance. Shared across tests.
	# Amortize the time spent on dynamically making it.
	set p [make-parser $format $glabel $grdata]

	test pt-pgen-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-f:${format}-g:${glabel}-3.$n \
	    "$format parser $glabel, good input" -setup {
	    } -body {
		$p parset $input
	    } -result {}


	test pt-pgen-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-f:${format}-g:${glabel}-4.$n \
	    "$format parser $glabel, bad input, tcl error" -setup {
	    } -body {
		set code [catch {
		    $p parset X
		} msg]
		lassign $msg tag loc mlist
		list $tag $loc [lsort -dict $mlist]
	    } -result [list pt::rde 0 [list $message]]

	test pt-pgen-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-f:${format}-g:${glabel}-5.$n \
	    "$format parser $glabel, bad input, readable error" -setup {
	    } -body {
		set code [catch {
		    $p parset X
		} msg]
		lassign $msg tag loc mlist
		pt::util::error2readable [list $tag $loc [lsort -dict $mlist]] X
	    } -result $edata

	# Kill shared parser instance.
	$p destroy
    }

}