OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [stringObj.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Commands covered: none
2 
#
3 
# This file contains tests for the procedures in tclStringObj.c
4 
# that implement the Tcl type manager for the string type.
5 
#
6 
# Sourcing this file into Tcl runs the tests and generates output for
7 
# errors. No output means no errors were found.
8 
#
9 
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
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 
#
14 
# RCS: @(#) $Id: stringObj.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
15 
 
16 
if {[info commands testobj] == {}} {
17 
    puts "This application hasn't been compiled with the \"testobj\""
18 
    puts "command, so I can't test the Tcl type and object support."
19 
    return
20 
}
21 
 
22 
if {[string compare test [info procs test]] == 1} then {source defs}
23 
 
24 
test stringObj-1.1 {string type registration} {
25 
    set t [testobj types]
26 
    set first [string first "string" $t]
27 
    set result [expr {$first != -1}]
28 
} {1}
29 
 
30 
test stringObj-2.1 {Tcl_NewStringObj} {
31 
    set result ""
32 
    lappend result [testobj freeallvars]
33 
    lappend result [teststringobj set 1 abcd]
34 
    lappend result [testobj type 1]
35 
    lappend result [testobj refcount 1]
36 
} {{} abcd string 2}
37 
 
38 
test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} {
39 
    set result ""
40 
    lappend result [testobj freeallvars]
41 
    lappend result [testobj newobj 1]
42 
    lappend result [teststringobj set 1 xyz] ;# makes existing obj a string
43 
    lappend result [testobj type 1]
44 
    lappend result [testobj refcount 1]
45 
} {{} {} xyz string 2}
46 
test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} {
47 
    set result ""
48 
    lappend result [testobj freeallvars]
49 
    lappend result [testintobj set 1 512]
50 
    lappend result [teststringobj set 1 foo]  ;# makes existing obj a string
51 
    lappend result [testobj type 1]
52 
    lappend result [testobj refcount 1]
53 
} {{} 512 foo string 2}
54 
 
55 
test stringObj-4.1 {Tcl_SetObjLength procedure, string gets shorter} {
56 
    testobj freeallvars
57 
    teststringobj set 1 test
58 
    teststringobj setlength 1 3
59 
    list [teststringobj length 1] [teststringobj length2 1] \
60 
            [teststringobj get 1]
61 
} {3 4 tes}
62 
test stringObj-4.2 {Tcl_SetObjLength procedure, string gets longer} {
63 
    testobj freeallvars
64 
    teststringobj set 1 abcdef
65 
    teststringobj setlength 1 10
66 
    list [teststringobj length 1] [teststringobj length2 1]
67 
} {10 10}
68 
test stringObj-4.3 {Tcl_SetObjLength procedure, string gets longer} {
69 
    testobj freeallvars
70 
    teststringobj set 1 abcdef
71 
    teststringobj append 1 xyzq -1
72 
    list [teststringobj length 1] [teststringobj length2 1] \
73 
            [teststringobj get 1]
74 
} {10 20 abcdefxyzq}
75 
test stringObj-4.4 {Tcl_SetObjLength procedure, "expty string", length 0} {
76 
    testobj freeallvars
77 
    testobj newobj 1
78 
    teststringobj setlength 1 0
79 
    list [teststringobj length2 1] [teststringobj get 1]
80 
} {0 {}}
81 
 
82 
test stringObj-5.1 {Tcl_AppendToObj procedure, type conversion} {
83 
    testobj freeallvars
84 
    testintobj set2 1 43
85 
    teststringobj append 1 xyz -1
86 
    teststringobj get 1
87 
} {43xyz}
88 
test stringObj-5.2 {Tcl_AppendToObj procedure, length calculation} {
89 
    testobj freeallvars
90 
    teststringobj set 1 {x y }
91 
    teststringobj append 1 bbCCddEE 4
92 
    teststringobj append 1 123 -1
93 
    teststringobj get 1
94 
} {x y bbCC123}
95 
test stringObj-5.3 {Tcl_AppendToObj procedure, reallocating space} {
96 
    testobj freeallvars
97 
    teststringobj set 1 xyz
98 
    teststringobj setlength 1 15
99 
    teststringobj setlength 1 2
100 
    set result {}
101 
    teststringobj append 1 1234567890123 -1
102 
    lappend result [teststringobj length 1] [teststringobj length2 1]
103 
    teststringobj setlength 1 10
104 
    teststringobj append 1 abcdef -1
105 
    lappend result [teststringobj length 1] [teststringobj length2 1] \
106 
            [teststringobj get 1]
107 
} {15 15 16 32 xy12345678abcdef}
108 
 
