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
|
#
# Name: Make Test Files From CSV Files
# Version: 0.2
# Date: August 6, 2022
# Author: Brian O'Hagan
# Email: [email protected]
# Legal Notice: (c) Copyright 2020 by Brian O'Hagan
# Released under the Apache v2.0 license. I would appreciate a copy of any modifications
# made to this package for possible incorporation in a future release.
#
#
# Convert test case file into test files
#
proc process_config_file {filename} {
set prev ""
set test 0
# Open file with test case indo
set in [open $filename r]
array set cases [list]
# Open output test file
set out [open [format %s.test [file rootname $filename]] w]
array set cases [list]
set list [list]
while {[string length $data] > 0} {
if {[string index $data 0] eq "\""} {
# Quoted
set end [string first "\"," $data]
if {$end == -1} {set end [expr {[string length $data]+1}]}
lappend list [string map [list {""} \"] [string range $data 1 [incr end -1]]]
set data [string range $data [incr end 3] end]
} else {
# Not quoted, so no embedded NL, quotes, or commas
set index [string first "," $data]
if {$index == -1} {set index [expr {[string length $data]+1}]}
lappend list [string range $data 0 [incr index -1]]
set data [string range $data [incr index 2] end]
}
}
# Get command or test case
foreach {group name constraints setup body cleanup match result output errorOutput returnCodes} $list {
if {$group eq "command"} {
# Pass-through command
set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]
foreach opt [list -constraints -setup -body -cleanup -match -result -output -errorOutput -returnCodes] {
set cmd [string trim [set [string trimleft $opt "-"]]]
if {$cmd ne ""} {
if {$opt in [list -setup -body -cleanup]} {
append buffer " " $opt " \{\n"
foreach line [split $cmd ";"] {
append buffer \t [string trim $line] \n
}
append buffer " \}"
} elseif {$opt in [list -output -errorOutput]} {
append buffer " " $opt " {" $cmd \n "}"
} elseif {$opt in [list -result]} {
if {[string index $cmd 0] in [list \[ \" \{]} {
append buffer " " $opt " " $cmd
} elseif {[string match {*[\\$]*} $cmd]} {
append buffer " " $opt " \"" [string map [list \\\\\" \\\"] [string map [list \" \\\" ] $cmd]] "\""
} else {
append buffer " " $opt " {" $cmd "}"
}
} else {
append buffer " " $opt " {" $cmd "}"
}
}
}
puts $out $buffer
} else {
# Empty line
}
break
}
}
# Output clean-up commands
puts $out "\n# Cleanup\n::tcltest::cleanupTests\nreturn"
close $out
close $in
}
#
# Call script
#
foreach file [glob *.csv] {
process_config_file $file
}
exit
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
|
|
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
|
>
>
>
>
|
>
>
|
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
157
158
159
160
161
162
163
164
165
|
#
# Name: Make Test Files From CSV Files
# Version: 0.3
# Date: March 9, 2024
# Author: Brian O'Hagan
# Email: [email protected]
# Legal Notice: (c) Copyright 2020 by Brian O'Hagan
# Released under the Apache v2.0 license. I would appreciate a copy of any modifications
# made to this package for possible incorporation in a future release.
#
#
# Parse CSV line
#
proc parse_csv {ch data} {
set buffer ""
set result [list]
set start 0
set end [string length $data]
while {$start < $end} {
if {[string index $data $start] eq "\""} {
# Quoted
if {[set index [string first "\"" $data [incr start]]] > -1} {
set next [string index $data [expr {$index + 1}]]
if {$next eq "\""} {
# Quote
append buffer [string range $data $start $index]
set start [incr index]
} else {
# End of quoted data
append buffer [string range $data $start [incr index -1]]
set start [incr index 3]
lappend result $buffer
set buffer ""
}
} else {
# Multi-line
append buffer [string range $data $start end] "\n"
gets $ch new
set data "\""
append data $new
set start 0
set end [string length $data]
}
} else {
# Not quoted, so no embedded NL, quotes, or commas
set index [string first "," $data $start]
if {$index > -1} {
lappend result [string range $data $start [incr index -1]]
set start [incr index 2]
} else {
lappend result [string range $data $start end]
set start [string length $data]
}
}
}
return $result
}
#
# Convert test case file into test files
#
proc process_config_file {filename} {
set prev ""
set test 0
# Open file with test case indo
set in [open $filename r]
array set cases [list]
# Open output test file
set out [open [format %s.test [file rootname $filename]] w]
fconfigure $out -encoding utf-8 -translation {auto lf}
array set cases [list]
# Add setup commands to test file
puts $out [format "# Auto generated test cases for %s" [file tail $filename]]
#puts $out [format "# Auto generated test cases for %s created on %s" [file tail $filename] [clock format [clock seconds]]]
# Package requires
puts $out "\n# Load Tcl Test package"
puts $out [subst -nocommands {if {[lsearch [namespace children] ::tcltest] == -1} {\n\tpackage require tcltest\n\tnamespace import ::tcltest::*\n}\n}]
puts $out {set auto_path [concat [list [file dirname [file dirname [info script]]]] $auto_path]}
puts $out ""
# Generate test cases and add to test file
while {[gets $in data] > -1} {
# Skip comments
set data [string trim $data]
if {[string match "#*" $data]} continue
# Split comma separated fields with quotes
set list [parse_csv $in $data]
# Get command or test case
foreach {group name constraints setup body cleanup match result output errorOutput returnCodes} $list {
if {$group eq "command"} {
puts $out $name
} elseif {$group ne "" && $body ne ""} {
set group [string map [list " " "_"] $group]
if {$group ne $prev} {
incr test
set prev $group
puts $out ""
}
# Test case
if {[string index $name 0] ne {$}} {
set buffer [format "\ntest %s-%d.%d {%s}" $group $test [incr cases($group)] $name]
} else {
set buffer [format "\ntest %s-%d.%d %s" $group $test [incr cases($group)] $name]
}
foreach opt [list -constraints -setup -body -cleanup -match -result -output -errorOutput -returnCodes] {
set cmd [string trim [set [string trimleft $opt "-"]]]
if {$cmd ne ""} {
if {$opt in [list -setup -body -cleanup]} {
append buffer " " $opt " \{\n"
foreach line [split $cmd ";"] {
append buffer \t [string trim $line] \n
}
append buffer " \}"
} elseif {$opt in [list -output -errorOutput]} {
append buffer " " $opt " {" $cmd \n "}"
} elseif {$opt in [list -result]} {
if {[string index $cmd 0] in [list \[ \" \{ \$]} {
append buffer " " $opt " " $cmd
} elseif {[string match {*[\\$]*} $cmd]} {
append buffer " " $opt " \"" [string map [list \\\\\" \\\"] [string map [list \" \\\" ] $cmd]] "\""
} else {
append buffer " " $opt " {" $cmd "}"
}
} else {
append buffer " " $opt " {" $cmd "}"
}
}
}
puts $out $buffer
} else {
# Empty line
puts $out ""
}
break
}
}
# Output clean-up commands
puts $out "\n# Cleanup\n::tcltest::cleanupTests\nreturn"
close $out
close $in
}
#
# Call script
#
foreach file [glob *.csv] {
puts $file
process_config_file $file
}
exit
|