1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
# crc32bugs.test - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sf.net>
#
# Bug finding for crc32 module.
# In particular we are looking for byte order problems, and issues between
# the trf code and tcl-only code.
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
# RCS: @(#) $Id: crc32bugs.test,v 1.5 2005/03/12 21:11:01 patthoyts Exp $
# -------------------------------------------------------------------------
# Initialise the test package
#
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import ::tcltest::*
}
# -------------------------------------------------------------------------
# Ensure we test _this_ local copy and one installed somewhere else.
#
package forget crc32
package forget crc16
catch {namespace delete ::crc}
if {[catch {source [file join [file dirname [info script]] crc32.tcl]} msg]} {
puts "skipped [file tail [info script]]: $msg"
return
}
if {[catch {source [file join [file dirname [info script]] crc16.tcl]} msg]} {
puts "skipped [file tail [info script]]: $msg"
return
}
# -------------------------------------------------------------------------
# Setup any constraints
#
# -------------------------------------------------------------------------
# Now the package specific tests....
# -------------------------------------------------------------------------
set BO $::tcl_platform(byteOrder)
if {[::crc::LoadAccelerator critcl]} {
puts "- crc32bugs [package provide crc32] (critcl based) $BO"
}
if {[::crc::LoadAccelerator trf]} {
puts "- crc32bugs [package provide crc32] (Trf based) $BO"
}
puts "- crc32bugs [package provide crc32] (pure Tcl) $BO"
# -------------------------------------------------------------------------
# Handle multiple implementation testing
#
array set preserve [array get ::crc::accel]
proc implementations {} {
variable ::crc::accel
foreach {a v} [array get accel] {if {$v} {lappend r $a}}
lappend r tcl; set r
}
proc select_implementation {impl} {
variable ::crc::accel
foreach e [array names accel] { set accel($e) 0 }
if {[string compare "tcl" $impl] != 0} {
set accel($impl) 1
}
}
proc reset_implementation {} {
variable ::crc::accel
array set accel [array get ::preserve]
}
# -------------------------------------------------------------------------
set tests {
1 "" "0"
2 "\x00" "d202ef8d"
3 "\x00\x00" "41d912ff"
4 "\x00\x00\x00" "ff41d912"
5 "\x00\x00\x00\x00" "2144df1c"
6 "\xFF" "ff000000"
7 "\xFF\xFF" "ffff0000"
8 "\xFF\xFF\xFF" "ffffff00"
9 "\xFF\xFF\xFF\xFF" "ffffffff"
10 "\x00\x00\x00\x01" "5643ef8a"
11 "\x80\x00\x00\x00" "cc1d6927"
}
foreach impl [implementations] {
select_implementation $impl
foreach {n msg expected} $tests {
test crc32bugs-$impl-1.$n "crc32 (crc32 and and crc16 comparison)" {
set r [catch {
list [::crc::crc32 -format %x $msg] \
[::crc::crc-32 -format %x $msg]
} err]
if {$r} {lappend err $::errorInfo}
list $r $err
} [list 0 [list $expected $expected]]
}
}
# -------------------------------------------------------------------------
::tcltest::cleanupTests
# Local Variables:
# mode: tcl
# indent-tabs-mode: nil
# End:
|
