Persistent Arrays

Check-in [cdd4169663]
Login

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

Overview
Comment:json serialization for multi arrays. Test suite updates.
Timelines: family | ancestors | descendants | both | serializations
Files: files | file ages | folders
SHA1:cdd41696633ab70f067d41e5032eb39bc542742c
User & Date: andreask 2013-05-24 23:51:55
Context
2013-05-24
23:52
Bring basic serialization back to main. check-in: 2892e4aeb3 user: andreask tags: trunk
23:51
json serialization for multi arrays. Test suite updates. Leaf check-in: cdd4169663 user: andreask tags: serializations
22:58
Cleaned up the multi array doc and implementation. No functional changes. check-in: 90ef193e4f user: andreask tags: serializations
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added multi-serial-json-extended.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
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
# -*- tcl -*-
## (c) 2013 Andreas Kupries
# # ## ### ##### ######## ############# #####################

## Commands to convert 'base' arrays into json and back.
## The intermediate representation is a Tcl dictionary.
## This package generates an 'extended' representation (compared to
## 'json-simple'). The form contains additional information, namely
## type data, user identification, timestamp, and checksum around the
## simple data.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require json
package require json::write ; # config (indented|aligned) is left to user.
package require md5 2

namespace eval ::phash::multi::serial::json-extended {}

# # ## ### ##### ######## ############# #####################
## API Implementation

proc ::phash::multi::serial::json-extended::generate {dict {type {}} {user {}} {when {}}} {
    if {$type eq {}} { set type array::base }
    if {$user eq {}} { set user $::tcl_platform(user) }
    if {$when eq {}} { set when [clock seconds] }

    set when   [clock format $when -gmt 1 -format {%Y-%m-%dT%H:%M:%S}]
    set sorted [DictSort2 $dict]

    return [json::write::object \
		check [json::write::string [Checksum $sorted type $type user $user when $when]] \
		data  [json::write::object {*}[Process2 $sorted]] \
		type  [json::write::string $type] \
		user  [json::write::string $user] \
		when  [json::write::string $when]]
}

proc ::phash::multi::serial::json-extended::parse {json} {
}

# # ## ### ##### ######## ############# #####################
## Internal support.

proc ::phash::multi::serial::json-extended::Checksum {dict args} {
    set s {}
    foreach {k v} $dict {
	append s "[string length $k] $k [llength $v]\n"
	foreach item $v {
	    append s "[string length $item] $item\n"
	}
    }
    foreach item $args {
	append s "[string length $item] $item\n"
    }
    return [string tolower [md5::md5 -hex -- $s]]
}

proc ::phash::multi::serial::json-extended::Process2 {dict} {
    set tmp {}
    foreach {k v} $dict {
	lappend tmp $k [json::write::object {*}[Process $v]]
    }
    return $tmp
}

proc ::phash::multi::serial::json-extended::Process {dict} {
    set tmp {}
    foreach {k v} $dict {
	lappend tmp $k [json::write::string $v]
    }
    return $tmp
}

proc ::phash::multi::serial::json-extended::DictSort2 {dict} {
    set tmp {}
    foreach k [lsort -dict [dict keys $dict]] {
	lappend tmp $k [DictSort [dict get $dict $k]]
    }
    return $tmp
}

proc ::phash::multi::serial::json-extended::DictSort {dict} {
    set tmp {}
    foreach k [lsort -dict [dict keys $dict]] {
	lappend tmp $k [dict get $dict $k]
    }
    return $tmp
}

# # ## ### ##### ######## ############# #####################
## Publish API

