ycl

Artifact 9b7788f7d54d7ccf9275ac80406739bf02842005:

• File packages/switch/lib/switch.test.tcl — part of check-in [7f8a8ea012] at 2021-05-22 09:54:07 on branch trunk — update various things to reflect changes in other packages

  add new files and packages (user: pooryorick size: 3697)

#! /bin/env tclsh

proc suite_main {} {
	package require {ycl proc}
	package require {ycl chan diagnostic}
	[yclprefix] proc alias [yclprefix]::proc::alias
	[yclprefix] proc alias aliases [yclprefix] proc aliases
	aliases {
		{ycl list} {
			sl
		}
		{ycl switch} {
			lswistch
		}
	}
	package require {ycl test}
	[yclprefix]::test::init

	variable cleanup1
	variable setup1

	test lswitch {} -setup $setup1 -body {
		set list {colorless green ideas sleep furiously}
		lswitch $list {
			{colorless green} {
				lappend res one
			}
		}
		lswitch $list {
			{colorless green} {
				lappend res two
			}
			default {
				lappend res three
			}
		}
		lswitch $list {
			foo {
				lappend res four 
			}
			{colorless green ideas} {
				lappend res five 
			}
		}
		lswitch $list {
			foo {
				lappend res six 
			}
			{colorless green goop} {
				lappend res seven 
			}
			default {
				lappend res eight 
			}
		}
		set res
	} -result [sl {
		one two five eight
	}]

	set list {colorless green ideas sleep furiously}

	test lswitch_glob {} -setup $setup1 -body {
		lswitch -glob $list {
			doop {
				lappend res one
			}
		}

		lswitch -glob $list {
			* {
				lappend res two
			}
		}

		lswitch -glob $list {
			{* green}  {
				lappend res three
			}
		}

		lswitch -glob $list {
			{* blue}  {
				lappend res four 
			}
		}

		lswitch -glob $list {
			doop {
				lappend res five
			}
			{* green}  {
				lappend res six 
			}
		}
		set res
	} -result [sl {
		two three six
	}]

	test lswitch_regexp {} -setup $setup1 -body {
		lswitch -regexp $list {
			doop {
				lappend res one
			}
			.* {
				lappend res two
			}
		}

		lswitch -regexp $list {
			doop {
				lappend res three
			}
			{.* doop} {
				lappend res four
			}
		}

		lswitch -regexp -nocase $list {
			doop {
				lappend res five
			}
			{.* G.*} {
				lappend res six
			}
		}

		lswitch -regexp $list {
			doop {
				lappend res seven
			}
			{.* g.*x} {
				lappend res eight
			}
			default {
				lappend res nine
			}
		}

		lswitch -regexp -nocase $list {
			doop {
				lappend res ten
			}
			{.* G.*} {
				lappend res eleven
			}
		}
		set res
	} -cleanup $cleanup1 -result [sl {
		two six nine eleven
	}]

	test lswitch_regexp_matchvar {} -setup $setup1 -body {
		lswitch -regexp -matchvar matches $list {
			doop {
				lappend res one
			}
		}
		lappend res $matches
		lswitch -regexp -matchvar matches $list {
			doop {
				lappend res two
			}
			{.* {gr([^a]*)n.*}} {
				lappend res three
			}
		}
		lappend res $matches 
		set res
	} -cleanup $cleanup1 -result [sl {
		{} three {green ee}
	}]

	test lswitch_regexp_indexvar {} -setup $setup1 -body {
		lswitch -regexp -indexvar indices $list {
			doop {
				lappend res one
			}
		}
		lappend res $indices
		lswitch -regexp -indexvar indices  $list {
			doop {
				lappend res two
			}
			{colorless .* .* .* {fu([^l]*)(.*)}} {
				lappend res three
			}
		}
		lappend res $indices 
		set res
	} -cleanup $cleanup1 -result [sl {
		{} three {{0 8} {2 6} {7 8}}
	}]

	test lswitch_regexp_indexvar_matchvar {} -setup $setup1 -body {
		lswitch -regexp -indexvar indices -matchvar matches $list {
			doop {
				lappend res one
			}
		}
		lappend res $matches
		lappend res $indices
		lswitch -regexp -indexvar indices -matchvar matches  $list {
			doop {
				lappend res two
			}
			{colorless .* .* .* {fu([^l]*)(.*)}} {
				lappend res three
			}
		}
		lappend res $matches 
		lappend res $indices 
		set res
	} -cleanup $cleanup1 -result [sl {
		{} {} three {furiously rious ly} {{0 8} {2 6} {7 8}}
	}]

	cleanupTests
}

variable setup1 {
	set res {}
}

variable cleanup1 {
	catch {
		set res {}
	}
	catch {
		unset matches
	}
	catch {
		unset indices
	}
}