Fossil

Check-in [c35152a5]
Login

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

Overview
Comment:Fixed json.test problem with fossil configured without --json. Removed the knownBug marker from the test json-wiki-diff-diff since [08197f96] fixed the bug it identified.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:c35152a5d47257cdaed94c52232392034a88cf1a
User & Date: rberteig 2016-02-06 22:41:58
Context
2016-02-07
04:15
Defer requiring json loading until after it is determined that fossil json works. check-in: 5d700c7d user: andybradford tags: trunk
2016-02-06
22:41
Fixed json.test problem with fossil configured without --json. Removed the knownBug marker from the test json-wiki-diff-diff since [08197f96] fixed the bug it identified. check-in: c35152a5 user: rberteig tags: trunk
20:35
Normalize the the directory in which the Fossil being tested is found so relative paths also work. check-in: 25f7d3c1 user: andybradford tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to test/json.test.

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
..
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
...
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610

# 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. This assumes the current (as of 2016-01-27)
# practice of eliminating all trace of the fossil json command when
# not configured. If that changes, these conditions might not prevent
# the rest of this file from running.
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 GET a JSON API URL. Sets the globals
# RESULT to the HTTP response body, and JR to a Tcl dict conversion of
# the response body.
# 
................................................................................
proc fossil_http_json {url {cookie "Muppet=Monster"} args} {
  global RESULT JR
  set request "GET $url HTTP/1.1\r\nHost: localhost\r\nUser-Agent: Fossil-http-json\r\nCookie: $cookie"
  set RESULT [fossil_maybe_answer $request http {*}$args]
  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
}


# Use the HTTP interface to POST a JSON API URL. Sets the globals
# RESULT to the HTTP response body, and JR to a Tcl dict conversion of
................................................................................
  set RESULT [fossil_maybe_answer $request http {*}$args]

  # separate HTTP headers from body
  regexp {(?w)(.*)^\s*$(.*)} $RESULT dummy head body
  regexp {^HTTP\S+\s+(\d\d\d)\s+(.*)$} $head dummy status msg
  if {$status eq "200"} {
    if {[string length $body] > 0} {
      set JR [::json::json2dict $body]
    } else {
      set JR ""
    }
  }
  return $status
}

................................................................................

fossil_json wiki diff $uuid1 $uuid2
test_json_envelope_ok json-wiki-diff-env
test_json_payload json-wiki-diff [list v1 v2 diff] {}
test json-wiki-diff-v1 {[dict get $JR payload v1] eq $uuid1}
test json-wiki-diff-v1 {[dict get $JR payload v2] eq $uuid2}
set diff [dict get $JR payload diff]
test json-wiki-diff-diff {[string first "+consectetur adipisicing elit" $diff] >= 0} knownBug
#puts [dict get $JR payload diff]

# wiki preview
#
# takes a string in fossil wiki markup and return an HTML fragment.
# This command does not make use of the actual wiki content (much?)
# at all.







>
>
>
>
>
>
>
>
>







|
|
<
<
<
<



>
|
>
>
>
>
|









|







 







|







 







|







 







|







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
..
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
...
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
...
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620

# 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

proc json2dict {txt} {
  set rc [catch {::json::json2dict $txt} result options]
  if {$rc != 0} {
    protOut "JSON ERROR: $result" 
    return {}
  }
  return $result
}

# Make sure we have a build with the json command at all and that it
# is not stubbed out. This assumes the current (as of 2016-01-27)
# practice of eliminating all trace of the fossil json command when
# not configured. If that changes, these conditions might not prevent
# the rest of this file from running.
fossil help -a
if {[string first json $RESULT] < 0} {
  puts "Fossil was not compiled with JSON support (fossil help -a)."; return




}

# and that the json itself smells ok and has the expected API error code in it
fossil json -expectError 
set JR [json2dict $RESULT]
if {$JR eq ""} {
  puts "Fossil was not compiled with JSON support (bad JSON)."; return
}
test json-1 {[dict exists $JR resultCode]
             && [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 [json2dict $RESULT]
  return "200"
}

# Use the HTTP interface to GET a JSON API URL. Sets the globals
# RESULT to the HTTP response body, and JR to a Tcl dict conversion of
# the response body.
# 
................................................................................
proc fossil_http_json {url {cookie "Muppet=Monster"} args} {
  global RESULT JR
  set request "GET $url HTTP/1.1\r\nHost: localhost\r\nUser-Agent: Fossil-http-json\r\nCookie: $cookie"
  set RESULT [fossil_maybe_answer $request http {*}$args]
  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 [json2dict $body]
  }
  return $status
}


# Use the HTTP interface to POST a JSON API URL. Sets the globals
# RESULT to the HTTP response body, and JR to a Tcl dict conversion of
................................................................................
  set RESULT [fossil_maybe_answer $request http {*}$args]

  # separate HTTP headers from body
  regexp {(?w)(.*)^\s*$(.*)} $RESULT dummy head body
  regexp {^HTTP\S+\s+(\d\d\d)\s+(.*)$} $head dummy status msg
  if {$status eq "200"} {
    if {[string length $body] > 0} {
      set JR [json2dict $body]
    } else {
      set JR ""
    }
  }
  return $status
}

................................................................................

fossil_json wiki diff $uuid1 $uuid2
test_json_envelope_ok json-wiki-diff-env
test_json_payload json-wiki-diff [list v1 v2 diff] {}
test json-wiki-diff-v1 {[dict get $JR payload v1] eq $uuid1}
test json-wiki-diff-v1 {[dict get $JR payload v2] eq $uuid2}
set diff [dict get $JR payload diff]
test json-wiki-diff-diff {[string first "+consectetur adipisicing elit" $diff] >= 0}
#puts [dict get $JR payload diff]

# wiki preview
#
# takes a string in fossil wiki markup and return an HTML fragment.
# This command does not make use of the actual wiki content (much?)
# at all.