namespace eval ::phash::multi::serial::json-extended {
    namespace export generate parse
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide phash::multi::serial::json-extended 0
return

Added multi-serial-json-simple.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
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
# -*- tcl -*-
## (c) 2013 Andreas Kupries
# # ## ### ##### ######## ############# #####################

## Commands to convert 'base' arrays into json and back.
## The intermediate representation is a Tcl dictionary.
## This package generates a simple json representation, just
## mapping keys and vaues into a single JSON object.

# # ## ### ##### ######## ############# #####################
## Requisites

package require Tcl 8.5
package require json
package require json::write ; # config (indented|aligned) is left to user.

namespace eval ::phash::multi::serial::json-simple {}

# # ## ### ##### ######## ############# #####################
## API Implementation

proc ::phash::multi::serial::json-simple::generate {dict} {
    # dict (doc --> (key --> value)) !nested dict
    return [json::write::object {*}[Process2 [DictSort2 $dict]]]
}

proc ::phash::multi::serial::json-simple::parse {json} {
}

# # ## ### ##### ######## ############# #####################
## Internal support.

proc ::phash::multi::serial::json-simple::Process2 {dict} {
    set tmp {}
    foreach {k v} $dict {
	lappend tmp $k [json::write::object {*}[Process $v]]
    }
    return $tmp
}

proc ::phash::multi::serial::json-simple::Process {dict} {
    set tmp {}
    foreach {k v} $dict {
	lappend tmp $k [json::write::string $v]
    }
    return $tmp
}

proc ::phash::multi::serial::json-simple::DictSort2 {dict} {
    set tmp {}
    foreach k [lsort -dict [dict keys $dict]] {
	lappend tmp $k [DictSort [dict get $dict $k]]
    }
    return $tmp
}

proc ::phash::multi::serial::json-simple::DictSort {dict} {
    set tmp {}
    foreach k [lsort -dict [dict keys $dict]] {
	lappend tmp $k [dict get $dict $k]
    }
    return $tmp
}

# # ## ### ##### ######## ############# #####################
## Publish API

namespace eval ::phash::multi::serial::json-simple {
    namespace export generate parse
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################
## Ready
package provide phash::multi::serial::json-simple 0
return

Changes to multi.tcl.

92
93
94
95
96
97
98












99
100
101
102
103
104
105
    method unset {{pattern *}} { my APIerror unset }

    # unsetv: key --> ()
    method unsetv {key} { my APIerror unsetv }

    # clear: () --> ()
    method clear {} { my APIerror clear }













    # # ## ### ##### ######## #############
    ## Internal helpers

    method Error {text args} {
	return -code error -errorcode [list PHASH {*}$args] $text
    }







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







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
    method unset {{pattern *}} { my APIerror unset }

    # unsetv: key --> ()
    method unsetv {key} { my APIerror unsetv }

    # clear: () --> ()
    method clear {} { my APIerror clear }

    # # ## ### ##### ######## #############
    ## (De)serialization.

    method export {format args} {
	package require phash::multi::serial::$format
	set all {}
	foreach doc [my names] {
	    dict set all $doc [my _get $doc]
	}
	return [phash::multi::serial::$format generate $all {*}$args]
    }

    # # ## ### ##### ######## #############
    ## Internal helpers

