Fossil

Changes On Branch rberteig-json-test
Login

Changes On Branch rberteig-json-test

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

Changes In Branch rberteig-json-test Excluding Merge-Ins

This is equivalent to a diff from 74ce4181 to 2de15c8e

2016-02-06
02:46
Add test cases for fossil json. Improve the test suite to support a way to treat expected non-zero status exits from fossil as success when warrented. Made minor bug fixes to the test framework, and to several test cases unrelated to JSON support. ... (check-in: 62627615 user: rberteig tags: trunk)
02:27
Improve the MSVC build tool sub-routine 'fn_UnsetVariable'. ... (check-in: 4c163cd7 user: mistachkin tags: trunk)
02:03
Merged from trunk to pick up work in progress and a bug fix to tester.tcl. Fixed issue introduced by the addition of the insertCsrf and verifyCsrf commands from ci [f8820eff] which broke the test th1-info-commands. Also fixed the dependence on the order of commands output by TH1. ... (Closed-Leaf check-in: 2de15c8e user: rberteig tags: rberteig-json-test)
2016-02-05
23:46
On Windows, normalize the Fossil executable file extension used by the test suite. ... (check-in: 74ce4181 user: mistachkin tags: trunk)
2016-02-02
02:32
Minor tweaks in a few test cases, placeholder for cases to exercise documented error codes. ... (check-in: 9f45c8b6 user: rberteig tags: rberteig-json-test)
2016-02-01
20:38
Add --https and --nossl options to the 'server' command. ... (check-in: b8c7af5b user: mistachkin tags: trunk)

Changes to test/amend.test.

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
  "%d/%m/%Y %H:%M%:%S"
  "%d/%m/%Y"
}
set sc 0
foreach badformat $badformats {
  incr sc
  set datetime [clock format $timestamp -format $badformat -gmt 1]
  fossil amend $UUIDINIT -date $datetime
  test amend-date-2.$sc {[string first "YYYY-MM-DD HH:MM:SS" $RESULT] != -1}
}

########################################
# Test: -hide                          #
########################################
set UUIDH UUIDH







|







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
  "%d/%m/%Y %H:%M%:%S"
  "%d/%m/%Y"
}
set sc 0
foreach badformat $badformats {
  incr sc
  set datetime [clock format $timestamp -format $badformat -gmt 1]
  fossil amend $UUIDINIT -date $datetime -expectError
  test amend-date-2.$sc {[string first "YYYY-MM-DD HH:MM:SS" $RESULT] != -1}
}

########################################
# Test: -hide                          #
########################################
set UUIDH UUIDH
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
  [string match "*comment:*Create*new*branch*named*\"cllf\"*" $RESULT]
}
fossil tag ls --raw $UUIDC
test amend-close-1.2 {[string first "closed" $RESULT] != -1}
fossil timeline -n 1
test amend-close-1.3 {[string match {*Marked*"Closed".*} $RESULT]}
write_file datafile "cllf"
fossil commit -m "should fail"
test amend-close-2 {[string first "closed leaf" $RESULT] != -1}

set UUID3 UUID3
fossil revert
fossil update trunk
write_file datafile "cb"
fossil commit -m "closed-branch" --branch "closebranch"







|







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
  [string match "*comment:*Create*new*branch*named*\"cllf\"*" $RESULT]
}
fossil tag ls --raw $UUIDC
test amend-close-1.2 {[string first "closed" $RESULT] != -1}
fossil timeline -n 1
test amend-close-1.3 {[string match {*Marked*"Closed".*} $RESULT]}
write_file datafile "cllf"
fossil commit -m "should fail" -expectError
test amend-close-2 {[string first "closed leaf" $RESULT] != -1}

set UUID3 UUID3
fossil revert
fossil update trunk
write_file datafile "cb"
fossil commit -m "closed-branch" --branch "closebranch"
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
fossil tag ls --raw current
test amend-close-3.2 {[string first "closed" $RESULT] != -1}
fossil timeline -n 1
test amend-close-3.3 {
  [string match "*Add*propagating*\"closed\".*" $RESULT]
}
write_file datafile "changed"
fossil commit -m "should fail"
test amend-close-3.4 {[string first "closed leaf" $RESULT] != -1}

########################################
# Test: -tag/-cancel                   #
########################################
set tagtests {
  tagged tagged







|







283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
fossil tag ls --raw current
test amend-close-3.2 {[string first "closed" $RESULT] != -1}
fossil timeline -n 1
test amend-close-3.3 {
  [string match "*Add*propagating*\"closed\".*" $RESULT]
}
write_file datafile "changed"
fossil commit -m "should fail" -expectError
test amend-close-3.4 {[string first "closed leaf" $RESULT] != -1}

########################################
# Test: -tag/-cancel                   #
########################################
set tagtests {
  tagged tagged
397
398
399
400
401
402
403
404
405
  fossil_maybe_answer "a\n$comment\n.\nw\nq\n" amend $UUID --edit-comment
  test-comment 5 $UUID $comment
}

########################################
# Test: NULL UUID                      #
########################################
fossil amend {} -close
test amend-null-uuid {$CODE && [string first "no such check-in" $RESULT] != -1}







|

397
398
399
400
401
402
403
404
405
  fossil_maybe_answer "a\n$comment\n.\nw\nq\n" amend $UUID --edit-comment
  test-comment 5 $UUID $comment
}

