Index: modules/md5/md5x.tcl ================================================================== --- modules/md5/md5x.tcl +++ modules/md5/md5x.tcl @@ -159,24 +159,34 @@ incr pad 64 } if {$pad == 0} { incr pad 64 } + + puts "P $pad|bits=[expr {8 * $state(n)}]" + append state(i) [binary format a$pad \x80] # RFC1321:3.2 - Append length in bits as little-endian wide int. append state(i) [binary format ii [expr {8 * $state(n)}] 0] + +puts DATA=[Hex $state(i)]([string length $state(i)]) # Calculate the hash for the remaining block. set len [string length $state(i)] for {set n 0} {($n + 64) <= $len} {} { MD5Hash $token [string range $state(i) $n [incr n 64]] } + + puts md5-post__________________________________________ + parray ::${token} # RFC1321:3.5 - Output set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)] unset state + + puts HASH=[Hex $r] return $r } # ------------------------------------------------------------------------- # HMAC Hashed Message Authentication (RFC 2104) @@ -255,14 +265,18 @@ # procedures and to make is a bit more comprehensible. # set ::md5::MD5Hash_body { variable $token upvar 0 $token state + + puts TR__=[Hex $msg]([string length $msg]) # RFC1321:3.4 - Process Message in 16-Word Blocks binary scan $msg i* blocks foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks { + puts BL + set A $state(A) set B $state(B) set C $state(C) set D $state(D) @@ -600,11 +614,20 @@ if {[llength $args] != 1} { return -code error "wrong # args:\ should be \"md5 ?-hex? -filename file | string\"" } set tok [MD5Init] + + puts md5_______________________________________________ + parray ::${tok} + + puts IN=(([lindex $args 0])) MD5Update $tok [lindex $args 0] + + puts md5-final_________________________________________ + parray ::${tok} + set r [MD5Final $tok] } else { set tok [MD5Init] Index: modules/md5/md5x.test ================================================================== --- modules/md5/md5x.test +++ modules/md5/md5x.test @@ -95,11 +95,12 @@ "C3FCD3D76192E4007DFB496CCA67E13B" 6 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "D174AB98D277D9F5A5611C2C9F419D9F" 7 "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57EDF4A22BE3C955AC49DA2E2107B67A" - 8 "a\$apr1\$a" "020C3DD6931F7E94ECC99A1F4E4C53E2" + 8 "a\$apr1\$a" + "020C3DD6931F7E94ECC99A1F4E4C53E2" } foreach impl [implementations] { select_implementation $impl foreach {n msg expected} $tests { test md5-v2-$impl-2.$n "md5 ($impl impl)" { Index: modules/struct/graph.man ================================================================== --- modules/struct/graph.man +++ modules/struct/graph.man @@ -1,7 +1,7 @@ -[comment {-*- tcl -*-}] -[manpage_begin struct::graph n 2.4] +[comment {-*- tcl -*-}][vset VERSION 2.4.1] +[manpage_begin struct::graph n [vset VERSION]] [keywords adjacent] [keywords arc] [keywords cgraph] [keywords degree] [keywords edge] @@ -15,11 +15,11 @@ [copyright {2002-2009 Andreas Kupries }] [moddesc {Tcl Data Structures}] [titledesc {Create and manipulate directed graph objects}] [category {Data structures}] [require Tcl 8.4] -[require struct::graph [opt 2.4]] +[require struct::graph [opt [vset VERSION]]] [require struct::list [opt 1.5]] [require struct::set [opt 2.2.3]] [description] [para] Index: modules/struct/graph.tcl ================================================================== --- modules/struct/graph.tcl +++ modules/struct/graph.tcl @@ -175,6 +175,6 @@ namespace eval ::struct { # Export the constructor command. namespace export graph } -package provide struct::graph 2.4 +package provide struct::graph 2.4.1 Index: modules/struct/graph.test ================================================================== --- modules/struct/graph.test +++ modules/struct/graph.test @@ -4,10 +4,11 @@ # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-2000 by Ajuba Solutions. +# Copyright (c) 2017-2017 Andreas Kupries # All rights reserved. # # RCS: @(#) $Id: graph.test,v 1.27 2007/04/12 03:01:54 andreas_kupries Exp $ # ------------------------------------------------------------------------- Index: modules/struct/graph/tests/walk.test ================================================================== --- modules/struct/graph/tests/walk.test +++ modules/struct/graph/tests/walk.test @@ -1,10 +1,9 @@ # -*- tcl -*- # Graph tests - walk -# Copyright (c) 2006 Andreas Kupries +# Copyright (c) 2006-2017 Andreas Kupries # All rights reserved. -# RCS: @(#) $Id: walk.test,v 1.3 2008/12/13 03:57:33 andreas_kupries Exp $ # Syntax: graph walk NODE ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd # ------------------------------------------------------------------------- # Wrong # args: Missing, Too many @@ -197,11 +196,56 @@ mygraph walk ix -dir backward -order both -command record mygraph destroy set t } [tmE {enter ix enter i enter viii enter vi enter v enter iv enter iii enter ii leave ii leave iii leave iv leave v enter vii leave vii leave vi leave viii leave i leave ix} \ {enter ix enter i enter viii enter vi enter vii leave vii enter v enter iv enter iii enter ii leave ii leave iii leave iv leave v leave vi leave viii leave i leave ix}] + +# ------------------------------------------------------------------------- + +test graph-${impl}-${setimpl}-tkt.39ab616d8f-walk-4.0 {Ticket 39ab616d8f, dfs pre-order} -setup { + SETUP + mygraph node insert a + mygraph node insert b + mygraph node insert c + mygraph arc insert a b ab + mygraph arc insert b c bc + mygraph arc insert a c ac + # /-> b -\ + # a -----> c + set t {} +} -body { + mygraph walk a -command record -dir forward -order pre -type dfs + set t +} -cleanup { + mygraph destroy + unset t +} -result [tmE {enter a enter b enter c} {enter a enter c enter b}] + +test graph-${impl}-${setimpl}-tkt.39ab616d8f-walk-4.1 {Ticket 39ab616d8f, dfs pre-order} -setup { + # This is like 4.0, with arcs ab, ac inserted in reverse + # order. This forces the Critcl implementation into the same + # situation as 4.0 does for Tcl, having c in the work stack as + # neighbour of a and then getting visited from b before reahed + # again. Passes. + SETUP + mygraph node insert a + mygraph node insert b + mygraph node insert c + mygraph arc insert a c ac + mygraph arc insert a b ab + mygraph arc insert b c bc + # /-> b -\ + # a -----> c + set t {} +} -body { + mygraph walk a -command record -dir forward -order pre -type dfs + set t +} -cleanup { + mygraph destroy + unset t +} -result [tmE {enter a enter c enter b} {enter a enter b enter c}] # ------------------------------------------------------------------------- rename record {} # ------------------------------------------------------------------------- Index: modules/struct/graph_tcl.tcl ================================================================== --- modules/struct/graph_tcl.tcl +++ modules/struct/graph_tcl.tcl @@ -2765,10 +2765,14 @@ while { [llength $st] > 0 } { set node [lindex $st end] ldelete st end + # Skip all nodes already visited via some other path + # through the graph. + if {[info exists visited($node)]} continue + # Evaluate the command at this node set cmdcpy $cmd lappend cmdcpy enter $name $node uplevel 1 $cmdcpy Index: modules/struct/pkgIndex.tcl ================================================================== --- modules/struct/pkgIndex.tcl +++ modules/struct/pkgIndex.tcl @@ -17,7 +17,7 @@ package ifneeded struct::tree 1.2.2 [list source [file join $dir tree1.tcl]] package ifneeded struct::matrix 1.2.1 [list source [file join $dir matrix1.tcl]] if {![package vsatisfies [package provide Tcl] 8.4]} {return} package ifneeded struct::list 1.8.3 [list source [file join $dir list.tcl]] -package ifneeded struct::graph 2.4 [list source [file join $dir graph.tcl]] +package ifneeded struct::graph 2.4.1 [list source [file join $dir graph.tcl]] package ifneeded struct::graph::op 0.11.3 [list source [file join $dir graphops.tcl]]