| 1 | # -*-perl-*-
|
|---|
| 2 |
|
|---|
| 3 | $description = 'Test the $(guile ...) function.';
|
|---|
| 4 |
|
|---|
| 5 | $details = 'This only works on systems that support it.';
|
|---|
| 6 |
|
|---|
| 7 | # If this instance of make doesn't support GNU Guile, skip it
|
|---|
| 8 | # This detects if guile is loaded using the "load" directive
|
|---|
| 9 | # $makefile = get_tmpfile();
|
|---|
| 10 | # open(MAKEFILE, "> $makefile") || die "Failed to open $makefile: $!\n";
|
|---|
| 11 | # print MAKEFILE q!
|
|---|
| 12 | # -load guile
|
|---|
| 13 | # all: ; @echo $(filter guile,$(.LOADED))
|
|---|
| 14 | # !;
|
|---|
| 15 | # close(MAKEFILE) || die "Failed to write $makefile: $!\n";
|
|---|
| 16 | # $cmd = subst_make_string("#MAKEPATH# -f $makefile");
|
|---|
| 17 | # $log = get_logfile(0);
|
|---|
| 18 | # $code = run_command_with_output($log, $cmd);
|
|---|
| 19 | # read_file_into_string ($log) eq "guile\n" and $FEATURES{guile} = 1;
|
|---|
| 20 |
|
|---|
| 21 | # If we don't have Guile support, never mind.
|
|---|
| 22 | exists $FEATURES{guile} or return -1;
|
|---|
| 23 |
|
|---|
| 24 | # Verify simple data type conversions
|
|---|
| 25 | # Currently we don't support vectors:
|
|---|
| 26 | # echo '$(guile (vector 1 2 3))'; \
|
|---|
| 27 | run_make_test(q!
|
|---|
| 28 | x:;@echo '$(guile #f)'; \
|
|---|
| 29 | echo '$(guile #t)'; \
|
|---|
| 30 | echo '$(guile #\c)'; \
|
|---|
| 31 | echo '$(guile 1234)'; \
|
|---|
| 32 | echo '$(guile 'foo)'; \
|
|---|
| 33 | echo '$(guile "bar")'; \
|
|---|
| 34 | echo '$(guile (cons 'a 'b))'; \
|
|---|
| 35 | echo '$(guile '(a b (c . d) 1 (2) 3))'
|
|---|
| 36 | !,
|
|---|
| 37 | '', "\n#t\nc\n1234\nfoo\nbar\na b\na b c d 1 2 3");
|
|---|
| 38 |
|
|---|
| 39 | # Verify the gmk-expand function
|
|---|
| 40 | run_make_test(q!
|
|---|
| 41 | VAR = $(guile (gmk-expand "$(shell echo hi)"))
|
|---|
| 42 | x:;@echo '$(VAR)'
|
|---|
| 43 | !,
|
|---|
| 44 | '', "hi");
|
|---|
| 45 |
|
|---|
| 46 | # Verify the gmk-eval function
|
|---|
| 47 | # Prove that the string is expanded only once (by eval)
|
|---|
| 48 | run_make_test(q!
|
|---|
| 49 | TEST = bye
|
|---|
| 50 | EVAL = VAR = $(TEST) $(shell echo there)
|
|---|
| 51 | $(guile (gmk-eval "$(value EVAL)"))
|
|---|
| 52 | TEST = hi
|
|---|
| 53 | x:;@echo '$(VAR)'
|
|---|
| 54 | !,
|
|---|
| 55 | '', "hi there");
|
|---|
| 56 |
|
|---|
| 57 | # Verify the gmk-eval function with a list
|
|---|
| 58 | run_make_test(q!
|
|---|
| 59 | $(guile (gmk-eval '(VAR = 1 (2) () 3)))
|
|---|
| 60 | x:;@echo '$(VAR)'
|
|---|
| 61 | !,
|
|---|
| 62 | '', "1 2 3");
|
|---|
| 63 |
|
|---|
| 64 | # Verify the gmk-var function
|
|---|
| 65 | run_make_test(q!
|
|---|
| 66 | VALUE = hi $(shell echo there)
|
|---|
| 67 | VAR = $(guile (gmk-var "VALUE"))
|
|---|
| 68 | x:;@echo '$(VAR)'
|
|---|
| 69 | !,
|
|---|
| 70 | '', "hi there");
|
|---|
| 71 |
|
|---|
| 72 | # Verify the gmk-var function with a symbol
|
|---|
| 73 | run_make_test(q!
|
|---|
| 74 | VALUE = hi $(shell echo there)
|
|---|
| 75 | VAR = $(guile (gmk-var 'VALUE))
|
|---|
| 76 | x:;@echo '$(VAR)'
|
|---|
| 77 | !,
|
|---|
| 78 | '', "hi there");
|
|---|
| 79 |
|
|---|
| 80 | # Write a Guile program using define and run it
|
|---|
| 81 | run_make_test(q!
|
|---|
| 82 | # Define the "fib" function in Guile
|
|---|
| 83 | define fib
|
|---|
| 84 | ;; A procedure for counting the n:th Fibonacci number
|
|---|
| 85 | ;; See SICP, p. 37
|
|---|
| 86 | (define (fib n)
|
|---|
| 87 | (cond ((= n 0) 0)
|
|---|
| 88 | ((= n 1) 1)
|
|---|
| 89 | (else (+ (fib (- n 1))
|
|---|
| 90 | (fib (- n 2))))))
|
|---|
| 91 | endef
|
|---|
| 92 | $(guile $(fib))
|
|---|
| 93 |
|
|---|
| 94 | # Now run it
|
|---|
| 95 | x:;@echo $(guile (fib $(FIB)))
|
|---|
| 96 | !,
|
|---|
| 97 | 'FIB=10', "55");
|
|---|
| 98 |
|
|---|
| 99 | 1;
|
|---|