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

Overview
Comment:Place a cornerstone for scaffolding of the test cases for the fossil json command and related REST API. This begins with an extension to fossil_maybe_answer in tester.tcl that adds a -expectError option to flag invocations of fossil that are expected to exit with error status and not log it when -quiet is in effect. The new file json.test has the first few test cases for fossil json, all of which are currently passing.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | rberteig-json-test
Files: files | file ages | folders
SHA1:95080f47e265f34e17bea66f534176d543aacfec
User & Date: Ross 2016-01-26 01:46:56
Context
2016-01-26
02:45
Minor spacing fix. check-in: 2ff6ceb9 user: mistachkin tags: rberteig-json-test
01:46
Place a cornerstone for scaffolding of the test cases for the fossil json command and related REST API. This begins with an extension to fossil_maybe_answer in tester.tcl that adds a -expectError option to flag invocations of fossil that are expected to exit with error status and not log it when -quiet is in effect. The new file json.test has the first few test cases for fossil json, all of which are currently passing. check-in: 95080f47 user: Ross tags: rberteig-json-test
01:36
Create new branch named "rberteig-json-test" check-in: 50891558 user: Ross tags: rberteig-json-test
Changes

Added test/json.test.































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
#
# Copyright (c) 2011 D. Richard Hipp
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the Simplified BSD License (also
# known as the "2-Clause License" or "FreeBSD License".)
#
# This program is distributed in the hope that it will be useful,
# but without any warranty; without even the implied warranty of
# merchantability or fitness for a particular purpose.
#
# Author contact information:
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test JSON Support
#

# We need a JSON parser to effectively test the JSON produced by
# fossil. It looks like the one from tcllib is exactly what we need.
# On ActiveTcl, add it with teacup. On other platforms, YMMV.
# teacup install json
# teacup install json::write
package require json

# Make sure we have a build with the json command at all and that it
# is not stubbed out
fossil help -a
if {[string first json $RESULT] eq ""} {
  puts "Fossil was not compiled with JSON support."; return
}
fossil json -expectError 
if {$RESULT eq ""} {
  puts "Fossil was not compiled with JSON support."; return
}

# and that the json itself smells ok and has the expected API error code in it
set JR [::json::json2dict $RESULT]
test json-1 {[dict get $JR resultCode] eq "FOSSIL-4102"}

# Use the CLI interface to execute a JSON command. Sets the global
# RESULT to the response text, and JR to a Tcl dict conversion of the
# response body.
#
# Returns "200" or "500".
proc fossil_json {args} {
    global RESULT JR
    uplevel 1 fossil json {*}$args
    set JR [::json::json2dict $RESULT]
    return "200"
}

# Use the HTTP interface to fetch a JSON API URL. Sets the globals
# RESULT to the HTTP response body, and JR to a Tcl dict conversion of
# the response body.
# 
# Returns the status code from the HTTP header.
proc fossil_http_json {url} {
    global RESULT JR
    set request "GET $url HTTP/1.1\r\nHost: localhost\r\nUser-Agent: Fossil"
    set RESULT [fossil_maybe_answer $request http]
    regexp {(?w)(.*)^\s*$(.*)} $RESULT dummy head body
    regexp {^HTTP\S+\s+(\d\d\d)\s+(.*)$} $head dummy status msg
    if {$status eq "200"} {
	set JR [::json::json2dict $body]
    }
    return $status
}

# Inspect the envelope part of a returned JSON structure to confirm
# that it has specific fields and that it lacks specific fields.
proc test_json_envelope {testname okfields badfields} {
    global JR
    set i 1
    foreach f $okfields {
	test "$testname-$i" {[dict exists $JR $f]}
	incr i
    }
    foreach f $badfields {
	test "$testname-$i" {![dict exists $JR $f]}
	incr i
    }
}

# Inspect the envelope of a normal successful result
proc test_json_envelope_ok {testname} {
    test_json_envelope $testname [concat fossil timestamp command procTimeUs \
	procTimeMs payload] [concat resultCode resultText]
}

# Inspect the payload of a successful result to confirm that it has
# specific fields and that it lacks specific fields.
proc test_json_payload {testname okfields badfields} {
    global JR
    set i 1
    foreach f $okfields {
	test "$testname-P-$i" {[dict exists $JR payload $f]}
	incr i
    }
    foreach f $badfields {
	test "$testname-P-$i" {![dict exists $JR payload $f]}
	incr i
    }
}

# The JSON API generally assumes we have a respository, so let it have one.
repo_init

# Check for basic envelope fields in the result with an error
fossil_json -expectError
test_json_envelope json-enverr [concat resultCode fossil timestamp \
    resultText command procTimeUs procTimeMs] {}
test json-enverr-rc-1 {[dict get $JR resultCode] eq "FOSSIL-3002"}


# Check for basic envelope fields in the result with a successful
# command
set HAIfields [concat manifestUuid manifestVersion manifestDate \
    manifestYear releaseVersion releaseVersionNumber \
    resultCodeParanoiaLevel jsonApiVersion]

fossil_json HAI
test_json_envelope_ok json-HAI
test_json_payload json-HAI $HAIfields {}

# Check for basic envelope fields in a HTTP result with a successful
# command
fossil_http_json /json/HAI
test_json_envelope_ok json-http-HAI
test_json_payload json-http-HAI $HAIfields {}

#### ARTIFACT

# sha1 of 0 bytes and a file to match in a commit
set UUID_empty da39a3ee5e6b4b0d3255bfef95601890afd80709
write_file empty ""
fossil add empty
fossil ci -m "empty file"

# json artifact (checkin)
fossil_json [concat artifact tip]
test_json_envelope_ok json-artifact
test json-artifact-checkin {[dict get $JR payload type] eq "checkin"}
test_json_payload json-artifact \
    [concat type uuid isLeaf timestamp user comment parents tags files] {}

# json artifact (file)
fossil_json [concat artifact $UUID_empty]
test_json_envelope_ok json-artifact
test json-artifact-file {[dict get $JR payload type] eq "file"}
test_json_payload json-artifact [concat type uuid size checkins] {}

# json artifact (wiki)
# name, uuid, parent, user, timestamp, size, content?


#### AUTHENTICATION
#### BRANCHES
#### CONFIG
#### DIFFS
#### DIRECTORY LISTING
#### FILE INFO
#### QUERY
#### STATS
#### STATUS
#### TAGS
#### TICKETS
#### TICKET REPORTS
#### TIMELINE
#### USER MANAGEMENT
#### VERSION AKA HAI
#### WIKI
#### UNAVOIDABLE MISC

Changes to test/tester.tcl.

111
112
113
114
115
116
117





118
119
120
121
122
123
124
...
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
# diagnostics should be emitted when no error is seen.
# Sets the CODE and RESULT global variables for use in
# test expressions.
#
proc fossil_maybe_answer {answer args} {
  global fossilexe
  set cmd $fossilexe





  foreach a $args {
    lappend cmd $a
  }
  protOut $cmd

  flush stdout
  if {[string length $answer] > 0} {
................................................................................
    set rc [catch {eval exec $cmd <$prompt_file} result]
    file delete $prompt_file
  } else {
    set rc [catch {eval exec $cmd} result]
  }
  global RESULT CODE
  set CODE $rc
  if {$rc} {
    protOut "ERROR: $result" 1
  } elseif {$::VERBOSE} {
    protOut "RESULT: $result"
  }
  set RESULT $result
}

# Read a file into memory.







>
>
>
>
>







 







|
|







111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
...
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
# diagnostics should be emitted when no error is seen.
# Sets the CODE and RESULT global variables for use in
# test expressions.
#
proc fossil_maybe_answer {answer args} {
  global fossilexe
  set cmd $fossilexe
  set expectError 0
  if {[lindex $args end] eq "-expectError"} {
    set expectError 1
    set args [lrange $args 0 end-1]
  }
  foreach a $args {
    lappend cmd $a
  }
  protOut $cmd

  flush stdout
  if {[string length $answer] > 0} {
................................................................................
    set rc [catch {eval exec $cmd <$prompt_file} result]
    file delete $prompt_file
  } else {
    set rc [catch {eval exec $cmd} result]
  }
  global RESULT CODE
  set CODE $rc
  if {($rc && !$expectError) || (!$rc && $expectError)} {
      protOut "ERROR: $result" 1
  } elseif {$::VERBOSE} {
    protOut "RESULT: $result"
  }
  set RESULT $result
}

# Read a file into memory.