########################################
# Test: NULL UUID                      #
########################################
fossil amend {} -close -expectError
test amend-null-uuid {$CODE && [string first "no such check-in" $RESULT] != -1}

Changes to test/clean.test.

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

fossil extra
test clean-22 {[normalize_result] eq {f2
f4}}

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

fossil undo
test clean-23 {[normalize_result] eq {nothing to undo}}

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

# clean w/undo disabled, force, 1 file < 10MiB, 1 file > 10MiB
fossil clean --disable-undo --force
test clean-24 {[normalize_result] eq {}}

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

fossil extra
test clean-25 {[normalize_result] eq {}}

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

fossil undo
test clean-26 {[normalize_result] eq {nothing to undo}}

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

write_file f5 "f5 line"
fossil extra
test clean-27 {[normalize_result] eq {f5}}







|















|







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

fossil extra
test clean-22 {[normalize_result] eq {f2
f4}}

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

fossil undo -expectError
test clean-23 {[normalize_result] eq {nothing to undo}}

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

# clean w/undo disabled, force, 1 file < 10MiB, 1 file > 10MiB
fossil clean --disable-undo --force
test clean-24 {[normalize_result] eq {}}

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

fossil extra
test clean-25 {[normalize_result] eq {}}

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

fossil undo -expectError
test clean-26 {[normalize_result] eq {nothing to undo}}

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

write_file f5 "f5 line"
fossil extra
test clean-27 {[normalize_result] eq {f5}}
176
177
178
179
180
181
182
183
184
185
186
187
188
189
###############################################################################

fossil extra
test clean-29 {[normalize_result] eq {}}

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

fossil undo
test clean-30 {[normalize_result] eq {nothing to undo}}

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

fossil extra
test clean-31 {[normalize_result] eq {}}







|






176
177
178
179
180
181
182
183
184
185
186
187
188
189
###############################################################################

fossil extra
test clean-29 {[normalize_result] eq {}}

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

fossil undo -expectError
test clean-30 {[normalize_result] eq {nothing to undo}}

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

fossil extra
test clean-31 {[normalize_result] eq {}}

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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
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
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
#
# Copyright (c) 2016 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. 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.
# 
# Returns the status code from the HTTP header.
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
# the response body.
#
# Returns the status code from the HTTP header.
proc fossil_post_json {url data {cookie "Muppet=Monster"} args} {
  global RESULT JR 

  # set up a full GET or POST HTTP request
  set len [string length $data]
  if {$len > 0} {
    set request [subst {POST $url HTTP/1.0\r
Host: localhost\r
User-Agent: Fossil-Test\r
Cookie: $cookie\r
Content-Type: application/json
Content-Length $len
\r
$data}]
  } else {
    set request [subst {GET $url HTTP/1.0\r
Host: localhost\r
User-Agent: Fossil-Test\r
Cookie: $cookie\r
\r
}]
  }

  # handle the actual request
  flush stdout
  #exec $fossilexe
  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
}


# Inspect a dict for keys it must have and keys it must not have
proc test_dict_keys {testname D okfields badfields} {
  set i 1
  foreach f $okfields {
    test "$testname-$i" {[dict exists $D $f]}
    incr i
  }
  foreach f $badfields {
    test "$testname-$i" {![dict exists $D $f]}
    incr i
  }
}

# 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} {
  test_dict_keys $testname $::JR $okfields $badfields
}

# 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} {
  test_dict_keys $testname [dict get $::JR payload] $okfields $badfields
}

#### VERSION AKA HAI

# 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 {}
test json-HAI-api {[dict get $JR payload jsonApiVersion] >= 20120713}

# 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 {}
test json-http-HAI-api {[dict get $JR payload jsonApiVersion] >= 20120713}

fossil_json version
test_json_envelope_ok json-version
test_json_payload json-version $HAIfields {}
test json-version-api {[dict get $JR payload jsonApiVersion] >= 20120713}

#### 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-checkin-env
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-file-env
test json-artifact-file {[dict get $JR payload type] eq "file"}
test_json_payload json-artifact [concat type uuid size checkins] {}

# json artifact (wiki)
fossil wiki create Empty <<"-=BLANK=-"
fossil_json wiki get Empty
test json-wiki-get {[dict get $JR payload name] eq "Empty"}
set uuid [dict get $JR payload uuid]
fossil_json artifact $uuid
test_json_envelope_ok json-artifact-wiki-env
test json-artifact-wiki {[dict get $JR payload type] eq "wiki"}
test_json_payload json-artifact-wiki [list type uuid artifact] {}
set artifact [dict get $JR payload artifact]
test_dict_keys json-artifact-wiki-artifact $artifact \
  [list name uuid user timestamp size] {}
