# Adler32 checksum implementation as for RFC1950
# Copyright (C) 2004 Salvatore Sanfilippo <antirez@invece.org>
# This code is under the BSD License.

# Compute the Adler32 checksum.
# If you want to compute checksum of data in blocks
# Pass the intermediate adler value as second argument of this
# function.
proc ZlibAdler32 {data {adler 1}} {
    set s1 [expr {wide($adler)&0xffff}]
    set s2 [expr {(wide($adler)>>16)&0xffff}]
    for {set i 0} {$i < [string length $data]} {incr i} {
	binary scan [string index $data $i] c byte
	set s1 [expr {(wide($s1)+$byte)%65521}]
	set s2 [expr {(wide($s1)+$s2)%65521}]
    }
    expr {wide($s2<<16)+$s1}
}

# I obtained this test vectors using a C program implementing
# the C code there is in the RFC1950. There are no official test
# vectors apparently.
set Adler32TestVectors [list \
"Mark Adler" 13070394 \
"\x00\x01\x02\x03" 000e0007 \
"\x00\x01\x02\x03\x04\x05\x06\x07" 005c001d \
"\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f" 02b80079 \
"\x41\x41\x41\x41" 028e0105 \
"\x42\x42\x42\x42\x42\x42\x42\x42" 09500211 \
"\x43\x43\x43\x43\x43\x43\x43\x43\x43\x43\x43\x43\x43\x43\x43\x43" 23a80431 \
]

# Returns true if the test is passed.
proc ZlibAdler32Test {args} {
    set verbose 0
    if {[lindex $args 0] eq {-verbose}} {set verbose 1}
    set testnum 0
    for {set multibuf 0} {$multibuf < 2} {incr multibuf} {
	foreach {vector rightadler} $::Adler32TestVectors {
	    if {$multibuf} {
		set l [string length $vector]
		set lhalf [string range $vector 0 [expr {$l-1}]]
		set rhalf [string range $vector $l end]
		set adler [ZlibAdler32 $lhalf]
		set adler [format %08x [ZlibAdler32 $rhalf $adler]]
	    } else {
		set adler [format %08x [ZlibAdler32 $vector]]
	    }
	    if {$verbose} {
		puts -nonewline "Test $testnum: "
	    }
	    if {$rightadler eq $adler} {
		if {$verbose} {puts "PASSED"}
	    } else {
		if {$verbose} {puts "!!!ERROR!!!"}
		return 0
	    }
	    incr testnum
	}
    }
    return 1
}

ZlibAdler32Test -verbose