Tcl Library Source Code

Check-in [63590365a7]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Pulling a commit to uuid that was missed
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 63590365a7174ad1ceadb11d1803f0c2902d59de6af0c8fb796432082c995f0c
User & Date: hypnotoad 2018-12-08 18:18:13.443
Context
2019-02-20
05:39
Test fixes in assorted modules - hook: Updated to match changes in 8.6+ core error stack results. - html: Undone bad removal of some trailing whitespace. - markdown: Fixed bad name of untabify2 function, and fixed result postprocessing in tests. - math::pca is Tcl 8.6+ - string::token::shell: Updated to match result variation starting with 8.6. check-in: e6742077ec user: aku tags: trunk
2019-01-05
19:28
Create new branch named "tkt-6e778502b8" check-in: 38995cc193 user: andrewm tags: tkt-6e778502b8
2018-12-31
05:19
Experimental fix to [7554bfed30] Leaf check-in: 31f9e28d7c user: rkeene tags: fix-dns-udp-ipv6-7554bfed30
03:51
Added lazyset module check-in: 6dba867add user: rkeene tags: add-lazyset
2018-12-15
00:08
Create new branch named "tkt-fdf6afed94" check-in: 0d40e3ac79 user: andrewm tags: tkt-fdf6afed94
2018-12-08
20:05
Bringing Trunk up to date with all of the hypnotoad branch changes since the split from the pooryorick branch. check-in: 6ff9027a29 user: hypnotoad tags: hypnotoad
18:18
Pulling a commit to uuid that was missed check-in: 63590365a7 user: hypnotoad tags: trunk
18:12
Fixes to restrict Markdown to just the parts of textutil it is actually using. Fixes to httpd to map all project dependencies to the local fossil checkout on test check-in: 5fa1916707 user: hypnotoad tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to modules/uuid/pkgIndex.tcl. 
1
2

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded uuid 1.0.6 [list source [file join $dir uuid.tcl]]


|

1
2

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded uuid 1.0.7 [list source [file join $dir uuid.tcl]]
Changes to modules/uuid/uuid.tcl.
︙︙
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

  lappend machinfo [array get ::tcl_platform]

  ###
  # If we have /dev/urandom just stream 128 bits from that
  ###
  if {[file exists /dev/urandom]} {
    set fin [open /dev/urandom r]
    set machinfo [read $fin 128]
    close $fin
  } elseif {[catch {package require nettool}]} {
    # More spatial information -- better than hostname.
    # bug 1150714: opening a server socket may raise a warning messagebox
    #   with WinXP firewall, using ipconfig will return all IP addresses
    #   including ipv6 ones if available. ipconfig is OK on win98+
    if {[string equal $::tcl_platform(platform) "windows"]} {








|








44
45
46
47
48
49
50
51
52
53
54
55
56
57
58

  lappend machinfo [array get ::tcl_platform]

  ###
  # If we have /dev/urandom just stream 128 bits from that
  ###
  if {[file exists /dev/urandom]} {
    set fin [open /dev/urandom r]
    binary scan [read $fin 128] H* machinfo
    close $fin
  } elseif {[catch {package require nettool}]} {
    # More spatial information -- better than hostname.
    # bug 1150714: opening a server socket may raise a warning messagebox
    #   with WinXP firewall, using ipconfig will return all IP addresses
    #   including ipv6 ones if available. ipconfig is OK on win98+
    if {[string equal $::tcl_platform(platform) "windows"]} {
︙︙
232
233
234
235
236
237
238
239
240
241
242
243
244
245

    variable e {}
    foreach e {critcl} {
        if {[LoadAccelerator $e]} break
    }
    unset e
}

package provide uuid 1.0.6

# -------------------------------------------------------------------------
# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:








|







232
233
234
235
236
237
238
239
240
241
242
243
244
245

    variable e {}
    foreach e {critcl} {
        if {[LoadAccelerator $e]} break
    }
    unset e
}

package provide uuid 1.0.7

# -------------------------------------------------------------------------
# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:
Changes to modules/uuid/uuid.test. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

# uuid.test:  tests for the uuid package                       -*- tcl -*-
#
# $Id: uuid.test,v 1.6 2006/10/09 21:41:42 andreas_kupries Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 1.0

testing {
    useLocal uuid.tcl uuid
}

# -------------------------------------------------------------------------
# Handle multiple implementation testing












|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

# uuid.test:  tests for the uuid package                       -*- tcl -*-
#
# $Id: uuid.test,v 1.6 2006/10/09 21:41:42 andreas_kupries Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0

testing {
    useLocal uuid.tcl uuid
}

# -------------------------------------------------------------------------
# Handle multiple implementation testing
︙︙
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


foreach impl [implementations] {
    select_implementation $impl

    test uuid-1.0-$impl "uuid requires args" {
        list [catch {uuid::uuid} msg]
    } {1}
    
    test uuid-1.1-$impl "uuid generate should create a 36 char string uuid" {
        list [catch {string length [uuid::uuid generate]} msg] $msg
    } {0 36}
    
    test uuid-1.2-$impl "uuid comparison of uuid with self should be true" {
        list [catch {
            set a [uuid::uuid generate]
            uuid::uuid equal $a $a
        } msg] $msg
    } {0 1}
    
    test uuid-1.3-$impl "uuid comparison of two different\
        uuids should be false" {
        list [catch {
            set a [uuid::uuid generate]
            set b [uuid::uuid generate]
            uuid::uuid equal $a $b
        } msg] $msg
    } {0 0}
    
    reset_implementation
}

# -------------------------------------------------------------------------

testsuiteCleanup

# -------------------------------------------------------------------------
# Local Variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:








|



|






|








|













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


foreach impl [implementations] {
    select_implementation $impl

    test uuid-1.0-$impl "uuid requires args" {
        list [catch {uuid::uuid} msg]
    } {1}

    test uuid-1.1-$impl "uuid generate should create a 36 char string uuid" {
        list [catch {string length [uuid::uuid generate]} msg] $msg
    } {0 36}

    test uuid-1.2-$impl "uuid comparison of uuid with self should be true" {
        list [catch {
            set a [uuid::uuid generate]
            uuid::uuid equal $a $a
        } msg] $msg
    } {0 1}

    test uuid-1.3-$impl "uuid comparison of two different\
        uuids should be false" {
        list [catch {
            set a [uuid::uuid generate]
            set b [uuid::uuid generate]
            uuid::uuid equal $a $b
        } msg] $msg
    } {0 0}

    reset_implementation
}

# -------------------------------------------------------------------------

testsuiteCleanup

# -------------------------------------------------------------------------
# Local Variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:
This page was generated in about 0.011s by Fossil 2.27 [a6d506ecc4] 2025-07-09 13:52:53