Last change
on this file since 3859 was
3859,
checked in by felix winkelmann, 13 years ago

crunch experimental version

File size:
1.6 KB

Line  

1  #!/bin/sh 

2  # ;;; tests.scm * Hen * 

3  csc $0 k c++ "$@" o a.out DDBGALLOC D crunchdebug && ./a.out 

4  exit 

5  # 

6  

7  (use testeez crunch) 

8  

9  (testeez 

10  "crunch" 

11  

12  (testdefine 

13  "compile fac" 

14  fac 

15  (let () 

16  (crunch 

17  (define (fac n) 

18  (if (zero? n) 

19  1 

20  (* n (fac (sub1 n)))))) 

21  fac) ) 

22  

23  (test/equal "run fac" (fac 10) 3628800) 

24  

25  (testdefine 

26  "compile tak" 

27  tak 

28  (let () 

29  (crunch 

30  (define (tak x y z) 

31  (if (not (< y x)) 

32  z 

33  (tak (tak ( x 1) y z) 

34  (tak ( y 1) z x) 

35  (tak ( z 1) x y) )))) 

36  tak) ) 

37  

38  (test/equal "run tak" (tak 18 12 6) 7) 

39  

40  (test/equal 

41  "simple loop" 

42  (let () 

43  (crunch 

44  (define (loop m) 

45  (let ((count 0)) 

46  (do ((n m (sub1 n))) 

47  ((zero? n) (newline)) 

48  (writechar #\.) 

49  (set! count (add1 count))) 

50  count)) ) 

51  (loop 10)) 

52  10) 

53  

54  (testeval 

55  "loop/case" 

56  (crunch 

57  (do ((i 0 (add1 i))) 

58  ((>= i 10)) 

59  (case (bitwiseand i #x3) 

60  ((0) (display "zero\n")) 

61  ((1) (display "one\n")) 

62  ((2) (display "two\n")) 

63  ((3) (display "three\n")))))) 

64  

65  (test/equal "crunch file fft" (system "csi s chickencrunch.scm fft.scm d o fft && ./fft") 0) 

66  

67  (test/equal 

68  "string reverse" 

69  (let () 

70  (crunch 

71  (define (stringreverse str) 

72  (let* ((n (stringlength str)) 

73  (s2 (makestring n #\space))) 

74  (do ((i 0 (add1 i))) 

75  ((>= i n)) 

76  (stringset! s2 (sub1 ( n i)) (stringref str i))) 

77  s2)) ) 

78  (stringreverse "this is a test!")) 

79  "!tset a si siht") 

80  

81  (test/equal "crunch numbers" (system "csi s chickencrunch.scm numbers.scm d o numbers && ./numbers") 0) 

82  

83  ) 

Note: See
TracBrowser
for help on using the repository browser.