Tcl Library Source Code

Changes On Branch ticket-266d1474a5
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki
Hide Diff Patch Side-by-Side Diff

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

Changes In Branch ticket-266d1474a5 Excluding Merge-Ins

This is equivalent to a diff from fe05de3454 to 9ec8eebe58

2015-06-08
19:46
Per ticket [266d1474a5], modified calls for info command to info commands (to better match the Tcl docs) The following packages were modified: base64/uuencode, base64/yencode, crc/crc32, crc/sum, dns/spf, ftp/ftp_geturl, ftpd/ftpd, md4/md4, md5/md5x, nettool/nettool, nettool/platform_windows, processman/processman, ripemd/ripemd128, ripemd/ripemd160, sha1/sha1, sha1/sha1v1, sha1/sha256, textutil/expander, uuid/uuid Per ticket [91d3bd90fd], modified the package name for odie::processman to processman. The processman.tcl file now provides two packages: odie::processman and processman. At some point after users have transitioned, we will yank the old package name. check-in: 272b6e8ee1 user: hypnotoad tags: trunk
14:45
Added a backward compatible alias to odie::processman from processman.tcl Closed-Leaf check-in: 9ec8eebe58 user: hypnotoad tags: ticket-266d1474a5
13:58
Fixed cases where calls to info commands were expressed as info command. Ticket [266d1474a5] Renamed the odie::processman package to processman, as it no longer depends on odie. Ticket [91d3bd90fd] check-in: 1b6fa7e91f user: hypnotoad tags: ticket-266d1474a5
2015-06-04
21:14
pt - Ticket [4a4e443ce9]. Created investigation branch. Putting example into the testsuite. check-in: 9034b39a70 user: andreask tags: tkt-4a4e443ce9-pt-oo-fail
07:05
Updated to trunk check-in: 9c08dc083b user: aku tags: tkt-785d2954d4-jsonc
07:02
Ticket [14e3acd8d7] - Modified sak.tcl's "critcl" command to use an explicit cache directory, ".critcl" under the build directory (CWD), for building Tcllib's critcl parts. check-in: fe05de3454 user: aku tags: trunk
2015-06-02
00:55
fileutil - Ticket [acd8c27943] - Fixed file-type detection for PDF files, While most are "binary", they can be "text", Version bumped to 1.14.11. Extended testsuite. check-in: 2b866cf322 user: aku tags: trunk

Changes to modules/base64/uuencode.tcl.

︙
157
158
159
160
161
162
163
164

165
166
167
168
169
170
171

157
158
159
160
161
162
163

164
165
166
167
168
169
170
171








-
+








    return $s
}

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

# If the Trf package is available then we shall use this by default but the
# Tcllib implementations are always visible if needed (ie: for testing)
if {[info command ::uuencode::CDecode] != {}} {    
if {[info commands ::uuencode::CDecode] != {}} {    
    # tcllib critcl package
    interp alias {} ::uuencode::encode {} ::uuencode::CEncode
    interp alias {} ::uuencode::decode {} ::uuencode::CDecode
} elseif {[package provide Trf] != {}} {
    proc ::uuencode::encode {s} {
        return [::uuencode -mode encode -- $s]
    }
︙

Changes to modules/base64/yencode.tcl.

︙
137
138
139
140
141
142
143
144

145
146
147
148
149
150
151

137
138
139
140
141
142
143

144
145
146
147
148
149
150
151








-
+








            Tcl_SetByteArrayLength(resultPtr, rlen);
            Tcl_SetObjResult(interp, resultPtr);
            return TCL_OK;
        }
    }
}

if {[info command ::yencode::CEncode] != {}} {
if {[info commands ::yencode::CEncode] != {}} {
    interp alias {} ::yencode::encode {} ::yencode::CEncode
    interp alias {} ::yencode::decode {} ::yencode::CDecode
} else {
    interp alias {} ::yencode::encode {} ::yencode::Encode
    interp alias {} ::yencode::decode {} ::yencode::Decode
}
︙

Changes to modules/crc/crc32.tcl.

︙
259
260
261
262
263
264
265
266

267
268
269
270
271
272
273

259
260
261
262
263
264
265

266
267
268
269
270
271
272
273








-
+








proc ::crc::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require crcc}]} {
                set r [expr {[info command ::crc::Crc32_c] != {}}]
                set r [expr {[info commands ::crc::Crc32_c] != {}}]
            }
        }
        trf {
            if {![catch {package require Trf}]} {
                set r [expr {![catch {::crc-zlib aa} msg]}]
            }
        }