# name, uuid, parent?, user, timestamp, size?, content?


#### AUTHENTICATION
fossil_json anonymousPassword
test_json_envelope_ok json-anonymousPassword-env
test_json_payload json-anonymousPassword {seed password} {}
set seed [dict get $JR payload seed]
set pass [dict get $JR payload password]

write_file anon-1 [subst {
{
  "command":"login",
  "payload":{
    "name":"anonymous",
    "anonymousSeed":$seed,
    "password":"$pass"
  }
}
}]
fossil_json --json-input anon-1
test_json_envelope_ok json-login-a-env
test_json_payload json-login-a {authToken name capabilities loginCookieName} {}
set AuthAnon [dict get $JR payload]
proc test_hascaps {testname need caps} {
  foreach n [split $need {}] {
    test $testname-$n {[string first $n $caps] >= 0}
  }
}
test_hascaps json-login-c "hmnc" [dict get $AuthAnon capabilities]

fossil user new U1 User-1 Uone
fossil user capabilities U1 s
write_file u1 {
{
  "command":"login",
  "payload":{
    "name":"U1",
    "password":"Uone"
  }
}
}
fossil_json --json-input u1
test_json_envelope_ok json-login-u1-env
test_json_payload json-login-u1 {authToken name capabilities loginCookieName} {}
set AuthU1 [dict get $JR payload]
test_hascaps json-login-c "s" [dict get $AuthU1 capabilities]

set U1Cookie [dict get $AuthU1 loginCookieName]=[regsub -all {[/]} [dict get $AuthU1 authToken] {%2F} ]
set AnonCookie [dict get $AuthAnon loginCookieName]=[regsub -all {[/]} [dict get $AuthAnon authToken] {%2F} ]

# json cap
# The CLI user has all rights, and no auth token affects that. This
# is consistent with the rest of the fossil CLI, and with the
# pragmatic argument that using the CLI implies physical access to
# the repo file itself, which can be taunted with many tools
# including raw SQLite which will also ignore authentication.
write_file anon-2 [subst {
  {"command":"cap",
   "authToken":"[dict get $AuthAnon authToken]"
  }
}]
fossil_json --json-input anon-2
test_json_envelope_ok json-cap-env
test json-cap-CLI {[dict get $JR payload permissionFlags setup]}

# json cap via POST with authToken in request envelope
set anon2 [read_file anon-2]
fossil_post_json "/json/cap" $anon2
test json-cap-POSTenv-env-0 {[string length $JR] > 0}
test_json_envelope_ok json-cap-POSTenv-env
test json-cap-POSTenv-name {[dict get $JR payload name] eq "anonymous"} knownBug
test json-cap-POSTenv-notsetup {![dict get $JR payload permissionFlags setup]}


# json cap via GET with authToken in Cookie header
fossil_post_json "/json/cap" {} $AnonCookie
test json-cap-GETcookie-env-0 {[string length $JR] > 0}
test_json_envelope_ok json-cap-GETcookie-env
test json-cap-GETcookie-name {[dict get $JR payload name] eq "anonymous"}
test json-cap-GETcookie-notsetup {![dict get $JR payload permissionFlags setup]}


# json cap via GET with authToken in a parameter
fossil_post_json "/json/cap?authToken=[dict get $AuthAnon authToken]" {}
test json-cap-GETcookie-env-0 {[string length $JR] > 0}
test_json_envelope_ok json-cap-GETcookie-env
test json-cap-GETcookie-name {[dict get $JR payload name] eq "anonymous"}
test json-cap-GETcookie-notsetup {![dict get $JR payload permissionFlags setup]}


# whoami
# via CLI with no auth token supplied
fossil_json whoami
test_json_envelope_ok json-whoami-cli-env
test_json_payload json-whoami-cli {name capabilities} {}
test json-whoami-cli-name {[dict get $JR payload name] eq "nobody"}
test_hascaps json-whoami-cli-cap "gjorz" [dict get $JR payload capabilities]

#### BRANCHES
# json branch list
fossil_json branch list
test_json_envelope_ok json-branch-list-env
test_json_payload json-branch-list {range current branches} {}
test json-branch-list-cur {[dict get $JR payload current] eq "trunk"}
test json-branch-list-cnt {[llength [dict get $JR payload branches]] == 1}
test json-branch-list-val {[dict get $JR payload branches] eq "trunk"}

# json branch create
fossil_json branch create alpha --basis trunk
test_json_envelope_ok json-branch-create-env
test_json_payload json-branch-create {name basis rid uuid isPrivate} {}


#### CONFIG
# json config get AREA
# AREAs are skin ticket project all skin-backup
foreach a [list skin ticket project all skin-backup] {
  fossil_json config get $a 
  test_json_envelope_ok json-config-$a-env
  # payload depends on specific area and may be completely empty
}

#### DIFFS
# json diff v1 v2

write_file fish {
ABCD goldfish
}
fossil add fish
fossil ci -m "goldfish"
fossil_json finfo fish
set fishHist [dict get $JR payload checkins]
set fishV1 [dict get [lindex $fishHist 0] uuid]

