Tcl Library Source Code

Check-in [c17997785d]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Reworked the amazon-s3 test setup to check for and tell about the AWS authentication requirements it has.
Timelines: family | ancestors | descendants | both | test-assets
Files: files | file ages | folders
SHA3-256: c17997785dba265ca6c1ddae3848fa51a06dbc66db3cad9262e49f66480eed61
User & Date: aku 2019-06-21 05:05:01
Context
2019-06-21
05:05
sak test run - Moved table of timings to separate log file "STEM.timetable". Closed-Leaf check-in: bddd800ca6 user: aku tags: test-assets
05:05
Reworked the amazon-s3 test setup to check for and tell about the AWS authentication requirements it has. check-in: c17997785d user: aku tags: test-assets
00:04
Move many tests assets into a proper subdir of the module. check-in: af0b003dad user: andreask tags: test-assets
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/amazon-s3/S3.test.

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
...
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0



if {[catch {package require xml}]} {
    puts "    Aborting the tests found in \"[file tail [info script]]\""
    puts "    Requiring xml package, not found."
    return
}























support {
    # Requires xml (TclXML)
    useLocal xsxp.tcl xsxp
}
testing {
    useLocal S3.tcl S3
}

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

# I normally leave BucketDeletion false, because Amazon gets cranky
# if you delete a bucket and then try to recreate it any time soon.

# This may clobber files starting with the characers "S3T". Don't
# run it in a directory with such files you want.

# Put your own keys in S3-test.config.

tcltest::customMatch S3err S3ErrorMatch

tcltest::testConstraint BucketDeletion false
tcltest::testConstraint REST true
tcltest::testConstraint BucketIO true
tcltest::testConstraint ItemIO true
................................................................................
}

proc bgerror {args} {set ::S3::afterResult [list "BGERROR" $args $::errorInfo]}

# Allow easy incorporation of user's AccessID and SecretKey

proc S3loadKeys {} {
    source test-S3.config
}

namespace import ::tcltest::test

proc CleanUpBuckets {{buckets 0}} {
    S3loadKeys
    set bucket [S3::SuggestBucket TclTestS3b]






>
>






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

<
|













|







 







|







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
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2.0

testsNeed xml ; # aka TclXML, author Steve Ball, of Zveno (Australia)

if {[catch {package require xml}]} {
    puts "    Aborting the tests found in \"[file tail [info script]]\""
    puts "    Requiring xml package, not found."
    return
}

# Put your own keys into test-assets/aws-access-id, aws-secret-access_key
# -------------------------------------------------------------------------

if {![file exists [asset aws-access-id]] ||
    ![file exists [asset aws-secret-access-key]]
} {
    if {[file exists [asset no-aws]]} {
	puts "    Skipping the tests found in \"[file tail [info script]]\""
	puts "    AWS not configured by user choice."

    } else {
	puts "    Aborting the tests found in \"[file tail [info script]]\""
	puts "    AWS configuration required, missing."
	puts "    Place access id and secret key into the files"
	puts "    - [asset aws-access-id], and"
	puts "    - [asset aws-secret-access-key]"
    }
    return
}

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

support {

    useLocal xsxp.tcl xsxp ;# Here we need (tcl)xml
}
testing {
    useLocal S3.tcl S3
}

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

# I normally leave BucketDeletion false, because Amazon gets cranky
# if you delete a bucket and then try to recreate it any time soon.

# This may clobber files starting with the characers "S3T". Don't
# run it in a directory with such files you want.

# Put your own keys in test-assets/test-S3.config.

tcltest::customMatch S3err S3ErrorMatch

tcltest::testConstraint BucketDeletion false
tcltest::testConstraint REST true
tcltest::testConstraint BucketIO true
tcltest::testConstraint ItemIO true
................................................................................
}

proc bgerror {args} {set ::S3::afterResult [list "BGERROR" $args $::errorInfo]}

# Allow easy incorporation of user's AccessID and SecretKey

proc S3loadKeys {} {
    source [asset test-S3.config]
}

namespace import ::tcltest::test

proc CleanUpBuckets {{buckets 0}} {
    S3loadKeys
    set bucket [S3::SuggestBucket TclTestS3b]

Name change from modules/amazon-s3/test-S3.config to modules/amazon-s3/test-assets/test-S3.config.










1



2








S3::Configure -accesskeyid use-yours \



-secretaccesskey put-yours-here
>
>
>
>
>
>
>
>
>
|
>
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
# -*- tcl -*-
# Scope: proc S3loadkeys
    
set i [open [asset aws-access-id]         r]
set k [open [asset aws-secret-access-key] r]

set id [read $i] ; close $i
set ky [read $k] ; close $k

S3::Configure -accesskeyid $id -secretaccesskey $ky

# Memoize
proc S3loadKeys {} \
    [list S3::Configure -accesskeyid $id -secretaccesskey $ky]

Changes to modules/devtools/testutilities.tcl.

406
407
408
409
410
411
412

413
414
415
416

417
418
419
420
421
422
423
## of the Tcllib under test.

# Shorthand for access to module-local assets files for tests.
proc asset {path} {
    file join $::tcltest::testsDirectory test-assets $path
}


proc localPath {fname} {
    return [file join $::tcltest::testsDirectory $fname]
}


proc tcllibPath {fname} {
    return [file join $::tcllib::testutils::tcllib $fname]
}

proc useLocalFile {fname} {
    return [uplevel 1 [list source [localPath $fname]]]
}






>




>







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
## of the Tcllib under test.

# Shorthand for access to module-local assets files for tests.
proc asset {path} {
    file join $::tcltest::testsDirectory test-assets $path
}

# General access to module-local files
proc localPath {fname} {
    return [file join $::tcltest::testsDirectory $fname]
}

# General access to global (project-local) files
proc tcllibPath {fname} {
    return [file join $::tcllib::testutils::tcllib $fname]
}

proc useLocalFile {fname} {
    return [uplevel 1 [list source [localPath $fname]]]
}