︙

Changes to modules/crc/sum.tcl.

︙
126
127
128
129
130
131
132
133

134
135
136
137
138
139

140
141
142
143
144
145
146

126
127
128
129
130
131
132

133
134
135
136
137
138

139
140
141
142
143
144
145
146








-
+





-
+








        }
    }
}

# -------------------------------------------------------------------------
# Switch from pure tcl to compiled if available.
#
if {[info command ::crc::SumBsd_c] == {}} {
if {[info commands ::crc::SumBsd_c] == {}} {
    interp alias {} ::crc::sum-bsd  {} ::crc::SumBsd
} else {
    interp alias {} ::crc::sum-bsd  {} ::crc::SumBsd_c
}

if {[info command ::crc::SumSysV_c] == {}} {
if {[info commands ::crc::SumSysV_c] == {}} {
    interp alias {} ::crc::sum-sysv {} ::crc::SumSysV
} else {
    interp alias {} ::crc::sum-sysv {} ::crc::SumSysV_c
}

# -------------------------------------------------------------------------
# Description:
︙

Changes to modules/crc/sum.test.

︙
19
20
21
22
23
24
25
26

27
28
29
30
31
32
33

19
20
21
22
23
24
25

26
27
28
29
30
31
32
33








-
+









testing {
    useLocal sum.tcl sum ::crc
}

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

if {[info command ::crc::SumBsd_c] == {}} {
if {[info commands ::crc::SumBsd_c] == {}} {
    puts "> pure tcl"
} else {    
    puts "> critcl based"
}

# -------------------------------------------------------------------------
︙

Changes to modules/dns/spf.tcl.

︙
100
101
102
103
104
105
106
107

108
109
110
111
112
113
114

100
101
102
103
104
105
106

107
108
109
110
111
112
113
114








-
+








        } else {
            set prefix "+"
        }

        set cmd [string tolower [lindex [split $directive {:/=}] 0]]
        set param [string range $directive [string length $cmd] end]

        if {[info command ::spf::_$cmd] == {}} {
        if {[info commands ::spf::_$cmd] == {}} {
            # 6.1 Unrecognised directives terminate processing
            #     but unknown modifiers are ignored.
            if {[string match "=*" $param]} {
                continue
            } else {
                set result unknown
                break
︙
441
442
443
444
445
446
447
448

449
450
451
452
453
454
455

441
442
443
444
445
446
447

448
449
450
451
452
453
454
455








-
+








# -------------------------------------------------------------------------
#
# DNS helper procedures.
#
# -------------------------------------------------------------------------

proc ::spf::Resolve {domain type resultproc} {
    if {[info command $resultproc] == {}} {
    if {[info commands $resultproc] == {}} {
        return -code error "invalid arg: \"$resultproc\" must be a command"
    }
    set tok [dns::resolve $domain -type $type]
    dns::wait $tok
    set errorcode NONE
    if {[string equal [dns::status $tok] "ok"]} {
        set result [$resultproc $tok]
︙

Changes to modules/ftp/ftp_geturl.tcl.

︙
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66

52
53
54
55
56
57
58

59
60
61
62
63
64
65
66








-
+








    if { $result == 0 } {
	ftp::Close $fdc
	return -code error "Cannot reach directory of url \"$url\""
    }

    # Fix for the tkcon List enhancements in ftp.tcl
    set List ::ftp::List_org
    if {[info command $List] == {}} {
    if {[info commands $List] == {}} {
        set List ::ftp::List 
    }

    # The result of List is a list of entries in the given directory.
    # Note that it is in 'ls -l format. We parse that into a more
    # readable array.
︙

Changes to modules/ftpd/ftpd.tcl.

︙
554
555
556
557
558
559
560
561

562
563
564
565
566
567
568

554
555
556
557
558
559
560

561
562
563
564
565
566
567
568








-
+








                } else {
                    puts $sock "530 Please login with USER and PASS."
		}
	    } elseif {($data(access) == 0) && (![string equal $cmd "PASS"]) \
                    && (![string equal $cmd "USER"]) \
                    && (![string equal $cmd "QUIT"])} {
                puts $sock "530 Please login with USER and PASS."
	    } elseif {[info command ::ftpd::command::$cmd] != ""} {
	    } elseif {[info commands ::ftpd::command::$cmd] != ""} {
		Log debug $command
		::ftpd::command::$cmd $sock $argument
		catch {flush $sock}
	    } else {
		Log error "Unknown command: $cmd"
		puts $sock "500 Unknown command $cmd"
	    }
︙

Changes to modules/md4/md4.tcl.

︙
373
374
375
376
377
378
379
380

381
382
383
384
385
386
387

373
374
375
376
377
378
379

380
381
382
383
384
385
386
387








-
+








proc ::md4::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require md4c}]} {
                set r [expr {[info command ::md4::md4c] != {}}]
                set r [expr {[info commands ::md4::md4c] != {}}]
            }
        }
        cryptkit {
            if {![catch {package require cryptkit}]} {
                set r [expr {![catch {cryptkit::cryptInit}]}]
            }
        }
︙

Changes to modules/md5/md5x.tcl.

︙
517
518
519
520
521
522
523
524

525
526
527
528
529
530
531

517
518
519
520
521
522
523

524
525
526
527
528
529
530
531








-
+








proc ::md5::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require md5c}]} {
                set r [expr {[info command ::md5::md5c] != {}}]
                set r [expr {[info commands ::md5::md5c] != {}}]
            }
        }
        cryptkit {
            if {![catch {package require cryptkit}]} {
                set r [expr {![catch {cryptkit::cryptInit}]}]
            }
        }