write_file fish {
ABCD goldfish
LMNO goldfish
}
fossil ci -m "goldfish"
fossil_json finfo fish
set fishHist [dict get $JR payload checkins]
set fishV2 [dict get [lindex $fishHist 0] uuid]

test fossil-diff-setup {$fishV1 ne $fishV2}
fossil_json diff $fishV1 $fishV2
test_json_envelope_ok json-diff-env
test_json_payload json-diff {from to diff} {}
test json-diff-v1 {[dict get $JR payload from] eq $fishV1}
test json-diff-v2 {[dict get $JR payload to] eq $fishV2}
set diff [dict get $JR payload diff]
test json-diff-diff {[string first "+LMNO goldfish" $diff] >= 0}
protOut [dict get $JR payload diff]


#### DIRECTORY LISTING
# json dir DIRNAME
fossil_json dir 
test_json_envelope_ok json-dir-env
test_json_payload json-dir {name entries} {}

#### FILE INFO
# json finfo FILENAME
fossil_json finfo empty
test_json_envelope_ok json-finfo-env
test_json_payload json-finfo {name checkins} {}

#### QUERY
# json query SQLCODE
fossil_json query {"SELECT * FROM reportfmt"}
test_json_envelope_ok json-query-env
test_json_payload json-query {columns rows} {}

#### STATS
# json stat
fossil_json stat
test_json_envelope_ok json-stat-env
test_json_payload json-stat {repositorySize ageDays ageYears projectCode compiler sqlite} \
{blobCount deltaCount uncompressedArtifactSize averageArtifactSize maxArtifactSize \
compressionRatio checkinCount fileCount wikiPageCount ticketCount}

fossil_json stat -f
test_json_envelope_ok json-stat-env
test_json_payload json-stat {repositorySize \
blobCount deltaCount uncompressedArtifactSize averageArtifactSize maxArtifactSize \
compressionRatio checkinCount fileCount wikiPageCount ticketCount \
ageDays ageYears projectCode compiler sqlite} {}


#### STATUS
# NOTE: Local checkout required
# json status
fossil_json status
test_json_envelope_ok json-status-env
test_json_payload json-status {repository localRoot checkout files errorCount} {}

#### TAGS

# json tag add NAME CHECKIN VALUE
fossil_json tag add blue trunk green
test_json_envelope_ok json-tag-add-env
test_json_payload json-tag-add {name value propagate raw appliedTo} {}


# json tag cancel NAME CHECKIN
fossil_json tag add cancel alpha
test_json_envelope_ok json-tag-cancel-env
# DOCBUG? Doc says no payload.
test_json_payload json-tag-cancel {name value propagate raw appliedTo} {}

# json tag find NAME
fossil_json tag find alpha
test_json_envelope_ok json-tag-find-env
test_json_payload json-tag-find {name raw type limit artifacts} {}
test json-tag-find-count {[llength [dict get $JR payload artifacts]] >= 1}

# json tag list CHECKIN
fossil_json tag list
test_json_envelope_ok json-tag-list-env
test_json_payload json-tag-list {raw includeTickets tags} {}
test json-tag-list-count {[llength [dict get $JR payload tags]] >= 2}


#### TICKETS
# API Docs say not yet defined, so it isn't quite fair to mark this
# category as TODO for the test cases...

#### TICKET REPORTS

# json report get NUMBER
fossil_json report get 1
test_json_envelope_ok json-report-get-env
test_json_payload json-report-get {report owner title timestamp columns sqlCode} {}

# json report list
fossil_json report list
test_json_envelope_ok json-report-list-env
#test_json_payload json-report-list {raw includeTickets tags} {}
test json-report-list-count {[llength [dict get $JR payload]] >= 1}


# json report run NUMBER
fossil_json report run 1
test_json_envelope_ok json-report-run-1-env
test_json_payload json-report-list {report title sqlcode columnNames tickets} {}
test json-report-list-count {[llength [dict get $JR payload columnNames]] >= 7}
test json-report-list-count {[llength [dict get $JR payload tickets]] >= 0}


#### TIMELINE

# json timeline checkin
fossil_json timeline checkin
test_json_envelope_ok json-timeline-checkin-env
test_json_payload json-timeline-checkin {limit timeline} {}
set i 0
foreach t [dict get $JR payload timeline] {
  # parents appears only for entries that have a parent
  # files appears only if requested by the --files parameter
  test_dict_keys json-timeline-checkin-$i $t {type uuid timestamp comment user isLeaf tags} {}
  incr i
}

# json timeline ci
# removed from documentation
#fossil_json timeline ci
#test json-timeline-ci {[dict get $JR resultCode] ne "FOSSIL-1102"} knownBug
#test_json_payload json-timeline-ci {limit timeline} {}

# json timeline ticket
fossil_json timeline ticket
test_json_envelope_ok json-timeline-ticket-env
test_json_payload json-timeline-ticket {limit timeline} {}

# json timeline wiki
fossil_json timeline wiki
test_json_envelope_ok json-timeline-wiki-env
test_json_payload json-timeline-wiki {limit timeline} {}


