diff options
author | sebres <sebres@users.sourceforge.net> | 2024-03-20 16:37:22 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2024-03-20 16:37:22 (GMT) |
commit | 74a35df9b6612436598f938cdddb2a3026c75ed9 (patch) | |
tree | e089162907d6b5f5dd25bf65a39721570e2e22b3 /tests-perf | |
parent | 07429ddef1256ee2897c7bd1adcfae3024b9e8c1 (diff) | |
download | tcl-74a35df9b6612436598f938cdddb2a3026c75ed9.zip tcl-74a35df9b6612436598f938cdddb2a3026c75ed9.tar.gz tcl-74a35df9b6612436598f938cdddb2a3026c75ed9.tar.bz2 |
added performance regression tests for list facilities (initially only few lsearch cases, illustrating [6811a0081940b76c])
Diffstat (limited to 'tests-perf')
-rw-r--r-- | tests-perf/list.perf.tcl | 100 |
1 files changed, 100 insertions, 0 deletions
diff --git a/tests-perf/list.perf.tcl b/tests-perf/list.perf.tcl new file mode 100644 index 0000000..9c66259 --- /dev/null +++ b/tests-perf/list.perf.tcl @@ -0,0 +1,100 @@ +#!/usr/bin/tclsh + +# ------------------------------------------------------------------------ +# +# list.perf.tcl -- +# +# This file provides performance tests for comparison of tcl-speed +# of list facilities. +# +# ------------------------------------------------------------------------ +# +# Copyright (c) 2024 Serg G. Brester (aka sebres) +# +# See the file "license.terms" for information on usage and redistribution +# of this file. +# + + +if {![namespace exists ::tclTestPerf]} { + source [file join [file dirname [info script]] test-performance.tcl] +} + + +namespace eval ::tclTestPerf-List { + +namespace path {::tclTestPerf} + +# regression tests for [bug-da16d15574] (fix for [db4f2843cd]): +proc test-lsearch-regress {{reptime 1000}} { + _test_run -no-result $reptime { + # list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set l [lrepeat 5000 $str]; llength $l } + # lsearch with no option, found immediatelly : + { lsearch $l $str } + # lsearch with -glob, found immediatelly : + { lsearch -glob $l $str } + # lsearch with -exact, found immediatelly : + { lsearch -exact $l $str } + # lsearch with -dictionary, found immediatelly : + { lsearch -dictionary $l $str } + + # lsearch with -nocase only, found immediatelly : + { lsearch -nocase $l $str } + # lsearch with -nocase -glob, found immediatelly : + { lsearch -nocase -glob $l $str } + # lsearch with -nocase -exact, found immediatelly : + { lsearch -nocase -exact $l $str } + # lsearch with -nocase -dictionary, found immediatelly : + { lsearch -nocase -dictionary $l $str } + } +} + +proc test-lsearch-nf-regress {{reptime 1000}} { + _test_run -no-result $reptime { + # list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set sNF $str/NF; set l [lrepeat 5000 $str]; llength $l } + # lsearch with no option, not found: + { lsearch $l $sNF } + # lsearch with -glob, not found: + { lsearch -glob $l $sNF } + # lsearch with -exact, not found: + { lsearch -exact $l $sNF } + # lsearch with -dictionary, not found: + { lsearch -dictionary $l $sNF } + } +} + +proc test-lsearch-nc-nf-regress {{reptime 1000}} { + _test_run -no-result $reptime { + # list with 5000 strings with ca. 50 chars elements: + setup { set str [join [lrepeat 13 "XXX"] /]; set sNF $str/NF; set l [lrepeat 5000 $str]; llength $l } + # lsearch with -nocase only, not found: + { lsearch -nocase $l $sNF } + # lsearch with -nocase -glob, not found: + { lsearch -nocase -glob $l $sNF } + # lsearch with -nocase -exact, not found: + { lsearch -nocase -exact $l $sNF } + # lsearch with -nocase -dictionary, not found: + { lsearch -nocase -dictionary $l $sNF } + } +} + +proc test {{reptime 1000}} { + test-lsearch-regress $reptime + test-lsearch-nf-regress $reptime + test-lsearch-nc-nf-regress $reptime + + puts \n**OK** +} + +}; # end of ::tclTestPerf-List + +# ------------------------------------------------------------------------ + +# if calling direct: +if {[info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]} { + array set in {-time 500} + array set in $argv + ::tclTestPerf-List::test $in(-time) +} |