# reg.test --
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
# (Don't panic if you are seeing this as part of the reg distribution
# and aren't using Tcl -- reg's own regression tester also knows how
# to read this file, ignoring the Tcl-isms.)
#
# Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
#
# RCS: @(#) $Id: reg.test,v 1.17.2.4 2004/12/09 23:01:10 dgp Exp $
# RCS: @(#) $Id: reg.test,v 1.17.2.5 2007/04/08 14:59:49 dgp Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
}

# All tests require the testregexp command, return if this
# command doesn't exist

    #  which wants argument testing even in the event of failure).
    proc MatchExpected {opts testid flags re target args} {
	variable regBug

	# if &, test as both BRE and ARE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    MatchExpected $opts "$testid ARE" ${f}  $re $target {expand}$args
	    MatchExpected $opts "$testid BRE" ${f}b $re $target {expand}$args
	    MatchExpected $opts "$testid ARE" ${f}  $re $target {*}$args
	    MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [list testregexp]

	if {$regBug} {
	    # This will register as a skipped test
	    lappend constraints knownBug
	}

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will register as a skipped test
	    lappend constraints localeRegexp
	}

	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about        {expand}$f $re]
	set ecmd [list testregexp {expand}$opts {expand}$f $re $target]
	set ccmd [list testregexp -about        {*}$f $re]
	set ecmd [list testregexp {*}$opts {*}$f $re $target]

	set nsub [expr {[llength $args] - 1}]
	set names [list]
	set refs ""
	for {set i 0} {$i < [llength $args]} {incr i} {
	    if {$i == 0} {
		set name match

	if {[string match *o* $flags]} {	;# REG_NOSUB kludge
	    set nsub 0				;# unsigned value cannot be -1
	}
	if {[string match *t* $flags]} {	;# REG_EXPECT
	    incr nsub -1			;# the extra does not count
	}
	set erun "list \[[concat $ecmd $names]\] $refs"
	set result [list [expr {![string match *!* $flags]}] {expand}$args]
	set result [list [expr {![string match *!* $flags]}] {*}$args]
	set info [list $nsub $infoflags]

	::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \
		-constraints $constraints -body $ccmd -result $info
	::tcltest::test [TestNum $testid execute] [TestDesc $testid execute] \
		-constraints $constraints -body $erun -result $result
    }

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will register as a skipped test
	    lappend constraints localeRegexp
	}

	set cmd [list testregexp -about {expand}[TestFlags $flags] $re]
	set cmd [list testregexp -about {*}[TestFlags $flags] $re]
	::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
		-constraints $constraints -result [list 1 REG_$err] -body \
		"list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]"
    }

    # match failure expected
    proc expectNomatch {testid flags re target args} {
	# if &, test as both ARE and BRE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectNomatch "$testid ARE" ${f}  $re $target {expand}$args
	    expectNomatch "$testid BRE" ${f}b $re $target {expand}$args
	    expectNomatch "$testid ARE" ${f}  $re $target {*}$args
	    expectNomatch "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [list testregexp]

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will register as a skipped test
	    lappend constraints localeRegexp
	}

	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about {expand}$f $re]
	set ccmd [list testregexp -about {*}$f $re]
	set nsub [expr {[llength $args] - 1}]
	if {$nsub == -1} {
	    # didn't tell us number of subexps
	    set ccmd "lreplace \[$ccmd\] 0 0"
	    set info [list $infoflags]
	} else {
	    set info [list $nsub $infoflags]
	}
	set ecmd [list testregexp {expand}$f $re $target]
	set ecmd [list testregexp {*}$f $re $target]

	::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \
		-constraints $constraints -body $ccmd -result $info
	::tcltest::test [TestNum $testid execute] [TestDesc $testid execute] \
		-constraints $constraints -body $ecmd -result 0
    }

    # match expected (no missing, empty, or ambiguous submatches)
    # expectMatch testno flags re target mat submat ...
    proc expectMatch {args} {
	MatchExpected {} {expand}$args
	MatchExpected {} {*}$args
    }

    # match expected (full fanciness)
    # expectIndices testno flags re target mat submat ...
    proc expectIndices {args} {
	MatchExpected -indices {expand}$args 
	MatchExpected -indices {*}$args 
    }

    # partial match expected
    # expectPartial testno flags re target mat "" ...
    # Quirk:  number of ""s must be one more than number of subREs.
    proc expectPartial {args} {
	lset args 1 ![lindex $args 1]	;# add ! flag
	MatchExpected -indices {expand}$args
	MatchExpected -indices {*}$args
    }

    # test is a knownBug
    proc knownBug {args} {
	variable regBug 1
	uplevel \#0 $args
	set regBug 0