#!/usr/local/bin/tclsh7.5
#
# $Id: time-tcl,v 1.6 1996/06/18 14:03:50 loverso Exp loverso $
#

set comment {
Newsgroups: comp.lang.tcl
Distribution: world
References:  <2asa9n$g7n@crchh404.bnr.ca>
From: loverso@osf.org (John Robert LoVerso)
Organization: OSF Research Institute, Cambridge MA
Subject: Re: Possible bug in new TCL/TK release

tdoan@bnr.ca (Tuan Doan) writes:
|> newwish> set t1 1234567887187821676736
|> newwish> if {$t1==""} {puts stdout "yes"}
|> newwish> integer value too large to represent

Yes - don't use expr to do string comparisons.  It loses on both
correctness (as above) and performance.  The fastest way to compare
strings with a constant is to use string match:

	if [string match "" $t1] {puts stdout "yes"}

This is faster than using "string compare" because the above would need
a negation, which costs:
	if ![string compare "" $t1] {puts stdout "yes"}

This form is slightly faster, but it still is slightly slower than match:
	if [string compare "" $t1] {} else {puts stdout "yes"}

And, besides, the "string match" has better readability.

Appended below is my timing test I did a month or two back.
Just for the record, my machine is an HP Snake (9000/730) with
64MB memory running OSF/1.

John


4/94:
	Added "regexp"; note that you cannot compare against an empty string.
}

set tests(all) [set testsets {}]
proc testset {name t} {
    global tests
    lappend tests(all) $name
    set tests($name) $t
    global testsets
    set testsets [concat $testsets $t]
}

testset string {
	{cond {$str == "foo"} 1}
	{cond {"foo" == $str} 1}
	{cond {$str == {foo}} 1}
	{cond {{foo} == $str} 1}
	{cond {![string compare $str "foo"]} 1}
	{cond {[string compare $str "foo"]} 0}
	{cond {[string compare $str "foo"] != 0} 0}
	{cond {[string match "foo" $str]} 1}
	{cond {[regexp "foo" $str]} 1}
}

testset string:regexp {
	{cond {[regexp & $str]} 0}
	{cond {[string match *&* $str]} 0}
	{cond {[regexp & $longstr]} 0}
	{cond {[string match *&* $longstr]} 0}
	{cond {[regexp & $hugestr]} 0}
	{cond {[string match *&* $hugestr]} 0}
	{cond {[regexp & $str1]} 0}
	{cond {[regexp & $str2]} 0}
	{cond {[string match *&* $str1]} 0}
	{cond {[string match *&* $str2]} 0}
}

testset longstr:null {
	{cond {$longstr == ""} 0}
	{cond {$longstr == {}} 0}
	{cond {![string compare $longstr ""]} 0}
	{cond {[string compare $longstr ""]} 1}
	{cond {[string match "" $longstr]} 0}
	{cond {[regexp "" $longstr]} 0}
}

testset longstr:eq {
	{cond {$longstr == "This is a test"} 1}
	{cond {$longstr == {This is a test}} 1}
	{cond {![string compare $longstr "This is a test"]} 1}
	{cond {[string compare $longstr "This is a test"]} 0}
	{cond {[string match "This is a test" $longstr]} 1}
	{cond {[regexp "This is a test" $longstr]} 1}
}

testset longstr:neq {
	{cond {$longstr == "This bad test"} 0}
	{cond {$longstr == {This bad test}} 0}
	{cond {![string compare $longstr "This bad test"]} 0}
	{cond {[string compare $longstr "This bad test"]} 1}
	{cond {[string match "This bad test" $longstr]} 0}
	{cond {[regexp "This bad test" $longstr]} 0}
}

testset char:eq {
	{cond {$c == "x"} 1}
	{cond {$c == {x}} 1}
	{cond {![string compare $c "x"]} 1} 
	{cond {[string compare $c "x"]} 0}
	{cond {[string match "x" $c]} 1}
	{cond {[regexp "x" $c]} 1}
}

proc lassign {val args} {
   set c 0
   foreach i $args {
	uplevel 1 [list set $i [lindex $val $c]]
	incr c
   }
   return [lrange $val $c end]
}

