1# Commands covered: lpop 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright © 1991-1993 The Regents of the University of California. 8# Copyright © 1994 Sun Microsystems, Inc. 9# Copyright © 1998-1999 Scriptics Corporation. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13 14if {"::tcltest" ni [namespace children]} { 15 package require tcltest 2.5 16 namespace import -force ::tcltest::* 17} 18 19unset -nocomplain no; # following tests expecting var "no" does not exists 20test lpop-1.1 {error conditions} -returnCodes error -body { 21 lpop no 22} -result {can't read "no": no such variable} 23test lpop-1.2 {error conditions} -returnCodes error -body { 24 lpop no 0 25} -result {can't read "no": no such variable} 26test lpop-1.3 {error conditions} -returnCodes error -body { 27 set l "x {}x" 28 lpop l 29} -result {list element in braces followed by "x" instead of space} 30test lpop-1.4 {error conditions} -returnCodes error -body { 31 set l "x y" 32 lpop l -1 33} -result {index "-1" out of range} 34test lpop-1.4b {error conditions (also check SF on empty list variable, bug [234d6c811d])} -body { 35 set l "x y" 36 list [lpop l] [lpop l] [catch {lpop l} v] $v [catch {lpop l 0} v] $v $l 37} -result {y x 1 {index "end" out of range} 1 {index "0" out of range} {}} 38test lpop-1.5 {error conditions} -returnCodes error -body { 39 set l "x y z" 40 lpop l 3 41} -result {index "3" out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX} 42test lpop-1.6 {error conditions} -returnCodes error -body { 43 set l "x y" 44 lpop l end+1 45} -result {index "end+1" out of range} 46test lpop-1.7 {error conditions} -returnCodes error -body { 47 set l "x y" 48 lpop l {} 49} -match glob -result {bad index *} 50test lpop-1.8 {error conditions} -returnCodes error -body { 51 set l "x y" 52 lpop l 0 0 0 0 1 53} -result {index "1" out of range} 54test lpop-1.9 {error conditions} -returnCodes error -body { 55 set l "x y" 56 lpop l {1 0} 57} -match glob -result {bad index *} 58 59test lpop-2.1 {basic functionality} -body { 60 set l "x y z" 61 list [lpop l 0] $l 62} -result {x {y z}} 63test lpop-2.2 {basic functionality} -body { 64 set l "x y z" 65 list [lpop l 1] $l 66} -result {y {x z}} 67test lpop-2.3 {basic functionality} -body { 68 set l "x y z" 69 list [lpop l] $l 70} -result {z {x y}} 71test lpop-2.4 {basic functionality} -body { 72 set l "x y z" 73 set l2 $l 74 list [lpop l] $l $l2 75} -result {z {x y} {x y z}} 76 77test lpop-3.1 {nested} -body { 78 set l "x y" 79 set l2 $l 80 list [lpop l 0 0 0 0] $l $l2 81} -result {x {{{{}}} y} {x y}} 82test lpop-3.2 {nested} -body { 83 set l "{x y} {a b}" 84 list [lpop l 0 1] $l 85} -result {y {x {a b}}} 86test lpop-3.3 {nested} -body { 87 set l "{x y} {a b}" 88 list [lpop l 1 0] $l 89} -result {a {{x y} b}} 90 91 92 93 94 95test lpop-99.1 {performance} -constraints perf -body { 96 set l [lrepeat 10000 x] 97 set l2 $l 98 set t1 [time { 99 while {[llength $l] >= 2} { 100 lpop l end 101 } 102 }] 103 set l [lrepeat 30000 x] 104 set l2 $l 105 set t2 [time { 106 while {[llength $l] >= 2} { 107 lpop l end 108 } 109 }] 110 regexp {\d+} $t1 ms1 111 regexp {\d+} $t2 ms2 112 set ratio [expr {double($ms2)/$ms1}] 113 # Deleting from end should have linear performance 114 expr {$ratio > 4 ? $ratio : 4} 115} -result {4} 116 117test lpop-99.2 {performance} -constraints perf -body { 118 set l [lrepeat 10000 x] 119 set l2 $l 120 set t1 [time { 121 while {[llength $l] >= 2} { 122 lpop l 1 123 } 124 }] 125 set l [lrepeat 30000 x] 126 set l2 $l 127 set t2 [time { 128 while {[llength $l] >= 2} { 129 lpop l 1 130 } 131 }] 132 regexp {\d+} $t1 ms1 133 regexp {\d+} $t2 ms2 134 set ratio [expr {double($ms2)/$ms1}] 135 expr {$ratio > 10 ? $ratio : 10} 136} -result {10} 137 138 139# cleanup 140::tcltest::cleanupTests 141return 142 143# Local Variables: 144# mode: tcl 145# End: 146