#### USER MANAGEMENT

# json user get
foreach u [list nobody anonymous reader developer U1] {
  fossil_json user get $u
  test_json_envelope_ok json-user-get-$u-env
  test_json_payload json-user-get-$u {uid name capabilities info timestamp} {}
}

# json user list
fossil_json user list
test_json_envelope_ok json-user-list-env
set i 0
foreach u [dict get $JR payload] {
  test_dict_keys json-user-list-$i $u {uid name capabilities info timestamp} {}
  incr i
}

# json user save
fossil_json user save --uid -1 --name U2 --password Utwo 
test_json_envelope_ok json-user-save-env
test_json_payload json-user-save {uid name capabilities info timestamp} {}


# DOCBUG? Doc says payload is "same as /json/user/get" but actual
# result was an array of one user similar to /json/user/list.
#set i 0
#foreach u [dict get $JR payload] {
#  test_dict_keys json-user-save-$i $u {uid name capabilities info timestamp} {}
#  incr i
#}
#test json-user-save-count {$i == 1}



#### WIKI

# wiki list
fossil_json wiki list
test_json_envelope_ok json-wiki-list-env 
set pages  [dict get $JR payload]
test json-wiki-1 {[llength $pages] == 1}
test json-wiki-2 {[lindex  $pages 0] eq "Empty"}
fossil_json wiki list --verbose
set pages  [dict get $JR payload]
test json-wiki-verbose-1 {[llength $pages] == 1}
test_dict_keys json-wiki-verbose-pages [lindex $pages 0] [list name uuid user timestamp size] {}

# wiki get
fossil_json wiki get Empty
test_json_envelope_ok json-wiki-get-env 
# this page has only one version, so no parent should be listed
test_json_payload json-wiki-get [list name uuid user timestamp size content] [list parent]


# wiki create
# requires an authToken? Not from CLI.

write_file req.json {
  {
    "command":"wiki/create",
    "payload":{
      "name":"Page2",
      "content":"Lorem ipsum dolor sic amet."
    }
  }
}
fossil_json --json-input req.json
test_json_envelope_ok json-wiki-create-env
fossil_json wiki get Page2
test_json_envelope_ok json-wiki-create-get-env
test_json_payload json-wiki-save-get [list name uuid user timestamp size content] {parent}
set uuid1 [dict get $JR payload uuid]

# wiki save

write_file req2.json {
  {
    "command":"wiki/save",
    "payload":{
      "name":"Page2",
      "content":"Lorem ipsum dolor sic amet.\nconsectetur adipisicing elit."
    }
  }
}
fossil_json --json-input req2.json
test_json_envelope_ok json-wiki-save-env
fossil_json wiki get Page2
test_json_envelope_ok json-wiki-save-get-env
test_json_payload json-wiki-save-get [list name uuid user timestamp size parent content] {}
set uuid2 [dict get $JR payload uuid]
test json-wiki-save-parent {[dict get $JR payload parent] eq $uuid1}

# wiki diff

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.
write_file req3.json {
  {
    "command":"wiki/preview",
    "payload":"Lorem ipsum dolor sic amet.\nconsectetur adipisicing elit."
  }
}
fossil_json --json-input req3.json
test_json_envelope_ok json-wiki-preview-env
set pv [dict get $JR payload]
test json-wiki-preview-out-1 {[string first "<p>Lorem ipsum" $pv] == 0}
test json-wiki-preview-out-2 {[string last "<p>" $pv] == 0}

#### UNAVOIDABLE MISC

# json g
fossil_json g
test_json_envelope_ok json-g-env
#puts [llength [dict keys [dict get $JR payload]]]
test json-g-g {[llength [dict keys [dict get $JR payload]]] >= 60};# 64 on my PC

# json rebuild
fossil_json rebuild
test_json_envelope json-rebuild-env [concat fossil timestamp command procTimeUs \
  procTimeMs] [concat payload resultCode resultText]

# json resultCodes
fossil_json resultCodes
test_json_envelope_ok json-resultCodes-env
set codes [dict get $JR payload]
test json-resultCodes-codes-1 {[llength $codes] >= 35} ;# count as of API 20120713
# foreach c $codes {
#   puts [dict values $c]
# }
foreach r $codes {
  protOut "# [dict get $r resultCode] [dict get $r cSymbol]\n#     [dict get $r description]"
}



#### From the API Docs