testset str2:trim {
	{incr x; regexp ^//(.*) //www.osf.org/~loverso/haha m p}
	{incr x; set p [string trimleft //www.osf.org/~loverso/haha /]}
	{incr x; regexp {(.*)\?(.*)} /~loverso/haha?path=ff&over=1 m p q}
	{incr x; set pq [split /~loverso/haha?path=ff&over=1 ?]}
	{incr x; set pq [split /~loverso/haha?path=ff&over=1 ?]; set p [lindex $pq 0]; set q [lindex $pq 1]}
	{incr x; lassign [split /~loverso/haha?path=ff&over=1 ?] p q}
}

testset list:range {
	{incr x; set ll [lreplace $longlist 0 0]}
	{incr x; set ll [lrange $longlist 1 end]}
	{incr x; set ll [lrange $list 1 [expr [llength $list] - 2]]}
	{incr x; set ll [lreplace $list 0 0]; set ll [lreplace $ll end end]}
	{incr x; set ll [lrange $list 1 [expr [llength $longlist] - 2]]}
	{incr x; set ll [lreplace $longlist 0 0]; set ll [lreplace $ll end end]}
	{iter 100}
	{incr x; set ll [lrange $hugelist 1 [expr [llength $hugelist] - 2]]}
	{incr x; set ll [lreplace $hugelist 0 0]; set ll [lreplace $ll end end]}
}

testset list:null {
	{cond {$longlist != {}} 1}
	{cond {$longlist == {}} 0}
	{cond {[llength $longlist] == 0} 0}
	{cond {[string match "" $longlist]} 0}
}

testset eval:twice {
	{incr x; llength $longlist}
	{incr x; eval {llength $longlist}}
	{incr x; catch {eval {llength $longlist}}}
}

testset func:pass {
	{iter 5000}
	{incr x; funcV $list}
	{incr x; funcN list}
	{iter 2000}
	{incr x; funcV $longlist}
	{incr x; funcN longlist}
	{iter 500}
	{incr x; funcV $str2}
	{incr x; funcN str2}
	{iter 100}
	{incr x; funcV $str16}
	{incr x; funcN str16}
}

proc funcV {s} {
    set x [string trim $s]
}
proc funcN {sn} {
    upvar $sn s
    set x [string trim $s]
}




set str foo
set c x
set longstr "This is a test"
set hugestr "This is a test $comment"

set str1 "0123456789abcdef"
foreach a {0 1 2 3 4 5} {		;# 1K
    set str1 "$str1$str1"
}
set str2 "$str1$str1"
set str4 "$str2$str2"
set str8 "$str4$str4"
set str16 "$str8$str8"
set str32 "$str16$str16"		;# 32K
set str64 "$str32$str32"		;# 64K

set url http://www.osf.org/www/dist_client/detach/
set list [list GET $url HTTP/1.0]
set longlist [concat [info body unknown] $list]
set hugelist [concat $testsets $longlist $str32]


set do $tests(all)
if {$argc > 0} {
    set do {}
    foreach a $argv {
	if [info exists tests($a)] {
	    lappend do $a
	} else {
	    set m [set w {}]
	    foreach t [array names tests] {
		if [string match $a $t] {
		    lappend m $t
		}
		if [string match *$a* $t] {
		    lappend w $t
		}
	    }
	    if [string match "" $m] {
		set do [concat $do $w]
	    } else {
		set do [concat $do $m]
	    }
	}
    }
}

puts "Doing sets: $do"

proc panic {} {
	puts "panic: test failed"
	return -code continue
}

foreach ts $do {
    puts "\nTest set: $ts"
    set iter 1000
    foreach t $tests($ts) {
	set test {}
	switch -exact -- [lindex $t 0] {
	iter	{set iter [lindex $t 1]; continue}
	cond	{ set test [concat if "{" [lindex $t 1] "}"]
		  if [lindex $t 2] {
			append test " {incr x} else {panic}"
		  } else {
			append test " {panic} else {incr x}"
		  }
		}
	default	{ set test $t }
	}
	puts \n$test
	set x 0
	catch $test
	if {$x != 1} panic
	puts "Once: [time $test 1]"
	puts "Once: [time $test 1]"
	puts "[format %4d $iter]: [time $test $iter]"
	if {$x != [expr $iter + 3]} panic
    }
}

exit