︙

Changes to modules/md5crypt/md5crypt.test.

︙
24
25
26
27
28
29
30
31

32
33
34
35

36
37
38
39
40
41
42

24
25
26
27
28
29
30

31
32
33
34

35
36
37
38
39
40
41
42








-
+



-
+









# -------------------------------------------------------------------------
# Setup any constraints

# Set this true if we have the critcl version.

::tcltest::testConstraint md5crypt_c \
        [llength [info command ::md5crypt::md5crypt_c]]
        [llength [info commands ::md5crypt::md5crypt_c]]

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

if {[llength [info command ::md5crypt::md5crypt_c]]} {
if {[llength [info commands ::md5crypt::md5crypt_c]]} {
    puts "> critcl based"
    set impl critcl
} else {
    puts "> pure Tcl"
    set impl tcl
}
︙

Changes to modules/nettool/nettool.tcl. 

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

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











-
+












-
+








-
+








# @mdgen OWNER: generic.tcl
# @mdgen OWNER: available_ports.tcl
# @mdgen OWNER: locateport.tcl
# @mdgen OWNER: platform_*.tcl
package provide nettool 0.4

package require platform
# Uses the "ip" package from tcllib
package require ip

if {[info command ::ladd] eq {}} {
if {[info commands ::ladd] eq {}} {
  proc ::ladd {varname args} {
    upvar 1 $varname var
    if ![info exists var] {
        set var {}
    }
    foreach item $args {
      if {$item in $var} continue
      lappend var $item
    }
    return $var
  }
}
if {[info command ::get] eq {}} {
if {[info commands ::get] eq {}} {
  proc ::get varname {
    upvar 1 $varname var
    if {[info exists var]} {
      return [set var]
    }
    return {}
  }
}
if {[info command ::cat] eq {}} {
if {[info commands ::cat] eq {}} {
  proc ::cat filename {
    set fin [open $filename r]
    set dat [read $fin]
    close $fin
    return $dat
  }
}
︙

Changes to modules/nettool/platform_windows.tcl.

︙
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83

69
70
71
72
73
74
75

76
77
78
79
80
81
82
83








-
+








set body {}
if {[::twapi::get_ip_addresses] ne {}} {
  set body {
  set result [::twapi::get_ip_addresses]
  ldelete result 127.0.0.1
  return $result
} 
} elseif {[info command ::twapi::get_system_ipaddrs] ne {}} {
} elseif {[info commands ::twapi::get_system_ipaddrs] ne {}} {
# They changed commands names on me...
  set body {
  set result [::twapi::get_system_ipaddrs]
  ldelete result 127.0.0.1
  return $result
}
}
︙

Changes to modules/processman/pkgIndex.tcl. 

1
2
3
4
5
6
7
8
9
10
11


1
2
3
4
5
6
7
8
9
10
11
12












+

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded odie::processman 0.3 [list source [file join $dir processman.tcl]]
package ifneeded processman 0.3 [list source [file join $dir processman.tcl]]

Changes to modules/processman/processman.tcl. 

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

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





-














-
+











-
+





-
+








###
# IRM External Process Manager
###

package provide odie::processman 0.3
package require cron 1.1

::namespace eval ::processman {}

if { $::tcl_platform(platform) eq "windows" } {
  package require twapi
} else {
  ###
  # Try to utilize C level utilities that are bundled
  # with either TclX or Odielib
  ###
  if [catch {package require odielib}] {
    catch {package require Tclx}
  }
  if {[info command subprocess_exists] eq {}} {
  if {[info commands subprocess_exists] eq {}} {
    proc ::processman::subprocess_exists pid {
      set dat [exec ps]
      foreach line [split $dat \n] {
        if {![scan $line "%d %s" thispid rest]} continue
        if { $thispid eq $pid} {
          return $thispid
        }
      }
      return 0
    }
  }
  if {[info command kill_subprocess] eq {}} {
  if {[info commands kill_subprocess] eq {}} {
    proc ::processman::kill_subprocess pid {
      catch {exec kill $pid}
    }
  }
}
if {[info command harvest_zombies] eq {}} {
if {[info commands harvest_zombies] eq {}} {
  proc ::processman::harvest_zombies args {
  }
}

###
# topic: a0cdb7503872cd302756c732956cd5c3
# title: Periodic scan of the state of processes
︙
263
264
265
266
267
268
269



262
263
264
265
266
267
268
269
270








+
+

if {![info exists process_binding]} {
  set process_binding {}
}
}

::cron::every processman 60 ::processman::events

package provide odie::processman 0.3
package provide processman 0.3

Changes to modules/ripemd/ripemd128.tcl.

︙
522
523
524
525
526
527
528
529

530
531
532
533
534
535
536

522
523
524
525
526
527
528

529
530
531
532
533
534
535
536








-
+








proc ::ripemd::ripemd128::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        #critcl {
        #    if {![catch {package require tcllibc}]
        #        || ![catch {package require sha1c}]} {
        #        set r [expr {[info command ::sha1::sha1c] != {}}]
        #        set r [expr {[info commands ::sha1::sha1c] != {}}]
        #    }
        #}
        #cryptkit {
        #    if {![catch {package require cryptkit}]} {
        #        set r [expr {![catch {cryptkit::cryptInit}]}]
        #    }
        #}
︙

Changes to modules/ripemd/ripemd160.tcl.

︙
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669

655
656
657
658
659
660
661

662
663
664
665
666
667
668
669








-
+








proc ::ripemd::ripemd160::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        #critcl {
        #    if {![catch {package require tcllibc}]
        #        || ![catch {package require sha1c}]} {
        #        set r [expr {[info command ::sha1::sha1c] != {}}]
        #        set r [expr {[info commands ::sha1::sha1c] != {}}]
        #    }
        #}
        cryptkit {
            if {![catch {package require cryptkit}]} {
                set r [expr {![catch {cryptkit::cryptInit}]}]
            }
        }
︙

Changes to modules/sha1/sha1.tcl.

︙
58
59
60
61
62
63
64
65

66
67
68
69
70
71
72

58
59
60
61
62
63
64

65
66
67
68
69
70
71
72








-
+








        tcl {
            # Already present (this file)
            set r 1
        }
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require sha1c}]} {
                set r [expr {[info command ::sha1::sha1c] != {}}]
                set r [expr {[info commands ::sha1::sha1c] != {}}]
            }
        }
        cryptkit {
            if {![catch {package require cryptkit}]} {
                set r [expr {![catch {cryptkit::cryptInit}]}]
            }
        }
︙

Changes to modules/sha1/sha1v1.tcl.

︙
500
501
502
503
504
505
506
507

508
509
510
511
512
513
514

500
501
502
503
504
505
506

507
508
509
510
511
512
513
514








-
+








proc ::sha1::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require sha1c}]} {
                set r [expr {[info command ::sha1::sha1c] != {}}]
                set r [expr {[info commands ::sha1::sha1c] != {}}]
            }
        }
        cryptkit {
            if {![catch {package require cryptkit}]} {
                set r [expr {![catch {cryptkit::cryptInit}]}]
            }
        }