    method Error {text args} {
	return -code error -errorcode [list PHASH {*}$args] $text
    }

Changes to tests/multi-memory.test.

3
4
5
6
7
8
9



10
11
12


13
14
15
16
17
18
19
# # ## ### ##### ######## ############# #####################
## memory.test:  tests for the phash::multi::memory package.

kt check Tcl     8.5
kt check tcltest 2

kt require support TclOO




kt local   support phash
kt local   support phash::multi


kt local   testing phash::multi::memory

# # ## ### ##### ######## ############# #####################
## Identify the class under test, for the suites containing the common
## and shared test cases.

proc test-class {} { return phash::multi::memory }







>
>
>



>
>







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
# # ## ### ##### ######## ############# #####################
## memory.test:  tests for the phash::multi::memory package.

kt check Tcl     8.5
kt check tcltest 2

kt require support TclOO
kt require support json
kt require support json::write
kt require support md5

kt local   support phash
kt local   support phash::multi
kt local   support phash::multi::serial::json-simple
kt local   support phash::multi::serial::json-extended
kt local   testing phash::multi::memory

# # ## ### ##### ######## ############# #####################
## Identify the class under test, for the suites containing the common
## and shared test cases.

proc test-class {} { return phash::multi::memory }

Added tests/multi-serial-json-extended.test.











































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# -*- tcl -*- tcl.tk//DSL tcltest//EN//2.0 tcl.tk//DSL tcltest//EN//2.0
## (c) 2013 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## serial-json.test:  tests for json serialization, store independent.

kt check Tcl     8.5
kt check tcltest 2

kt require support json
kt require support json::write
kt require support md5 2

kt local   testing phash::multi::serial::json-extended

# # ## ### ##### ######## ############# #####################

kt source support/jc.tcl
kt source parts/multi-serial-json-extended.testsuite

# # ## ### ##### ######## ############# #####################
cleanupTests

Added tests/multi-serial-json-simple.test.









































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# -*- tcl -*- tcl.tk//DSL tcltest//EN//2.0 tcl.tk//DSL tcltest//EN//2.0
## (c) 2013 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## serial-json.test:  tests for json serialization, store independent.

kt check Tcl     8.5
kt check tcltest 2

kt require support json
kt require support json::write

kt local   testing phash::multi::serial::json-simple

# # ## ### ##### ######## ############# #####################

kt source support/jc.tcl
kt source parts/multi-serial-json-simple.testsuite

# # ## ### ##### ######## ############# #####################
cleanupTests

Changes to tests/multi-sqlite-file.test.

5
6
7
8
9
10
11



12
13
14


15
16
17
18
19
20
21

kt check Tcl     8.5
kt check tcltest 2

kt require support TclOO
kt require support sqlite3
kt require support dbutil




kt local   support phash
kt local   support phash::multi


kt local   testing phash::multi::sqlite

# # ## ### ##### ######## ############# #####################
## Identify the class under test, for the suites containing the common
## and shared test cases.

proc test-class {} { return phash::multi::sqlite/file }







>
>
>



>
>







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

kt check Tcl     8.5
kt check tcltest 2

kt require support TclOO
kt require support sqlite3
kt require support dbutil
kt require support json
kt require support json::write
kt require support md5

kt local   support phash
kt local   support phash::multi
kt local   support phash::multi::serial::json-simple
kt local   support phash::multi::serial::json-extended
kt local   testing phash::multi::sqlite

# # ## ### ##### ######## ############# #####################
## Identify the class under test, for the suites containing the common
## and shared test cases.

proc test-class {} { return phash::multi::sqlite/file }

Changes to tests/multi-sqlite-memory.test.

5
6
7
8
9
10
11



12
13
14


15
16
17
18
19
20
21

kt check Tcl     8.5
kt check tcltest 2

kt require support TclOO
kt require support sqlite3
kt require support dbutil




kt local   support phash
kt local   support phash::multi


kt local   testing phash::multi::sqlite

# # ## ### ##### ######## ############# #####################
## Identify the class under test, for the suites containing the common
## and shared test cases.

proc test-class {} { return phash::multi::sqlite/memory }







>
>
>



>
>







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

kt check Tcl     8.5
kt check tcltest 2

kt require support TclOO
kt require support sqlite3
kt require support dbutil
kt require support json
kt require support json::write
kt require support md5

kt local   support phash
kt local   support phash::multi
kt local   support phash::multi::serial::json-simple
kt local   support phash::multi::serial::json-extended
kt local   testing phash::multi::sqlite

# # ## ### ##### ######## ############# #####################
## Identify the class under test, for the suites containing the common
## and shared test cases.

proc test-class {} { return phash::multi::sqlite/memory }

Changes to tests/parts/base.testsuite.

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    test-store setv K V X
} -cleanup {
    release-store
} -returnCodes error -result {wrong # args: should be "test-store setv key value"}

# # ## ### ##### ######## ############# #####################

proc serial-prefix {} { return phash }
proc serial-args   {} { return dict }
proc serial-setup  {} {}
proc serial-result-js {} {
    return {{"a":"x","b":"c"}}
}
proc serial-result-je {} {
    return {{"check":"d35d4cc60cadeadf6f11b02940facf9d","data":{"a":"x","b":"c"},"type":"atest","user":"me","when":"1970-01-01T00:00:00"}}
}

kt source parts/core.testsuite

# # ## ### ##### ######## ############# #####################
return







|
|
|
|
|
|
|
|
|





49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
    test-store setv K V X
} -cleanup {
    release-store
} -returnCodes error -result {wrong # args: should be "test-store setv key value"}

# # ## ### ##### ######## ############# #####################

proc serial-store     {} { return test-store }
proc serial-prefix    {} { return phash }
proc serial-args      {} { return dict }
proc serial-result-js {} { return {{"a":"x","b":"c"}} }
proc serial-result-je {} { return {{"check":"d35d4cc60cadeadf6f11b02940facf9d","data":{"a":"x","b":"c"},"type":"atest","user":"me","when":"1970-01-01T00:00:00"}} }
proc serial-setup     {} {
    test-store set {b c a x}
}


kt source parts/core.testsuite

# # ## ### ##### ######## ############# #####################
return

Changes to tests/parts/export-json-extended.testsuite.

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
## instance command is 'teststore'.

# # ## ### ##### ######## ############# #####################

test [test-class]-common::core-export-json-extended-1.0 {generate, wrong args, too many} -setup {
    new-store
} -body {
    test-store export json-extended T U W X
} -cleanup {
    release-store
} -returnCodes error -result "wrong # args: should be \"[serial-prefix]::serial::json-extended generate [serial-args] ?type? ?user? ?when?\""

test [test-class]-common::core-export-json-extended-2.0 {export json-extended} -setup {
    jcsave 0 0
    new-store
    test-store set {a x b c}
    serial-setup
} -body {
    test-store export json-extended atest me 0
} -cleanup {
    release-store
    jcrestore
} -result [serial-result-je]

# # ## ### ##### ######## ############# #####################
return







|







<


|







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
## instance command is 'teststore'.

# # ## ### ##### ######## ############# #####################

test [test-class]-common::core-export-json-extended-1.0 {generate, wrong args, too many} -setup {
    new-store
} -body {
    [serial-store] export json-extended T U W X
} -cleanup {
    release-store
} -returnCodes error -result "wrong # args: should be \"[serial-prefix]::serial::json-extended generate [serial-args] ?type? ?user? ?when?\""

test [test-class]-common::core-export-json-extended-2.0 {export json-extended} -setup {
    jcsave 0 0
    new-store

    serial-setup
} -body {
    [serial-store] export json-extended atest me 0
} -cleanup {
    release-store
    jcrestore
} -result [serial-result-je]

# # ## ### ##### ######## ############# #####################
return

Changes to tests/parts/export-json-simple.testsuite.

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
## instance command is 'teststore'.

# # ## ### ##### ######## ############# #####################

test [test-class]-common::core-export-json-simple-1.0 {generate, wrong args, too many} -setup {
    new-store
} -body {
    test-store export json-simple X
} -cleanup {
    release-store
} -returnCodes error -result "wrong # args: should be \"[serial-prefix]::serial::json-simple generate [serial-args]\""

test [test-class]-common::core-export-json-simple-2.0 {export json-simple} -setup {
    jcsave 0 0
    new-store
    test-store set {a x b c}
    serial-setup
} -body {
    test-store export json-simple
} -cleanup {
    release-store
    jcrestore
} -result [serial-result-js]

# # ## ### ##### ######## ############# #####################
return







|







<


|







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
## instance command is 'teststore'.

# # ## ### ##### ######## ############# #####################

test [test-class]-common::core-export-json-simple-1.0 {generate, wrong args, too many} -setup {
    new-store
} -body {
    [serial-store] export json-simple X
} -cleanup {
    release-store
} -returnCodes error -result "wrong # args: should be \"[serial-prefix]::serial::json-simple generate [serial-args]\""

test [test-class]-common::core-export-json-simple-2.0 {export json-simple} -setup {
    jcsave 0 0
    new-store

    serial-setup
} -body {
    [serial-store] export json-simple
} -cleanup {
    release-store
    jcrestore
} -result [serial-result-js]

# # ## ### ##### ######## ############# #####################
return

Changes to tests/parts/mtime.testsuite.

157
158
159
160
161
162
163

164
165


166

167
168
169
170
171
172
173
174
175
176
177
178
179
180
    test-store setv A B C
} -cleanup {
    release-store
} -returnCodes error -result {Expected a time, got "C"}

# # ## ### ##### ######## ############# #####################


proc serial-prefix {} { return phash::mtime }
proc serial-args   {} { return {dictv dictt} }


proc serial-setup  {} {

    test-store set-timev a 0
    test-store set-timev b 0
}
proc serial-result-js {} {
    return {{"a":["x","1970-01-01T00:00:00"],"b":["c","1970-01-01T00:00:00"]}}
}
proc serial-result-je {} {
    return {{"check":"d2b5743d7f11a9fe10d9926c924ca777","data":{"a":["x","1970-01-01T00:00:00"],"b":["c","1970-01-01T00:00:00"]},"type":"atest","user":"me","when":"1970-01-01T00:00:00"}}
}

kt source parts/core.testsuite

# # ## ### ##### ######## ############# #####################
return







>
|
|
>
>
|
>



<
<
<
<
<
<





157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173






174
175
176
177
178
    test-store setv A B C
} -cleanup {
    release-store
} -returnCodes error -result {Expected a time, got "C"}