# Reminder to self: in March 2012 i saw a corner-case which returns
# HTML output. To reproduce: chmod 444 REPO, then submit a request
# which writes something (timeline creates a temp table). The "repo
# is not writable" error comes back as HTML. i don't know if the
# error happens before we have made the determination that the app is
# in JSON mode or if the error handling is incorrectly not
# recognizing JSON mode. 
#
#repo_init x.fossil
#catch {exec chmod 444 .rep.fossil}; # Unix. What about Win?
fossil_http_json /json/timeline/checkin $U1Cookie
test json-ROrepo-1-1 {$CODE == 0}
test json-ROrepo-1-2 {[regexp {\}\s*$} $RESULT]}
test json-ROrepo-1-3 {![regexp {SQLITE_[A-Z]+:} $RESULT]}
test_json_envelope_ok json-http-timeline1
protOut "chmod 444 repo"
catch {exec chmod 444 .rep.fossil}; # Unix. What about Win?
fossil_http_json /json/timeline/checkin $U1Cookie -expectError
test json-ROrepo-2-1 {$CODE != 0}
test json-ROrepo-2-2 {[regexp {\}\s*$} $RESULT]} knownBug
test json-ROrepo-2-3 {![regexp {SQLITE_[A-Z]+:} $RESULT]} knownBug
#test_json_envelope_ok json-http-timeline2
catch {exec chmod 666 .rep.fossil}; # Unix. What about Win?


#### Result Codes
# Test cases designed to stimulate each (documented) error code.

# FOSSIL-0000 
# Not returned by any command. We generally verify that in the
# test_json_envelope_ok command by verifying that the resultCode
# field is not present. Should any JSON endpoint begin to use the
# range reserved for non-fatal warnings, those tests will fail.
#
# Notice that code is not included in the list returned from
# /json/resultCodes.


# FOSSIL-1000 FSL_JSON_E_GENERIC
#     Generic error

# FOSSIL-1101 FSL_JSON_E_INVALID_REQUEST
#     Invalid request
write_file e1101.json {
  ["command","nope"]
}
fossil_json --json-input e1101.json -expectError
test json-RC-1101-array-CLI-exit {$CODE != 0}
test_json_envelope json-RC-1101-array-env {fossil timestamp command procTimeUs \
procTimeMs resultCode resultText} {payload}
test json-RC-1101-array-code {[dict get $JR resultCode] eq "FOSSIL-1101"}

write_file e1101.json {
  "Not really a command but more of a suggestion"
}
fossil_json --json-input e1101.json -expectError
test json-RC-1101-string-CLI-exit {$CODE != 0}
test_json_envelope json-RC-1101-string-env {fossil timestamp command procTimeUs \
procTimeMs resultCode resultText} {payload}
test json-RC-1101-string-code {[dict get $JR resultCode] eq "FOSSIL-1101"}




# FOSSIL-1102 FSL_JSON_E_UNKNOWN_COMMAND
#     Unknown command or subcommand
fossil_json NoSuchEndpoint -expectError
test json-RC-1102-CLI-exit {$CODE != 0}
test_json_envelope json-RC-1102-env {fossil timestamp command procTimeUs \
procTimeMs resultCode resultText} {payload}
test json-RC-1102-code {[dict get $JR resultCode] eq "FOSSIL-1102"}

write_file e1102.json {
  {
    "command":"no/such/endpoint"
  }
}
fossil_json --json-input e1102.json -expectError
test json-env-RC-1102-CLI-exit {$CODE != 0}
test_json_envelope json-env-RC-1102-env {fossil timestamp command procTimeUs \
procTimeMs resultCode resultText} {payload}
test json-env-RC-1102-code {[dict get $JR resultCode] eq "FOSSIL-1102"}


# FOSSIL-1103 FSL_JSON_E_UNKNOWN
#     Unknown error

write_file bad.sql  {
CREATE TABLE spam(a integer, b text);
}
exec sqlite3 bad.fossil <bad.sql
#exec $::fossilexe sqlite3 --no-repository bad.fossil <bad.sql
#fossil_json HAI -R bad.fossil -expectError

# FOSSIL-1104 FSL_JSON_E_TIMEOUT
#     Timeout reached
# FOSSIL-1105 FSL_JSON_E_ASSERT
#     Assertion failed
# FOSSIL-1106 FSL_JSON_E_ALLOC
#     Resource allocation failed
# FOSSIL-1107 FSL_JSON_E_NYI
#     Not yet implemented
# FOSSIL-1108 FSL_JSON_E_PANIC
#     x
# FOSSIL-1109 FSL_JSON_E_MANIFEST_READ_FAILED
#     Reading artifact manifest failed
# FOSSIL-1110 FSL_JSON_E_FILE_OPEN_FAILED
#     Opening file failed

# FOSSIL-2000 FSL_JSON_E_AUTH
#     Authentication error
# FOSSIL-2001 FSL_JSON_E_MISSING_AUTH
#     Authentication info missing from request
# FOSSIL-2002 FSL_JSON_E_DENIED
#     Access denied
# FOSSIL-2003 FSL_JSON_E_WRONG_MODE
#     Request not allowed (wrong operation mode)
# FOSSIL-2100 FSL_JSON_E_LOGIN_FAILED
#     Login failed
# FOSSIL-2101 FSL_JSON_E_LOGIN_FAILED_NOSEED
#     Anonymous login attempt was missing password seed
# FOSSIL-2102 FSL_JSON_E_LOGIN_FAILED_NONAME
#     Login failed - name not supplied
# FOSSIL-2103 FSL_JSON_E_LOGIN_FAILED_NOPW
#     Login failed - password not supplied
# FOSSIL-2104 FSL_JSON_E_LOGIN_FAILED_NOTFOUND
#     Login failed - no match found