109 
test stringObj-6.1 {Tcl_AppendStringsToObj procedure, type conversion} {
110 
    testobj freeallvars
111 
    teststringobj set2 1 [list a b]
112 
    teststringobj appendstrings 1 xyz { 1234 } foo
113 
    teststringobj get 1
114 
} {a bxyz 1234 foo}
115 
test stringObj-6.2 {Tcl_AppendStringsToObj procedure, counting space} {
116 
    testobj freeallvars
117 
    teststringobj set 1 abc
118 
    teststringobj appendstrings 1
119 
    list [teststringobj length 1] [teststringobj get 1]
120 
} {3 abc}
121 
test stringObj-6.3 {Tcl_AppendStringsToObj procedure, counting space} {
122 
    testobj freeallvars
123 
    teststringobj set 1 abc
124 
    teststringobj appendstrings 1 {} {} {} {}
125 
    list [teststringobj length 1] [teststringobj get 1]
126 
} {3 abc}
127 
test stringObj-6.4 {Tcl_AppendStringsToObj procedure, counting space} {
128 
    testobj freeallvars
129 
    teststringobj set 1 abc
130 
    teststringobj appendstrings 1 { 123 } abcdefg
131 
    list [teststringobj length 1] [teststringobj get 1]
132 
} {15 {abc 123 abcdefg}}
133 
test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} {
134 
    testobj freeallvars
135 
    testobj newobj 1
136 
    teststringobj appendstrings 1 123 abcdefg
137 
    list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
138 
} {10 10 123abcdefg}
139 
test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} {
140 
    testobj freeallvars
141 
    teststringobj set 1 abc
142 
    teststringobj setlength 1 10
143 
    teststringobj setlength 1 2
144 
    teststringobj appendstrings 1 34567890
145 
    list [teststringobj length 1] [teststringobj length2 1] \
146 
            [teststringobj get 1]
147 
} {10 10 ab34567890}
148 
test stringObj-6.7 {Tcl_AppendStringsToObj procedure, space reallocation} {
149 
    testobj freeallvars
150 
    teststringobj set 1 abc
151 
    teststringobj setlength 1 10
152 
    teststringobj setlength 1 2
153 
    teststringobj appendstrings 1 34567890x
154 
    list [teststringobj length 1] [teststringobj length2 1] \
155 
            [teststringobj get 1]
156 
} {11 22 ab34567890x}
157 
test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} {
158 
    testobj freeallvars
159 
    testobj newobj 1
160 
    teststringobj appendstrings 1 {}
161 
    list [teststringobj length2 1] [teststringobj get 1]
162 
} {0 {}}
163 
 
164 
test stringObj-7.1 {ConvertToStringType procedure} {
165 
    testobj freeallvars
166 
    teststringobj set2 1 [list a b]
167 
    teststringobj append 1 x -1
168 
    list [teststringobj length 1] [teststringobj length2 1] \
169 
            [teststringobj get 1]
170 
} {4 8 {a bx}}
171 
test stringObj-7.2 {ConvertToStringType procedure, null object} {
172 
    testobj freeallvars
173 
    testobj newobj 1
174 
    teststringobj appendstrings 1 {}
175 
    list [teststringobj length 1] [teststringobj length2 1] \
176 
            [teststringobj get 1]
177 
} {0 0 {}}
178 
 
179 
test stringObj-8.1 {DupStringInternalRep procedure} {
180 
    testobj freeallvars
181 
    teststringobj set 1 {}
182 
    teststringobj append 1 abcde -1
183 
    testobj duplicate 1 2
184 
    list [teststringobj length 1] [teststringobj length2 1] \
185 
            [teststringobj length 2] [teststringobj length2 2] \
186 
            [teststringobj get 2]
187 
} {5 10 5 5 abcde}
188 
 
189 
testobj freeallvars

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.