# # ## ### ##### ######## ############# #####################

proc serial-store     {} { return test-store }
proc serial-prefix    {} { return phash::mtime }
proc serial-args      {} { return {dictv dictt} }
proc serial-result-js {} { return {{"a":["x","1970-01-01T00:00:00"],"b":["c","1970-01-01T00:00:00"]}} }
proc serial-result-je {} { return {{"check":"d2b5743d7f11a9fe10d9926c924ca777","data":{"a":["x","1970-01-01T00:00:00"],"b":["c","1970-01-01T00:00:00"]},"type":"atest","user":"me","when":"1970-01-01T00:00:00"}} }
proc serial-setup     {} {
    test-store set {b c a x}
    test-store set-timev a 0
    test-store set-timev b 0
}







kt source parts/core.testsuite

# # ## ### ##### ######## ############# #####################
return

Added tests/parts/multi-serial-json-extended.testsuite.

































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
46
47
48
## -*- tcl -*-
## (c) 2013 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Test suite for json serialization of phash stores.

## The external procedures 'new-store' and 'release-store' are used to
## create and destroy an instance of the store under test. The expected
## instance command is 'teststore'.

# # ## ### ##### ######## ############# #####################

test phash::multi::serial::json-extended-generate-1.0 {generate, wrong args, not enough} -body {
    phash::multi::serial::json-extended generate
} -returnCodes error -result "wrong # args: should be \"phash::multi::serial::json-extended generate dict ?type? ?user? ?when?\""

