@@ -1532,11 +1532,11 @@ the settings above should match r5rs
1532
1532
1533
1533
1534
1534
(define (prepare-for-test-expression)
1535
- (let ([ drs (wait-for-drracket-frame)] )
1536
- (clear-definitions drs)
1537
- (set-language #t )
1538
- (sleep 1 ) ;; this shouldn't be neccessary....
1539
- (do-execute drs) ))
1535
+ (define drs (wait-for-drracket-frame))
1536
+ (clear-definitions drs)
1537
+ (set-language #t )
1538
+ (sleep 1 ) ;; this shouldn't be neccessary....
1539
+ (do-execute drs))
1540
1540
1541
1541
;; test-setting : (-> void) string string string -> void
1542
1542
;; opens the language dialog, runs `set-setting'
@@ -1552,34 +1552,37 @@ the settings above should match r5rs
1552
1552
(let ([f (test:get-active-top-level-window)])
1553
1553
(fw:test:button-push "OK " )
1554
1554
(wait-for-new-frame f))
1555
- (let* ([drs (test:get-active-top-level-window)]
1556
- [interactions (send drs get-interactions-text)])
1557
- (clear-definitions drs)
1558
- (insert-in-definitions drs expression)
1559
- (do-execute drs)
1560
- (when interactions-expr
1561
- (insert-in-interactions drs interactions-expr)
1562
- (alt-return-in-interactions drs)
1563
- (wait-for-computation drs))
1564
- (let* ([got (fetch-output/should-be-tested drs)])
1565
- (unless (if (regexp? result)
1566
- (regexp-match? result got)
1567
- (string=? result got))
1568
- (eprintf "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n "
1569
- (language) setting-name expression result got)))))
1555
+ (define drs (test:get-active-top-level-window))
1556
+ (send drs get-interactions-text)
1557
+ (clear-definitions drs)
1558
+ (insert-in-definitions drs expression)
1559
+ (do-execute drs)
1560
+ (when interactions-expr
1561
+ (insert-in-interactions drs interactions-expr)
1562
+ (alt-return-in-interactions drs)
1563
+ (wait-for-computation drs))
1564
+ (define got (fetch-output/should-be-tested drs))
1565
+ (unless (if (regexp? result)
1566
+ (regexp-match? result got)
1567
+ (string=? result got))
1568
+ (eprintf "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n "
1569
+ (language)
1570
+ setting-name
1571
+ expression
1572
+ result
1573
+ got)))
1570
1574
1571
1575
(define (test-hash-bang)
1572
- (let* ([expression "#!/bin/sh\n1 " ]
1573
- [result "1 " ]
1574
- [drs (test:get-active-top-level-window)]
1575
- [interactions (queue-callback (λ () (send drs get-interactions-text)))])
1576
- (clear-definitions drs)
1577
- (insert-in-definitions drs expression)
1578
- (do-execute drs)
1579
- (let* ([got (fetch-output/should-be-tested drs)])
1580
- (unless (string=? "1 " got)
1581
- (eprintf "FAILED: ~s ~a test\n expected: ~s\n got: ~s\n "
1582
- (language) expression result got)))))
1576
+ (define expression "#!/bin/sh\n1 " )
1577
+ (define result "1 " )
1578
+ (define drs (test:get-active-top-level-window))
1579
+ (queue-callback (λ () (send drs get-interactions-text)))
1580
+ (clear-definitions drs)
1581
+ (insert-in-definitions drs expression)
1582
+ (do-execute drs)
1583
+ (define got (fetch-output/should-be-tested drs))
1584
+ (unless (string=? "1 " got)
1585
+ (eprintf "FAILED: ~s ~a test\n expected: ~s\n got: ~s\n " (language) expression result got)))
1583
1586
1584
1587
(define (fetch-output/should-be-tested . args)
1585
1588
(regexp-replace (regexp
@@ -1683,13 +1686,13 @@ the settings above should match r5rs
1683
1686
(when (and has-sharing? show-sharing)
1684
1687
(fw:test:set-check-box!
1685
1688
"Show sharing in values "
1686
- (if ( eq? show-sharing 'on ) #t #f )))
1689
+ (eq? show-sharing 'on )))
1687
1690
(fw:test:set-check-box!
1688
1691
"Insert newlines in printed values "
1689
1692
pretty?)
1690
- (let ([ f (test:get-active-top-level-window)] )
1691
- (fw:test:button-push "OK " )
1692
- (wait-for-new-frame f) ))
1693
+ (define f (test:get-active-top-level-window))
1694
+ (fw:test:button-push "OK " )
1695
+ (wait-for-new-frame f))
1693
1696
(define (shorten str)
1694
1697
(if ((string-length str) . <= . 45 )
1695
1698
str
@@ -1774,15 +1777,14 @@ the settings above should match r5rs
1774
1777
(unless (member #\newline (string->list got))
1775
1778
(eprintf "long output should have contained newlines, got ~s\n " got)))
1776
1779
1777
- (let ()
1778
- (clear-definitions drr)
1779
- (insert-in-definitions drr (defs-prefix))
1780
- (insert-in-definitions drr "(print-value-columns 1000) " )
1781
- (insert-in-definitions drr "(build-list 100 values) " )
1782
- (do-execute drr)
1783
- (define got (fetch-output/should-be-tested drr))
1784
- (when (member #\newline (string->list got))
1785
- (eprintf "long output should not have contained newlines, got ~s\n " got)))))
1780
+ (clear-definitions drr)
1781
+ (insert-in-definitions drr (defs-prefix))
1782
+ (insert-in-definitions drr "(print-value-columns 1000) " )
1783
+ (insert-in-definitions drr "(build-list 100 values) " )
1784
+ (do-execute drr)
1785
+ (define got (fetch-output/should-be-tested drr))
1786
+ (when (member #\newline (string->list got))
1787
+ (eprintf "long output should not have contained newlines, got ~s\n " got))))
1786
1788
1787
1789
(define (find-output-radio-box label)
1788
1790
(define frame (test:get-active-top-level-window))
@@ -1818,26 +1820,24 @@ the settings above should match r5rs
1818
1820
"WARNING: Interactions window is out of sync with the definitions window\\. " ))
1819
1821
1820
1822
(define (test-error-after-definition)
1821
- (let* ([drs (wait-for-drracket-frame)]
1822
- [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))])
1823
- (clear-definitions drs)
1824
- (insert-in-definitions drs (defs-prefix))
1825
- (insert-in-definitions drs "(define y 0) (define (f x) (/ x y)) (f 2) " )
1826
- (do-execute drs)
1827
- (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))])
1828
- (type-in-interactions drs "y\n " )
1829
- (wait-for-computation drs)
1830
- (let ([got
1831
- (fetch-output/should-be-tested
1832
- drs
1833
- (queue-callback/res
1834
- (λ () (send interactions-text paragraph-start-position (+ last-para 1 ))))
1835
- (queue-callback/res
1836
- (λ ()
1837
- (send interactions-text paragraph-end-position
1838
- (- (send interactions-text last-paragraph) 1 )))))])
1839
- (unless (equal? got "0 " )
1840
- (eprintf "FAILED: test-error-after-definition failed, expected 0, got ~s\n " got))))))
1823
+ (define drs (wait-for-drracket-frame))
1824
+ (define interactions-text (queue-callback/res (λ () (send drs get-interactions-text))))
1825
+ (clear-definitions drs)
1826
+ (insert-in-definitions drs (defs-prefix))
1827
+ (insert-in-definitions drs "(define y 0) (define (f x) (/ x y)) (f 2) " )
1828
+ (do-execute drs)
1829
+ (define last-para (queue-callback/res (λ () (send interactions-text last-paragraph))))
1830
+ (type-in-interactions drs "y\n " )
1831
+ (wait-for-computation drs)
1832
+ (define got
1833
+ (fetch-output/should-be-tested
1834
+ drs
1835
+ (queue-callback/res (λ () (send interactions-text paragraph-start-position (+ last-para 1 ))))
1836
+ (queue-callback/res (λ ()
1837
+ (send interactions-text paragraph-end-position
1838
+ (- (send interactions-text last-paragraph) 1 ))))))
1839
+ (unless (equal? got "0 " )
1840
+ (eprintf "FAILED: test-error-after-definition failed, expected 0, got ~s\n " got)))
1841
1841
1842
1842
1843
1843
;; test-expression : (union string 'xml 'image (listof (union string 'xml 'image)))
@@ -1915,26 +1915,20 @@ the settings above should match r5rs
1915
1915
(send interactions-text last-position))
1916
1916
(send interactions-text paste))))
1917
1917
1918
- (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))])
1919
- (alt-return-in-interactions drs)
1920
- (wait-for-computation drs)
1921
- (let ([got
1922
- (fetch-output
1923
- drs
1924
- (queue-callback/res
1925
- (λ ()
1926
- (send interactions-text paragraph-start-position (+ last-para 1 ))))
1927
- (queue-callback/res
1928
- (λ ()
1929
- (send interactions-text paragraph-end-position
1930
- (- (send interactions-text last-paragraph) 1 )))))])
1931
- (when (regexp-match re:out-of-sync got)
1932
- (error 'text-expression "got out of sync message " ))
1933
- (unless (check-expectation repl-expected got)
1934
- (eprintf (make-err-msg repl-expected)
1935
- 'interactions
1936
- (language)
1937
- expression repl-expected got))))))
1918
+ (define last-para (queue-callback/res (λ () (send interactions-text last-paragraph))))
1919
+ (alt-return-in-interactions drs)
1920
+ (wait-for-computation drs)
1921
+ (define got
1922
+ (fetch-output
1923
+ drs
1924
+ (queue-callback/res (λ () (send interactions-text paragraph-start-position (+ last-para 1 ))))
1925
+ (queue-callback/res (λ ()
1926
+ (send interactions-text paragraph-end-position
1927
+ (- (send interactions-text last-paragraph) 1 ))))))
1928
+ (when (regexp-match re:out-of-sync got)
1929
+ (error 'text-expression "got out of sync message " ))
1930
+ (unless (check-expectation repl-expected got)
1931
+ (eprintf (make-err-msg repl-expected) 'interactions (language) expression repl-expected got))))
1938
1932
1939
1933
(define (test-undefined-var id #:icon+in? [icon+in? #f ])
1940
1934
(test-expression
0 commit comments