︙

Changes to modules/sha1/sha256.tcl.

︙
80
81
82
83
84
85
86
87

88
89
90
91
92
93
94

80
81
82
83
84
85
86

87
88
89
90
91
92
93
94








-
+








        tcl {
            # Already present (this file)
            set r 1
        }
        critcl {
            if {![catch {package require tcllibc}]
                || ![catch {package require sha256c}]} {
                set r [expr {[info command ::sha2::sha256c_update] != {}}]
                set r [expr {[info commands ::sha2::sha256c_update] != {}}]
            }
        }
        default {
            return -code error "invalid accelerator $key:\
                must be one of [join [KnownImplementations] {, }]"
        }
    }
︙

Changes to modules/snit/snit.test.

︙
329
330
331
332
333
334
335
336

337
338
339
340
341
342
343

329
330
331
332
333
334
335

336
337
338
339
340
341
342
343








-
+








} -result {0}

test typedestruction-1.4 {type proc is destroyed on error} -body {
    catch {type dog {
        error "Error creating dog"
    }} result

    list [namespace exists ::dog] [info command ::dog]
    list [namespace exists ::dog] [info commands ::dog]
} -result {0 {}}

test typedestruction-1.5 {unrelated namespaces are deleted, bug 2898640} -body {
    type dog {}
    namespace eval dog::unrelated {}
    dog destroy
} -result {}
︙
446
447
448
449
450
451
452
453

