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