diff options
Diffstat (limited to 'tools/spencer2regexp.tcl')
| -rw-r--r-- | tools/spencer2regexp.tcl | 174 |
1 files changed, 0 insertions, 174 deletions
diff --git a/tools/spencer2regexp.tcl b/tools/spencer2regexp.tcl deleted file mode 100644 index b23f806..0000000 --- a/tools/spencer2regexp.tcl +++ /dev/null @@ -1,174 +0,0 @@ -# spencer2regexp.tcl -- -# -# This file generates a test suite for the regexp command based on -# Henry Spencer's test suite. This script must be run in tcl 8.1 or -# higher and takes an output filename as its parameter. -# -# Copyright (c) 1996 by Sun Microsystems, Inc. -# -# SCCS: @(#) spencer2regexp.tcl 1.4 98/01/22 14:48:09 -# - -source ../tools/regexpTestLib.tcl - -# -# remove flags that have no meaning -# -proc removeFlags {flags} { - regsub -all {a|s|&|-|/|\+|,|\$|;|:|>|=|\.|\[|[A-Z]|[0-9]} $flags "" newFlags - return $newFlags -} - -# -# NOTBOL flag is already tested and can't be tested from the command line, skip ^ -# L is locale dependant, skip L -# $ flag has no (?$) meaning -# b&a and q&e are bad flag combinations -# -proc findSkipFlag {flags} { - if {[string first "^" $flags] != -1} { - return 1 - } - if {([string first "q" $flags] != -1) - && ([string first "e" $flags] != -1)} { - return 1 - } - if {([string first "a" $flags] != -1) - && ([string first "b" $flags] != -1)} { - return 1 - } - if {[regexp {\$|\+} $flags] == 1} { - return 1 - } - return 0 -} - -proc prepareCmd {flags re str vars noBraces} { - # adjust the re to include to compile-time flag, where applicable - - if {[llength $flags] != 0} { - - # if re already has meta-syntax, skip this test - - if {[regexp {^(\(\?)|^(\*\*\*)} $re] == 1} { - return -1 - } - set re "\(?$flags\)$re" - } - if {$noBraces > 0} { - set cmd "regexp -- $re $str $vars" - } else { - set cmd "regexp -- [list $re] [list $str] $vars" - } - return $cmd -} - -proc convertTestLineJunk {currentLine len lineNum srcLineNum} { - - regsub -all {(?b)\\} $currentLine {\\\\} currentLine - set re [lindex $currentLine 0] - set flags [lindex $currentLine 1] - set str [lindex $currentLine 2] - - # based on flags, decide whether to skip the test - - if {[findSkipFlag $flags]} { - regsub -all {\[|\]|\(|\)|\{|\}|\#} $currentLine {\&} line - set msg "\# skipping char mapping test from line $srcLineNum\n" - append msg "print \{... skip test from line $srcLineNum: $line\}" - return $msg - } - - # perform mapping if '=' flag exists - - if {[regexp {=|>} $flags] == 1} { - regsub -all {_} $currentLine {\\ } currentLine - regsub -all {A} $currentLine {\\007} currentLine - regsub -all {B} $currentLine {\\b} currentLine - regsub -all {E} $currentLine {\\033} currentLine - regsub -all {F} $currentLine {\\f} currentLine - regsub -all {N} $currentLine {\\n} currentLine - regsub -all {R} $currentLine {\\r} currentLine - regsub -all {T} $currentLine {\\t} currentLine - regsub -all {V} $currentLine {\\v} currentLine - if {[regexp {=} $flags] == 1} { - set re [lindex $currentLine 0] - } - set str [lindex $currentLine 2] - } - set flags [removeFlags $flags] - - # find the test result - - set numVars [expr $len - 3] - set vars {} - set vals {} - set result 0 - set v 0 - - if {[regsub {\*} "$flags" "" newFlags] == 1} { - # an error is expected - - if {[string compare $str "EMPTY"] == 0} { - # empty regexp is not an error - # skip this test - - return "\# skipping the empty-re test from line $srcLineNum\n" - } - set flags $newFlags - set result "1 \{[convertErrCode $str]\}" - } elseif {$numVars > 0} { - # at least 1 match is made - - if {[regexp {s} $flags] == 1} { - set result {0 1} - } else { - while {$v < $numVars} { - append vars " var($v)" - append vals " \$var($v)" - incr v - } - set result "0 \{1 [removeAts [lrange $currentLine 3 $len]]\}" - } - } else { - # no match is made - - set result "0 0" - } - - # adjust the re to include to compile-time flag, where applicable - - if {[llength $flags] != 0} { - - # if re already has meta-syntax, skip this test - - if {[regexp {^(\(\?)|^(\*\*\*)} $re] == 1} { - return "\# skipping test with metasyntax from line $srcLineNum\n" - } - set re "\(?$flags\)$re" - } - - # set up the test and write it to the output file - - set cmd "regexp -- [list $re] [list $str] $vars" - set test "test regexp-1.$srcLineNum \{converted from line $srcLineNum\} \{\n" - append test "\tcatch {unset var}\n" - append test "\tlist \[catch \{ \n" - append test "\t\tset match \[$cmd\] \n" - append test "\t\tlist \$match $vals \n" - append test "\t\} msg\] \$msg \n" - append test "\} \{$result\} \n" - return $test -} - -# main - -if {$argc != 2} { - puts "name of input and outfile reuqired" - return -} - -set inFileName [lindex $argv 0] -set outFileName [lindex $argv 1] - -writeOutputFile [readInputFile] regexp |