test phash::multi::serial::json-extended-generate-1.1 {generate, wrong args, too many} -body {
    phash::multi::serial::json-extended generate D T U W X
} -returnCodes error -result "wrong # args: should be \"phash::multi::serial::json-extended generate dict ?type? ?user? ?when?\""

test phash::multi::serial::json-extended-generate-2.0 {generate, ordered} -setup {
    jcsave 0 0
} -body {
    phash::multi::serial::json-extended generate {a {f g q r} b {c f j k}} atest me 0
} -cleanup {
    jcrestore
} -result {{"check":"82638ef5f6bc7a5219259f41f2bf97c0","data":{"a":{"f":"g","q":"r"},"b":{"c":"f","j":"k"}},"type":"atest","user":"me","when":"1970-01-01T00:00:00"}}

test phash::multi::serial::json-extended-generate-2.1 {generate, unordered} -setup {
    jcsave 0 0
} -body {
    phash::multi::serial::json-extended generate {b {j k c f} a {q r f g}} atest me 0
} -cleanup {
    jcrestore
} -result {{"check":"82638ef5f6bc7a5219259f41f2bf97c0","data":{"a":{"f":"g","q":"r"},"b":{"c":"f","j":"k"}},"type":"atest","user":"me","when":"1970-01-01T00:00:00"}}

test phash::multi::serial::json-extended-generate-2.2 {generate, bad input, not a dict} -setup {
    jcsave 0 0
} -body {
    phash::multi::serial::json-extended generate X
} -cleanup {
    jcrestore
} -returnCodes error -result {missing value to go with key}

# TODO: tcl_platform dependency, default type.
# TODO: Bad timestamp (non-integer)

# # ## ### ##### ######## ############# #####################
return

Added tests/parts/multi-serial-json-simple.testsuite.



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
## -*- tcl -*-
## (c) 2013 Andreas Kupries
# # ## ### ##### ######## ############# #####################
## Test suite for json serialization of phash stores.

## The external procedures 'new-store' and 'release-store' are used to
## create and destroy an instance of the store under test. The expected
## instance command is 'teststore'.

# # ## ### ##### ######## ############# #####################

test phash::multi::serial::json-simple-generate-1.0 {generate, wrong args, not enough} -body {
    phash::multi::serial::json-simple generate
} -returnCodes error -result "wrong # args: should be \"phash::multi::serial::json-simple generate dict\""

test phash::multi::serial::json-simple-generate-1.1 {generate, wrong args, too many} -body {
    phash::multi::serial::json-simple generate D X
} -returnCodes error -result "wrong # args: should be \"phash::multi::serial::json-simple generate dict\""

test phash::multi::serial::json-simple-generate-2.0 {generate, ordered} -setup {
    jcsave 0 0
} -body {
    phash::multi::serial::json-simple generate {a {f g q r} b {c f j k}}
} -cleanup {
    jcrestore
} -result {{"a":{"f":"g","q":"r"},"b":{"c":"f","j":"k"}}}

