test demo languages

7 years ago · 3cf4fe260e
parent b16e11a8a2
commit 3cf4fe260e
36 changed files with 613 additions and 87 deletions
--- a/beautiful-racket-demo/basic-demo-2/info.rkt
+++ b/beautiful-racket-demo/basic-demo-2/info.rkt
@ -1,4 +1,4 @@
 #lang info

-(define compile-omit-paths 'all)
-(define test-omit-paths 'all)
+(define compile-omit-paths '("private"))
+(define test-omit-paths '("private" "sample-input.rkt"))
--- a/beautiful-racket-demo/basic-demo-2/sample-cond.rkt
+++ b/beautiful-racket-demo/basic-demo-2/sample-cond.rkt
@ -5,4 +5,4 @@
 40 print a > 4
 50 print b = 10
 60 print b < 11
-70 print ! (b = 100)
+70 print rem (b = 100)
--- a/beautiful-racket-demo/basic-demo-2/sample-def.rkt
+++ b/beautiful-racket-demo/basic-demo-2/sample-def.rkt
@ -1,4 +0,0 @@
-#lang basic-demo-2
-10 rem all results should be 1
-20 def f(x) = x * x
-30 print f((1+2)*3) = 81
--- a/beautiful-racket-demo/basic-demo-2/sample-import.rkt
+++ b/beautiful-racket-demo/basic-demo-2/sample-import.rkt
@ -1,3 +0,0 @@
-#lang br
-(require basic-demo-2/sample-var)
-(* a a)
--- a/beautiful-racket-demo/basic-demo-2/test-sources.rkt
+++ b/beautiful-racket-demo/basic-demo-2/test-sources.rkt
@ -0,0 +1,34 @@
+#lang at-exp br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "sample.rkt") "one
+
+three
+4
+")
+(check-equal? (run-source "sample-var.rkt") "15
+75
+")
+(check-equal? (run-source "sample-math.rkt") "1
+1
+1
+1
+1
+1
+1
+")
+(check-equal? (run-source "sample-gosub.rkt") "hello
+world
+third
+hi
+")
+(check-equal? (run-source "sample-for.rkt") "19
+18
+17
+29
+28
+27
+39
+38
+37
+")
--- a/beautiful-racket-demo/basic-demo-2a/info.rkt
+++ b/beautiful-racket-demo/basic-demo-2a/info.rkt
@ -1,4 +1 @@
 #lang info
-
-(define compile-omit-paths 'all)
-(define test-omit-paths 'all)
--- a/beautiful-racket-demo/basic-demo-2a/test-sources.rkt
+++ b/beautiful-racket-demo/basic-demo-2a/test-sources.rkt
@ -0,0 +1,8 @@
+#lang at-exp br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "sample.rkt") "one
+
+three
+4
+")
--- a/beautiful-racket-demo/basic-demo-3/info.rkt
+++ b/beautiful-racket-demo/basic-demo-3/info.rkt
@ -1,4 +1,4 @@
 #lang info

-(define compile-omit-paths 'all)
-(define test-omit-paths 'all)
+(define compile-omit-paths '("private"))
+(define test-omit-paths '("private" "sample-input.rkt"))
--- a/beautiful-racket-demo/basic-demo-3/sample-cond.rkt
+++ b/beautiful-racket-demo/basic-demo-3/sample-cond.rkt
@ -5,4 +5,4 @@
 40 print a > 4
 50 print b = 10
 60 print b < 11
-70 print ! (b = 100)
+70 print rem (b = 100)
--- a/beautiful-racket-demo/basic-demo-3/sample-provide.rkt
+++ b/beautiful-racket-demo/basic-demo-3/sample-provide.rkt
@ -1,6 +1,6 @@
 #lang br
-(require "sample-export.rkt")
-(provide (all-from-out "sample-export.rkt"))
+(require "sample-exporter.rkt")
+(provide (all-from-out "sample-exporter.rkt"))
 div
 x
 (div x 10)
--- a/beautiful-racket-demo/basic-demo-3/test-sources.rkt
+++ b/beautiful-racket-demo/basic-demo-3/test-sources.rkt
@ -0,0 +1,72 @@
+#lang at-exp br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "sample.rkt") "one
+
+three
+4
+")
+
+(check-equal? (run-source "sample-cond.rkt") "1
+1
+1
+
+")
+
+(check-equal? (run-source "sample-def.rkt") "60
+600
+3
+")
+
+(check-equal? (run-source "sample-exporter.rkt") "1
+2
+3
+")
+
+(check-equal? (run-source "sample-for.rkt") "1
+9
+1
+8
+1
+7
+2
+9
+2
+8
+2
+7
+3
+9
+3
+8
+3
+7
+")
+
+(check-equal? (run-source "sample-gosub.rkt") "first
+second
+third
+fourth
+")
+
+(check-equal? (run-source "sample-import.rkt") "53
+0
+10
+")
+
+(check-equal? (run-source "sample-importer.rkt") "#<procedure:div>
+20
+2
+")
+
+(check-equal? (run-source "sample-math.rkt") "1
+1
+1
+1
+1
+1
+1
+")
+
+(check-equal? (run-source "sample-shell.rkt") "got shell args: 000\n")
+
--- a/beautiful-racket-demo/basic-demo/expander-runtime-errors.rkt
+++ b/beautiful-racket-demo/basic-demo/expander-runtime-errors.rkt
@ -1,61 +0,0 @@
-#lang br/quicklang
-(provide (rename-out [b-module-begin #%module-begin])
-         (matching-identifiers-out #rx"^b-" (all-defined-out)))
-
-(define-macro (b-module-begin (b-program LINE ...))
-  (with-pattern
-      ([(LINE-NUM ...)
-        (filter-stx-prop 'b-line-num
-                         (stx-flatten #'(LINE ...)))]
-       [(LINE-ID ...) (prefix-ids "line-" #'(LINE-NUM ...))])
-    #'(#%module-begin
-       LINE ...
-       (define line-table
-         (apply hasheqv (append (list LINE-NUM LINE-ID) ...)))
-       (run line-table))))
-
-(define-macro (b-line LINE-NUMBER STATEMENT ...)
-  (with-pattern
-      ([LINE-NUMBER-ID (prefix-id "line-" #'LINE-NUMBER
-                                  #:source #'LINE-NUMBER)]
-       [ORIG-LOC caller-stx])
-    (syntax/loc caller-stx
-      (define (LINE-NUMBER-ID #:srcloc? [loc #f])
-        (if loc
-            (syntax-srcloc #'ORIG-LOC)
-            (begin (void) STATEMENT ...))))))
-
-(define b-rem void)
-(define (b-print [val ""]) (displayln val))
-(define (b-sum . nums) (apply + nums))
-(define (b-num-expr expr)
-  (if (integer? expr) (inexact->exact expr) expr))
-
-(struct $program-end-signal ())
-(define (b-end) (raise ($program-end-signal)))
-
-(struct $change-line-signal (val))
-(define (b-goto expr) (raise ($change-line-signal expr)))
-
-(define-exn line-not-found exn:fail)
-
-(define (run line-table)
-  (define line-vec
-    (list->vector (sort (hash-keys line-table) <)))
-  (with-handlers ([$program-end-signal? void])
-    (for/fold ([line-idx 0])
-              ([i (in-naturals)])
-      (unless (< line-idx (vector-length line-vec)) (b-end))
-      (define line-num (vector-ref line-vec line-idx))
-      (define line-proc (hash-ref line-table line-num))
-      (with-handlers
-          ([$change-line-signal?
-            (λ (cls)
-              (define clsv ($change-line-signal-val cls))
-              (or
-               (and (exact-positive-integer? clsv)
-                    (vector-member clsv line-vec))
-               (raise-line-not-found
-                (line-proc #:srcloc? #t))))])
-        (line-proc)
-        (add1 line-idx)))))
--- a/beautiful-racket-demo/basic-demo/info.rkt
+++ b/beautiful-racket-demo/basic-demo/info.rkt
@ -1,4 +1,4 @@
 #lang info

-(define compile-omit-paths 'all)
-(define test-omit-paths 'all)
+(define test-omit-paths '("private"))
+(define compile-omit-paths '("private"))
--- a/beautiful-racket-demo/basic-demo/test-parser.rkt
+++ b/beautiful-racket-demo/basic-demo/test-parser.rkt
@ -8,4 +8,8 @@
 here
  )

-(parse-to-datum (apply-tokenizer-maker make-tokenizer str))
+(module+ test
+  (require rackunit)
+  (check-equal?
+   (parse-to-datum (apply-tokenizer-maker make-tokenizer str))
+   '(b-program (b-line 10 (b-rem "rem print")) (b-line 20 (b-end)))))
--- a/beautiful-racket-demo/basic-demo/test-sources.rkt
+++ b/beautiful-racket-demo/basic-demo/test-sources.rkt
@ -0,0 +1,8 @@
+#lang at-exp br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "sample.rkt") "one
+
+three
+4
+")
--- a/beautiful-racket-demo/bf-demo/info.rkt
+++ b/beautiful-racket-demo/bf-demo/info.rkt
@ -1,3 +1,3 @@
 #lang info

-(define compile-omit-paths 'all)
+(define test-omit-paths '("factorial.rkt" "test-reader.rkt"))
--- a/beautiful-racket-demo/bf-demo/parser-tester.rkt
+++ b/beautiful-racket-demo/bf-demo/parser-tester.rkt
@ -1,3 +1,42 @@
 #lang br
 (require "parser.rkt")
-(parse-to-datum "++++-+++-++-++[>++++-+++-++-++<-]>.")
+(module+ test
+  (require rackunit)
+  (check-equal? (parse-to-datum "++++-+++-++-++[>++++-+++-++-++<-]>.")
+                '(bf-program
+                  (bf-op "+")
+                  (bf-op "+")
+                  (bf-op "+")
+                  (bf-op "+")
+                  (bf-op "-")
+                  (bf-op "+")
+                  (bf-op "+")
+                  (bf-op "+")
+                  (bf-op "-")
+                  (bf-op "+")
+                  (bf-op "+")
+                  (bf-op "-")
+                  (bf-op "+")
+                  (bf-op "+")
+                  (bf-loop
+                   "["
+                   (bf-op ">")
+                   (bf-op "+")
+                   (bf-op "+")
+                   (bf-op "+")
+                   (bf-op "+")
+                   (bf-op "-")
+                   (bf-op "+")
+                   (bf-op "+")
+                   (bf-op "+")
+                   (bf-op "-")
+                   (bf-op "+")
+                   (bf-op "+")
+                   (bf-op "-")
+                   (bf-op "+")
+                   (bf-op "+")
+                   (bf-op "<")
+                   (bf-op "-")
+                   "]")
+                  (bf-op ">")
+                  (bf-op "."))))
--- a/beautiful-racket-demo/bf-demo/test-sources.rkt
+++ b/beautiful-racket-demo/bf-demo/test-sources.rkt
@ -0,0 +1,6 @@
+#lang br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "atsign.rkt") "@")
+(check-equal? (run-source "atsign-sexp.rkt") "@")
+(check-equal? (run-source "hello.rkt") "Hello, World!")
--- a/beautiful-racket-demo/chip8-demo/chip8.rkt
+++ b/beautiful-racket-demo/chip8-demo/chip8.rkt
--- a/beautiful-racket-demo/chip8-demo/info.rkt
+++ b/beautiful-racket-demo/chip8-demo/info.rkt
@ -0,0 +1,4 @@
+#lang info
+
+(define compile-omit-paths 'all)
+(define test-omit-paths 'all)
--- a/beautiful-racket-demo/funstacker-demo/info.rkt
+++ b/beautiful-racket-demo/funstacker-demo/info.rkt
@ -0,0 +1,3 @@
+#lang info
+
+(define test-omit-paths 'all)
--- a/beautiful-racket-demo/funstacker-demo/test-sources.rkt
+++ b/beautiful-racket-demo/funstacker-demo/test-sources.rkt
@ -0,0 +1,4 @@
+#lang br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "funstacker-test.rkt") "36")
--- a/beautiful-racket-demo/hdl-tst-demo/info.rkt
+++ b/beautiful-racket-demo/hdl-tst-demo/info.rkt
@ -0,0 +1,4 @@
+#lang info
+
+(define compile-omit-paths 'all)
+(define test-omit-paths 'all)
--- a/beautiful-racket-demo/info.rkt
+++ b/beautiful-racket-demo/info.rkt
@ -8,4 +8,3 @@
 (define version "1.1")
 (define deps '("base" "sugar" "beautiful-racket-lib" "rackunit-lib" "brag" "br-parser-tools-lib" "srfi-lib" "draw-lib" "syntax-color-lib" "gui-lib"))
 (define build-deps '("racket-doc" "scribble-lib"))
-(define test-omit-paths 'all)
--- a/beautiful-racket-demo/jsonic-demo-2/info.rkt
+++ b/beautiful-racket-demo/jsonic-demo-2/info.rkt
@ -0,0 +1 @@
+#lang info
--- a/beautiful-racket-demo/jsonic-demo-2/test-sources.rkt
+++ b/beautiful-racket-demo/jsonic-demo-2/test-sources.rkt
@ -0,0 +1,11 @@
+#lang at-exp br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "jsonic-test.rkt") @string-append{
+[
+  null,
+  42,
+  true,
+  ["array","of","strings"],
+  {"key-2":false,"key-1":null,"key-3":{"subkey":21}}
+]})
--- a/beautiful-racket-demo/jsonic-demo-3/test-sources.rkt
+++ b/beautiful-racket-demo/jsonic-demo-3/test-sources.rkt
@ -0,0 +1,11 @@
+#lang at-exp br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "jsonic-test.rkt") @string-append{
+[
+  null,
+  42,
+  true,
+  ["array","of","strings"],
+  {"key-2":false,"key-1":null,"key-3":{"subkey":21}}
+]})
--- a/beautiful-racket-demo/jsonic-demo/info.rkt
+++ b/beautiful-racket-demo/jsonic-demo/info.rkt
@ -0,0 +1,2 @@
+#lang info
+
--- a/beautiful-racket-demo/jsonic-demo/test-sources.rkt
+++ b/beautiful-racket-demo/jsonic-demo/test-sources.rkt
@ -0,0 +1,11 @@
+#lang at-exp br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "jsonic-test.rkt") @string-append{
+[
+  null,
+  42,
+  true,
+  ["array","of","strings"],
+  {"key-2":false,"key-1":null,"key-3":{"subkey":21}}
+]})
--- a/beautiful-racket-demo/stacker-demo/info.rkt
+++ b/beautiful-racket-demo/stacker-demo/info.rkt
@ -0,0 +1 @@
+#lang info
--- a/beautiful-racket-demo/stacker-demo/test-sources.rkt
+++ b/beautiful-racket-demo/stacker-demo/test-sources.rkt
@ -0,0 +1,4 @@
+#lang br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "stacker-test.rkt") "36")
--- a/beautiful-racket-demo/stackerizer-demo/info.rkt
+++ b/beautiful-racket-demo/stackerizer-demo/info.rkt
@ -0,0 +1 @@
+#lang info
--- a/beautiful-racket-demo/stackerizer-demo/test-sources.rkt
+++ b/beautiful-racket-demo/stackerizer-demo/test-sources.rkt
@ -0,0 +1,9 @@
+#lang br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "stackerizer-test.rkt") "4
+8
+
+3
+*
+")
--- a/beautiful-racket-demo/wires-demo/info.rkt
+++ b/beautiful-racket-demo/wires-demo/info.rkt
@ -0,0 +1 @@
+#lang info
--- a/beautiful-racket-demo/wires-demo/test-sources.rkt
+++ b/beautiful-racket-demo/wires-demo/test-sources.rkt
@ -0,0 +1,353 @@
+#lang br
+(require br/test rackunit)
+ 
+(check-equal? (run-source "test.rkt") "d: 72
+e: 507
+f: 492
+g: 114
+h: 65412
+i: 65079
+x: 123
+y: 456
+")
+
+(check-equal? (run-source "puzzle.rkt") "bo: 10292
+ly: 4045
+fq: 6560
+cq: 15518
+ga: 60815
+u: 1
+a: 46065
+ay: 65531
+hf: 15568
+lr: 8187
+lu: 7027
+ek: 15935
+cy: 0
+hv: 1438
+bi: 1
+ik: 9873
+t: 0
+ed: 128
+ko: 2047
+bx: 65515
+cu: 63740
+q: 65533
+lx: 46065
+lp: 64761
+fw: 16329
+r: 1997
+dk: 3655
+bj: 4
+ce: 10
+ij: 59287
+gj: 59011
+ld: 8090
+lw: 46064
+lc: 23032
+an: 0
+gq: 7140
+lh: 1011
+g: 245
+lo: 774
+db: 26676
+cz: 22
+cg: 20584
+fg: 4096
+iu: 64720
+kz: 14054
+cn: 513
+bk: 5
+hc: 29505
+jh: 9280
+bt: 64509
+kw: 16374
+kv: 2514
+il: 65457
+v: 837
+jn: 32360
+fr: 1640
+bh: 23539
+gd: 57743
+hm: 15858
+lf: 8090
+av: 525
+fo: 52486
+hp: 9506
+ln: 2031
+ky: 63215
+km: 2022
+en: 15935
+fu: 65503
+ji: 56255
+jp: 32360
+gw: 8704
+l: 160
+fm: 19718
+jx: 8126
+eq: 89
+lz: 32768
+ez: 65471
+jq: 8090
+ej: 2597
+dn: 62970
+kc: 4640
+bf: 0
+fl: 179
+dy: 13338
+lm: 783
+ef: 1827
+ft: 32
+kq: 65055
+kk: 16180
+da: 22
+au: 2100
+ar: 0
+fn: 32768
+fj: 1
+hx: 31136
+lg: 2022
+kj: 0
+eh: 1282
+id: 8189
+li: 252
+br: 5406
+gt: 58975
+gh: 26243
+cc: 39417
+ec: 1955
+ls: 1160
+m: 65375
+ib: 7988
+dj: 65279
+ll: 65295
+jr: 4045
+js: 1011
+bg: 65535
+w: 32768
+fk: 178
+jm: 5758
+im: 8320
+eg: 3879
+gz: 1
+le: 0
+bu: 4380
+co: 65022
+x: 33605
+k: 487
+ge: 1
+ih: 16121
+gp: 64495
+ee: 65407
+jy: 3098
+ff: 47903
+az: 2617
+fi: 43807
+jl: 5758
+ha: 718
+y: 8401
+dd: 26676
+bn: 41169
+ie: 1796
+z: 4200
+lk: 240
+cf: 11
+bc: 65495
+hl: 6642
+gc: 62463
+s: 1
+fz: 11401
+fe: 12562
+eo: 1
+ab: 5242
+bm: 32768
+hi: 8186
+lb: 23032
+ci: 53352
+la: 0
+gg: 359
+gk: 14752
+de: 6669
+lt: 64375
+lj: 1023
+jt: 4095
+ax: 4
+c: 0
+hr: 8448
+ig: 6393
+ew: 1232
+bs: 1026
+h: 16
+ma: 36813
+lv: 1
+je: 59339
+hb: 719
+er: 6669
+iv: 16180
+hs: 57087
+bl: 8401
+kl: 4045
+p: 2
+lq: 1257
+cr: 5130
+do: 5194
+cj: 13338
+be: 23539
+gi: 32768
+ic: 1997
+ep: 88
+ks: 4063
+gv: 59079
+hh: 1946
+fh: 61439
+hj: 1544
+o: 1999
+jo: 0
+hd: 32768
+dc: 0
+kn: 505
+ck: 6669
+ba: 6777
+iw: 8090
+kr: 1567
+ei: 64253
+as: 16802
+jb: 6268
+df: 3334
+bp: 5146
+cd: 1
+bb: 40
+aj: 47079
+kx: 2320
+ap: 2
+ea: 1667
+aq: 16802
+fc: 1665
+kt: 1549
+ii: 6248
+di: 256
+fy: 60607
+n: 327
+bq: 1286
+kp: 480
+dx: 0
+ia: 15976
+am: 47078
+ch: 32768
+he: 62273
+hg: 7784
+bz: 47609
+ku: 63986
+ac: 8
+al: 65534
+cx: 63740
+if: 63739
+dz: 3334
+it: 32768
+dl: 7759
+aw: 2621
+jj: 56216
+cv: 0
+eb: 416
+hz: 63904
+fb: 14227
+gl: 7376
+gb: 3072
+jk: 0
+kb: 32748
+dm: 2565
+fa: 6033
+dh: 3911
+jc: 16252
+aa: 1050
+hk: 63991
+in: 57215
+gf: 358
+hy: 32768
+ir: 2879
+ix: 2022
+fd: 63870
+em: 65535
+cm: 7823
+ev: 4929
+iq: 2878
+cl: 1667
+jd: 6196
+dg: 833
+at: 4200
+jz: 62437
+ai: 13475
+dt: 0
+ka: 5028
+du: 44
+fv: 8136
+ki: 16180
+iz: 1922
+iy: 8190
+es: 32768
+ey: 64
+bd: 6737
+fx: 4928
+jf: 10056
+eu: 9859
+kh: 11516
+jg: 65496
+et: 39437
+fp: 13121
+cb: 57343
+by: 14632
+ao: 2
+cp: 7310
+af: 13555
+ca: 8192
+kf: 0
+jw: 3134
+fs: 8168
+el: 0
+kd: 60895
+ex: 6097
+dp: 31870
+cw: 65535
+gu: 8772
+dw: 13338
+gx: 56831
+ja: 63613
+ip: 1
+ah: 65455
+f: 52
+cs: 60405
+ke: 28108
+ju: 961
+ct: 10388
+io: 57137
+jv: 64574
+dv: 44
+dq: 0
+d: 418
+kg: 11516
+dr: 65535
+bv: 14652
+gr: 15332
+hq: 63331
+i: 65519
+hn: 6352
+gy: 50375
+ak: 1
+bw: 20
+ht: 54883
+is: 31952
+gm: 1844
+j: 229
+gs: 6560
+ds: 31870
+e: 209
+go: 1040
+gn: 8180
+ag: 80
+hw: 1439
+b: 1674
+ae: 5234
+ad: 65527
+hu: 1
+ho: 59183
+")
--- a/beautiful-racket-lib/br/test.rkt
+++ b/beautiful-racket-lib/br/test.rkt
@ -1,6 +1,6 @@
 #lang racket/base
 (require setup/getinfo racket/runtime-path)
-(provide message)
+(provide message run-source)
 (define-runtime-path br-dir "../../beautiful-racket")
 (define gi (get-info/full br-dir))
 (define message
@ -8,5 +8,12 @@
          (if gi
              (format " v~a " (gi 'version))
              " ")))
+
+(require racket/port racket/system compiler/find-exe)
+(define (run-source path)
+  (define racket-path (find-exe))
+  (define cmd-string (format "'~a' ~a" racket-path path))
+  (with-output-to-string (λ () (system cmd-string))))
+
 (module+ main
  (displayln message))