Tcl Library Source Code

Check-in [9ab6b8023e]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Factored out commonalities into a test-case generator: TestTransformation; added tests for discussing suggested fixes (minimize, drop unrealizable)
Timelines: family | ancestors | descendants | both | pt-container-ssoberni
Files: files | file ages | folders
SHA3-256: 9ab6b8023e83ec556fb796dee3ee28a4f027d960e4324b6f2155d60955bfd373
User & Date: ssoberni 2018-07-04 12:50:56
Context
2018-07-09
19:49
Some fixes to the new pe transform testing. check-in: 8436048fee user: andreask tags: pt-container-ssoberni
2018-07-04
12:50
Factored out commonalities into a test-case generator: TestTransformation; added tests for discussing suggested fixes (minimize, drop unrealizable) check-in: 9ab6b8023e user: ssoberni tags: pt-container-ssoberni
2018-07-03
16:06
cleanup check-in: f43384e6e9 user: ssoberni tags: pt-container-ssoberni
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/pt/tests/pt_peg_op.tests.

1
2
3
4
5
6
7
8





9

10













11
12



































































































13
14
15
16
17

18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40
41
42


43

# -*- tcl -*-
# Testsuite for pt::peg::op.

test pt-peg-op-set:${setimpl}-1.0 {op minimize, wrong#args} -body {
    pt::peg::op::minimize 
} -returnCodes error -result {wrong # args: should be "pt::peg::op::minimize container"}

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





# minimize















set n 0
foreach {inStart inRulesSet outStart outRulesSet} {



































































































    {n S} {
	S {is {n A} mode value}
	A {is {n A} mode value}
    }
    epsilon {}

    {n S}
    {
     	S {is {n A} mode leaf}
     	A {is {t a} mode void}
    }
    {n S} {
	S {is {n A} mode leaf}
     	A {is {t a} mode void}
    }
} {
    test pt-pe-op-set:${setimpl}-2.$n {op minimize, expected} -setup {
	pt::peg::container ::In deserialize \

	    [list pt::grammar::peg [list rules $inRulesSet start $inStart]]
	pt::peg::container ::Expected deserialize \
	    [list pt::grammar::peg [list rules $outRulesSet start $outStart]]
    } -body {
	pt::peg::op::minimize ::In
	# puts stderr [::In serialize]
	# puts stderr [::Expected serialize]
	pt::peg equal [::In serialize] [::Expected serialize]
    } -result 1 -cleanup {
	::In destroy
	::Expected destroy
    }
    incr n


}



|
|
|

|
>
>
>
>
>
|
>

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





>









|
|
<
>
|
|
|
<
<
<
<
<
<
<
<

<
>
>
|
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
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
137
138
139
140
141
142
143
144
145
146
147

148
149
150
151








152

153
154
155
156
# -*- tcl -*-
# Testsuite for pt::peg::op.

test pt-peg-op-set:${setimpl}-0.0 {op 'flatten', wrong#args} -body {
    pt::peg::op flatten
} -returnCodes error -result {wrong # args: should be "pt::peg::op flatten container"}

test pt-peg-op-set:${setimpl}-0.1 {op 'drop unrealizable', wrong#args} -body {
    pt::peg::op drop unrealizable
} -returnCodes error -result {wrong # args: should be "pt::peg::op drop unrealizable container"}


test pt-peg-op-set:${setimpl}-0.2 {op 'minimize', wrong#args} -body {
    pt::peg::op minimize 
} -returnCodes error -result {wrong # args: should be "pt::peg::op minimize container"}


proc sl {v} {
    regsub -all -line {^\s*#.*$} $v {}
}

proc TestTransformation {op data setImpl} {
    set debug 0
    append bodyScript [list {*}::pt::peg::op::$op ::In] \;
    if {$debug} {
	append bodyScript "puts stderr \[::In serialize\]" \;
	append bodyScript "puts stderr \[::Expected serialize\]" \;
    }
    append bodyScript "pt::peg equal \[::In serialize\] \[::Expected serialize\]" \;
    set n 1
    foreach {inStart inRulesSet outStart outRulesSet} [sl $data] {
	set testLabel "pt-peg-op-set:${setImpl}-[join $op -].$n"
	if {$debug} {
	    puts stderr >>>>$testLabel<<<<
	}
	test $testLabel "OP '$op' vs. expected" -setup {
	    pt::peg::container ::In deserialize \
		[list pt::grammar::peg [list rules $inRulesSet start $inStart]]
	    pt::peg::container ::Expected deserialize \
		[list pt::grammar::peg [list rules $outRulesSet start $outStart]]
	} -body $bodyScript -result 1 -cleanup {
	    ::In destroy
	    ::Expected destroy
	}
	incr n
    }
}

# -------------------------------------------------------------------------
# flatten

TestTransformation flatten {
    # --- stays as-is #1
    epsilon {}
    epsilon {}
    # --- stays as-is #2
    {n S} {
	S {is {n A} mode value}
	A {is {t a} mode value}
    }
    {n S} {
	S {is {n A} mode value}
	A {is {t a} mode value}
    }
    # --- flatten start expr and rules: sequence
    {x {n S}} {
	S {is {x {n A}} mode value}
	A {is {n A} mode value}
    }
    {n S} {
	S {is {n A} mode value}
	A {is {n A} mode value}
    }
} $setimpl

# -------------------------------------------------------------------------
# drop realizable

TestTransformation "drop unrealizable" {
    # (1) stays as-is
    epsilon {}
    epsilon {}
    # (2) S <-- X; X <-- X; => epsilon
    {n S} {
	S {is {n X} mode value}
	X {is {n X} mode value}
    }
    epsilon {}
    # (3) S <-- X?; X <-- X; => S <-- epsilon
    {n S} {
	S {is {? {n X}} mode value}
	X {is {n X} mode value}
    }
    {n S} {
	S {is epsilon mode value}
    }
    # (4) S <-- X*; X <-- X; => S <-- epsilon
    {n S} {
	S {is {* {n X}} mode value}
	X {is {n X} mode value}
    }
    {n S} {
	S {is epsilon mode value}
    }
    # (5) S <-- X 'y'; X <-- X; => epsilon
    {n S} {
	S {is {x {n X} {t y}} mode value}
	X {is {n X} mode value}
    }
    epsilon {}
    # (6) S <-- X / 'y'; X <-- X; => S <-- 'y' (unflattened!)
    {n S} {
	S {is {/ {n X} {t y}} mode value}
	X {is {n X} mode value}
    }
    {n S} {
	S {is {/ {t y}} mode value}
    }
} $setimpl



# -------------------------------------------------------------------------
# minimize

TestTransformation minimize {
    # --- stays as-is
    epsilon {}
    epsilon {}
    # --- minimize away
    {n S} {
	S {is {n A} mode value}
	A {is {n A} mode value}
    }
    epsilon {}
    # --- already minimal
    {n S}
    {
     	S {is {n A} mode leaf}
     	A {is {t a} mode void}
    }
    {n S} {
	S {is {n A} mode leaf}
     	A {is {t a} mode void}
    }
    # --- realizable *before* reachable
    {n S}

    {
     	S {is {/ {x {n A} {n B}} {t a}} mode value}
     	A {is {x {t a} {n A}} mode value}
	B {is {t a} mode leaf}








    }

    {n S} {
	S {is {t a} mode leaf}
    }
} $setimpl