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;
|
---|