# FOSSIL-3000 FSL_JSON_E_USAGE
#     Usage error
# FOSSIL-3001 FSL_JSON_E_INVALID_ARGS
#     Invalid argument(s)

# FOSSIL-3002 FSL_JSON_E_MISSING_ARGS
#     Missing argument(s)
write_file e3002.json {
  {"color":"yellow",
   "really":"no, blue",
   "number":42
  }
}
fossil_json --json-input e3002.json -expectError
test json-RC-3002-strange-CLI-exit {$CODE != 0}
test_json_envelope json-RC-3002-strange-env {fossil timestamp command procTimeUs \
procTimeMs resultCode resultText} {payload}
test json-RC-3002-strange-code {[dict get $JR resultCode] eq "FOSSIL-3002"}


# FOSSIL-3003 FSL_JSON_E_AMBIGUOUS_UUID
#     Resource identifier is ambiguous
# FOSSIL-3004 FSL_JSON_E_UNRESOLVED_UUID
#     Provided uuid/tag/branch could not be resolved
# FOSSIL-3005 FSL_JSON_E_RESOURCE_ALREADY_EXISTS
#     Resource already exists
# FOSSIL-3006 FSL_JSON_E_RESOURCE_NOT_FOUND
#     Resource not found

# FOSSIL-4000 FSL_JSON_E_DB
#     Database error
# FOSSIL-4001 FSL_JSON_E_STMT_PREP
#     Statement preparation failed
# FOSSIL-4002 FSL_JSON_E_STMT_BIND
#     Statement parameter binding failed
# FOSSIL-4003 FSL_JSON_E_STMT_EXEC
#     Statement execution/stepping failed
# FOSSIL-4004 FSL_JSON_E_DB_LOCKED
#     Database is locked
# FOSSIL-4101 FSL_JSON_E_DB_NEEDS_REBUILD
#     Fossil repository needs to be rebuilt

# FOSSIL-4102 FSL_JSON_E_DB_NOT_FOUND
#     Fossil repository db file could not be found.
fossil close
fossil_json HAI -expectError
test json-RC-4102-CLI-exit {$CODE != 0}
test_json_envelope json-RC-1102-env {fossil timestamp command procTimeUs \
procTimeMs resultCode resultText} {payload}
test json-1 {[dict get $JR resultCode] eq "FOSSIL-4102"}
fossil open .rep.fossil

# FOSSIL-4103 FSL_JSON_E_DB_NOT_VALID
#     Fossil repository db file is not valid.
write_file nope.fossil {
This is not a fossil repo. It ought to be a SQLite db with a well-known schema,
but it is actually just a block of text.
}