test phash::multi::serial::json-simple-generate-2.1 {generate, unordered} -setup {
    jcsave 0 0
} -body {
    phash::multi::serial::json-simple generate {b {j k c f} a {q r f g}}
} -cleanup {
    jcrestore
} -result {{"a":{"f":"g","q":"r"},"b":{"c":"f","j":"k"}}}

test phash::multi::serial::json-simple-generate-2.2 {generate, bad input, not a dict} -setup {
    jcsave 0 0
} -body {
    phash::multi::serial::json-simple generate X
} -cleanup {
    jcrestore
} -returnCodes error -result {missing value to go with key}

# # ## ### ##### ######## ############# #####################
return

Changes to tests/parts/multi.testsuite.

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
..
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
...
390
391
392
393
394
395
396
397
398




















399








test [test-class]-dispatch-1.1 {instance, bad method name} -setup {
    new-store
} -body {
    test-multi-store foo
} -cleanup {
    release-store
} -returnCodes error \
    -result [badmethod foo {clear destroy get getv keys names open size unset unsetv}]

# # ## ### ##### ######## ############# #####################
## destructor

test [test-class]-destroy-1.0 {destroy, wrong#args, too many} -setup {
    new-store
} -body {
................................................................................

test [test-class]-destroy-1.1 {destroy} -setup {
    new-store
} -body {
    release-store
    info commands ::test-multi-store
} -result {}


# # ## ### ##### ######## ############# #####################
## clear - Across documents

test [test-class]-clear-1.0 {clear, wrong#args, too many} -setup {
    new-store
} -body {
................................................................................
    test-doc-store   set {A Z D Q}
} -body {
    test-multi-store unsetv B
    dict2sort [test-multi-store get]
} -cleanup {
    release-store
} -result {A {ABC B XYZ Z} AX {ABC Z} C {ABC R} D {XYZ Q}}

# # ## ### ##### ######## ############# #####################




















return















|







 







<







 









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
..
61
62
63
64
65
66
67

68
69
70
71
72
73
74
...
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
test [test-class]-dispatch-1.1 {instance, bad method name} -setup {
    new-store
} -body {
    test-multi-store foo
} -cleanup {
    release-store
} -returnCodes error \
    -result [badmethod foo {clear destroy export get getv keys names open size unset unsetv}]

# # ## ### ##### ######## ############# #####################
## destructor

test [test-class]-destroy-1.0 {destroy, wrong#args, too many} -setup {
    new-store
} -body {
................................................................................

test [test-class]-destroy-1.1 {destroy} -setup {
    new-store
} -body {
    release-store
    info commands ::test-multi-store
} -result {}


# # ## ### ##### ######## ############# #####################
## clear - Across documents

test [test-class]-clear-1.0 {clear, wrong#args, too many} -setup {
    new-store
} -body {
................................................................................
    test-doc-store   set {A Z D Q}
} -body {
    test-multi-store unsetv B
    dict2sort [test-multi-store get]
} -cleanup {
    release-store
} -result {A {ABC B XYZ Z} AX {ABC Z} C {ABC R} D {XYZ Q}}

# # ## ### ##### ######## ############# #####################
## export

test [test-class]-export-json-simple-1.0 {export wrong args, not enough} -setup {
    new-store
} -body {
    test-multi-store export
} -cleanup {
    release-store
} -returnCodes error -result "wrong # args: should be \"test-multi-store export format ...\""

# # ## ### ##### ######## ############# #####################

proc serial-store     {} { return test-multi-store }
proc serial-prefix    {} { return phash::multi }
proc serial-args      {} { return dict }
proc serial-result-js {} { return {{"a":{"f":"g","q":"r"},"b":{"c":"f","j":"k"}}} }
proc serial-result-je {} { return {{"check":"82638ef5f6bc7a5219259f41f2bf97c0","data":{"a":{"f":"g","q":"r"},"b":{"c":"f","j":"k"}},"type":"atest","user":"me","when":"1970-01-01T00:00:00"}} }
proc serial-setup     {} {
    set n [test-multi-store open b] ; $n set {j k c f} ; $n destroy
    set n [test-multi-store open a] ; $n set {q r f g} ; $n destroy
    return
}

kt source support/jc.tcl
kt source parts/export-json-simple.testsuite
kt source parts/export-json-extended.testsuite

# # ## ### ##### ######## ############# #####################
return