454
455
456
457
458
459
460

446
447
448
449
450
451
452

453
454
455
456
457
458
459
460








-
+








        type dog {
            typeconstructor {
                error "Error creating dog"
            }
        }
    } result

    list [namespace exists ::dog] [info command ::dog]
    list [namespace exists ::dog] [info commands ::dog]
} -result {0 {}}

#-----------------------------------------------------------------------
# Type components

test typecomponent-1.1 {typecomponent defines typevariable} -body {
    type dog {
︙

Changes to modules/textutil/expander.tcl.

︙
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97

83
84
85
86
87
88
89

90
91
92
93
94
95
96
97








-
+








            append ns "::"
        }
        
        set name "$ns$name"
    }

    # NEXT, Check the name
    if {"" != [info command $name]} {
    if {"" != [info commands $name]} {
        return -code error "command name \"$name\" already exists"
    }

    # NEXT, Create the object.
    proc $name {method args} [format {
        if {[catch {::textutil::expander::Methods %s $method $args} result]} {
            return -code error $result
︙

Changes to modules/uuid/uuid.tcl.

︙
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213

199
200
201
202
203
204
205

206
207
208
209
210
211
212
213








-
+








#
proc ::uuid::LoadAccelerator {name} {
    variable accel
    set r 0
    switch -exact -- $name {
        critcl {
            if {![catch {package require tcllibc}]} {
                set r [expr {[info command ::uuid::generate_c] != {}}]
                set r [expr {[info commands ::uuid::generate_c] != {}}]
            }
        }
        default {
            return -code error "invalid accelerator package:\
                must be one of [join [array names accel] {, }]"
        }
    }
︙

This page was generated in about 0.068s by Fossil 2.25 [c09fea3299] 2024-05-08 11:59:18