Changes to test/merge5.test.

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
fossil update br1
checkout-test 120 {
  35815cf5804e8933eab64ae34e00bbb381be72c5  four.txt
  da5c8346496f3421cb58f84b6e59e9531d9d424d  one.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil merge br4
checkout-test 121 {
  35815cf5804e8933eab64ae34e00bbb381be72c5  four.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil undo
fossil update br4
checkout-test 122 {
  6e167b139c294bed560e2e30b352361b101e1f39  four.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil merge br1
checkout-test 123 {
  6e167b139c294bed560e2e30b352361b101e1f39  four.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil undo








|












|







220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
fossil update br1
checkout-test 120 {
  35815cf5804e8933eab64ae34e00bbb381be72c5  four.txt
  da5c8346496f3421cb58f84b6e59e9531d9d424d  one.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil merge br4 -expectError
checkout-test 121 {
  35815cf5804e8933eab64ae34e00bbb381be72c5  four.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil undo
fossil update br4
checkout-test 122 {
  6e167b139c294bed560e2e30b352361b101e1f39  four.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil merge br1 -expectError
checkout-test 123 {
  6e167b139c294bed560e2e30b352361b101e1f39  four.txt
  ed24d19d726d173f18dbf4a9a0f8514daa3e3ca4  three.txt
  278a402316510f6ae4a77186796a6bde78c7dbc1  two.txt
}
fossil undo

Changes to test/tester.tcl.

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
# 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 prompt_file [file join $::tempPath fossil_prompt_answer]
    write_file $prompt_file $answer\n
    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
}








>
>
>
>
>







>









|







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
# 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} {
    protOut $answer
    set prompt_file [file join $::tempPath fossil_prompt_answer]
    write_file $prompt_file $answer\n
    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
}

Changes to test/th1.test.

911
912
913
914
915
916
917
918

919
920
921
922










923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941

942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996

fossil test-th-eval "reinitialize 1; globalState configuration"
test th1-reinitialize-2 {$RESULT ne ""}

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

#
# NOTE: This test may fail if the command names do not always come out in a

#       deterministic order from TH1.
#
fossil test-th-eval "info commands"











if {$th1Tcl} {
  test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
      enable_output uplevel dir http expr glob_match utime styleFooter encode64\
      catch if tclReady searchable reinitialize combobox lindex tclIsSafe query\
      html anoncap randhex llength for set break regexp markdown styleHeader\
      puts return checkout decorate artifact trace wiki proc tclInvoke hascap\
      globalState continue getParameter hasfeature setting lsearch breakpoint\
      upvar render repository string unset setParameter list error info rename\
      tclExpr array anycap tclEval httpize tclMakeSafe}}
} else {
  test th1-info-commands-1 {$RESULT eq {linecount htmlize date stime\
      enable_output uplevel dir http expr glob_match utime styleFooter encode64\
      catch if tclReady searchable reinitialize combobox lindex query html\
      anoncap randhex llength for set break regexp markdown styleHeader puts\
      return checkout decorate artifact trace wiki proc hascap globalState\
      continue getParameter hasfeature setting lsearch breakpoint upvar render\
      repository string unset setParameter list error info rename array anycap\
      httpize}}
}


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

fossil test-th-eval "info vars"

if {$th1Hooks} {
  test th1-info-vars-1 {$RESULT eq \
      "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-1 {$RESULT eq "tcl_platform"}
}

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

fossil test-th-eval "set x 1; info vars"

if {$th1Hooks} {
  test th1-info-vars-2 {$RESULT eq \
      "x th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-2 {$RESULT eq "x tcl_platform"}
}

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

fossil test-th-eval "set x 1; unset x; info vars"

if {$th1Hooks} {
  test th1-info-vars-3 {$RESULT eq \
      "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-3 {$RESULT eq "tcl_platform"}
}

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

fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
test th1-info-vars-4 {$RESULT eq "x"}

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

fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"

if {$th1Hooks} {
  test th1-info-vars-5 {$RESULT eq \
      "th_stack_trace y cmd_flags tcl_platform cmd_name cmd_args"}
} else {
  test th1-info-vars-5 {$RESULT eq "y tcl_platform"}
}

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

fossil test-th-eval "array exists foo"
test th1-array-exists-1 {$RESULT eq "0"}








|
>
|


|
>
>
>
>
>
>
>
>
>
>

|
<
<
<
<
<
<
<

|
<
<
<
<
<
<
<

>






|
|









|
|

|







|
|














|
|

|







911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935







936
937







938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994

fossil test-th-eval "reinitialize 1; globalState configuration"
test th1-reinitialize-2 {$RESULT ne ""}

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

#
# NOTE: This test will fail if the command names are added to TH1, or
#       moved from Tcl builds to plain or the reverse. Sorting the 
#       command lists eliminates a dependence on order.
#
fossil test-th-eval "info commands"
set sorted_result [lsort $RESULT]
protOut "Sorted: $sorted_result"
set base_commands {anoncap anycap array artifact break breakpoint catch\
      checkout combobox continue date decorate dir enable_output encode64\
      error expr for getParameter glob_match globalState hascap hasfeature\
      html htmlize http httpize if info insertCsrf lindex linecount list\
      llength lsearch markdown proc puts query randhex redirect regexp\
      reinitialize rename render repository return searchable set\
      setParameter setting stime string styleFooter styleHeader tclReady\
      trace unset uplevel upvar utime verifyCsrf wiki}
set tcl_commands {tclEval tclExpr tclInvoke tclIsSafe tclMakeSafe}
if {$th1Tcl} {
  test th1-info-commands-1 {$sorted_result eq [lsort "$base_commands $tcl_commands"]}







} else {
  test th1-info-commands-1 {$sorted_result eq [lsort "$base_commands"]}







}


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

fossil test-th-eval "info vars"

if {$th1Hooks} {
  test th1-info-vars-1 {[lsort $RESULT] eq \
      [lsort "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"]}
} else {
  test th1-info-vars-1 {$RESULT eq "tcl_platform"}
}

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

fossil test-th-eval "set x 1; info vars"

if {$th1Hooks} {
  test th1-info-vars-2 {[lsort $RESULT] eq \
      [lsort "x th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"]}
} else {
  test th1-info-vars-2 {[lsort $RESULT] eq [lsort "x tcl_platform"]}
}

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

fossil test-th-eval "set x 1; unset x; info vars"

if {$th1Hooks} {
  test th1-info-vars-3 {[lsort $RESULT] eq \
      [lsort "th_stack_trace cmd_flags tcl_platform cmd_name cmd_args"]}
} else {
  test th1-info-vars-3 {$RESULT eq "tcl_platform"}
}

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

fossil test-th-eval "proc foo {} {set x 1; info vars}; foo"
test th1-info-vars-4 {$RESULT eq "x"}

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

fossil test-th-eval "set y 1; proc foo {} {set x 1; uplevel 1 {info vars}}; foo"

if {$th1Hooks} {
  test th1-info-vars-5 {[lsort $RESULT] eq \
      [lsort "th_stack_trace y cmd_flags tcl_platform cmd_name cmd_args"]}
} else {
  test th1-info-vars-5 {[lsort $RESULT] eq [lsort "y tcl_platform"]}
}

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

fossil test-th-eval "array exists foo"
test th1-array-exists-1 {$RESULT eq "0"}