Tcl Library Source Code

Check-in [74769ab5c0]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

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

Overview
Comment:Added lots of test cases going over characters special to PEG, Tcl, and C. Currently mainly failing due to bogus handling in the various generators. The layers of quoting need some sorting.
Timelines: family | ancestors | descendants | both | pt-work
Files: files | file ages | folders
SHA1: 74769ab5c07346e30850623697d432a162047b98
User & Date: aku 2014-06-26 23:27:51
Context
2014-06-27
05:55
pt::pe - Added constructors for explicit char-classes and strings. Version bumped to 1.0.2. check-in: 10d94706b2 user: aku tags: pt-work
2014-06-26
23:27
Added lots of test cases going over characters special to PEG, Tcl, and C. Currently mainly failing due to bogus handling in the various generators. The layers of quoting need some sorting. check-in: 74769ab5c0 user: aku tags: pt-work
23:25
Fixed bad assert, range was off-by-one. check-in: 9690c98b93 user: aku tags: pt-work
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/pt/pt_pgen.test.

︙︙
23
24
25
26
27
28
29




30
31
32
33

34
35
36
37
38
39
40

support {
    useAccel [useTcllibC] struct/stack.tcl struct::stack ; # User: pt::rde
    TestAccelInit                          struct::stack ; # (tcl)

    useAccel [useTcllibC] struct/sets.tcl struct::set
    TestAccelInit                         struct::set





    use      snit/snit.tcl          snit
    use      fileutil/fileutil.tcl  fileutil      ;# tests/common
    use      textutil/adjust.tcl    textutil::adjust


    useLocal pt_astree.tcl                pt::ast
    useLocal pt_pexpression.tcl           pt::pe
    useLocal pt_pexpr_op.tcl              pt::pe::op
    useLocal pt_pegrammar.tcl             pt::peg
    useLocal pt_peg_container.tcl         pt::peg::container

    useAccel [useTcllibC] pt/pt_rdengine.tcl  pt::rde ; # User: pt::parse::peg








>
>
>
>




>








23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

support {
    useAccel [useTcllibC] struct/stack.tcl struct::stack ; # User: pt::rde
    TestAccelInit                          struct::stack ; # (tcl)

    useAccel [useTcllibC] struct/sets.tcl struct::set
    TestAccelInit                         struct::set

    if {![package vsatisfies [package present Tcl] 8.6]} {
	# Pull in try emulation for 8.5. Tcl 8.6 has it builtin.
	use try/try.tcl try
    }
    use      snit/snit.tcl          snit
    use      fileutil/fileutil.tcl  fileutil      ;# tests/common
    use      textutil/adjust.tcl    textutil::adjust

    useLocal pt_util.tcl                  pt::util
    useLocal pt_astree.tcl                pt::ast
    useLocal pt_pexpression.tcl           pt::pe
    useLocal pt_pexpr_op.tcl              pt::pe::op
    useLocal pt_pegrammar.tcl             pt::peg
    useLocal pt_peg_container.tcl         pt::peg::container

    useAccel [useTcllibC] pt/pt_rdengine.tcl  pt::rde ; # User: pt::parse::peg
︙︙

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

︙︙
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46


	# Test parser on good inputs for the grammar.
	TestFilesProcess $mytestdir gr ok-${glabel} ok-${glabel}-res -> k label infile text expected {
	    test pt-pgen-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-f:${format}-g:${glabel}-t:${label}-1.$n.$k \
		"$format parser $glabel, good input - $label" -setup {
		} -body {
		    $p parset $text
		} -cleanup {
		} -result $expected
	}

	# Test parser on bad inputs for the grammar.
	##
	# Note how the expected output depends not only on grammar,
	# but the parser format as well. Different optimizations and








<








32
33
34
35
36
37
38

39
40
41
42
43
44
45


	# Test parser on good inputs for the grammar.
	TestFilesProcess $mytestdir gr ok-${glabel} ok-${glabel}-res -> k label infile text expected {
	    test pt-pgen-parse:${parseimpl}-rde:${rdeimpl}-stack:${stackimpl}-f:${format}-g:${glabel}-t:${label}-1.$n.$k \
		"$format parser $glabel, good input - $label" -setup {
		} -body {
		    $p parset $text

		} -result $expected
	}

	# Test parser on bad inputs for the grammar.
	##
	# Note how the expected output depends not only on grammar,
	# but the parser format as well. Different optimizations and
︙︙
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77




78



79



















































80

		    # by msg id, that is not necessarily
		    # lexicographical, nor matching the Tcl results.
		    lassign $msg tag loc mlist
		    set msg [list $tag $loc [lsort -dict $mlist]]

		    # TODO: Convert message to readable.
		    list $code $msg
		} -cleanup {
		} -result $expected
	} yes ;# Allow missing testsets, for two reasons:
	#      # (a) Easier during testsuite development, allowing incremental buildup
	#      # (b) Some grammar construction *cannot* fail (Ex: x*), thus we cannot provide
	#      #     failure cases either.

	# Kill shared parser instance.
	$p destroy
    }
}




























































#----------------------------------------------------------------------








<









|
>
>
>
>

>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


59
60
61
62
63
64
65

66
67
68
69
70
71
72
73
74
75
76
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

		    # by msg id, that is not necessarily
		    # lexicographical, nor matching the Tcl results.
		    lassign $msg tag loc mlist
		    set msg [list $tag $loc [lsort -dict $mlist]]

		    # TODO: Convert message to readable.
		    list $code $msg

		} -result $expected
	} yes ;# Allow missing testsets, for two reasons:
	#      # (a) Easier during testsuite development, allowing incremental buildup
	#      # (b) Some grammar construction *cannot* fail (Ex: x*), thus we cannot provide
	#      #     failure cases either.

	# Kill shared parser instance.
	$p destroy
    }

    # Testing the handling of generated parsers for single
    # 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
    }

}


#----------------------------------------------------------------------

This page was generated in about 0.012s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19