tests/scripts/functions/guile

   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 run_make_test(q!
  48 $(guile (gmk-eval "VAR = hi $(shell echo there)"))
  49 x:;@echo '$(VAR)'
  50 !,
  51               '', "hi there");
  52
  53 # Verify the gmk-eval function with a list
  54 run_make_test(q!
  55 $(guile (gmk-eval '(VAR = 1 (2) () 3)))
  56 x:;@echo '$(VAR)'
  57 !,
  58               '', "1 2 3");
  59
  60 # Verify the gmk-var function
  61 run_make_test(q!
  62 VALUE = hi $(shell echo there)
  63 VAR = $(guile (gmk-var "VALUE"))
  64 x:;@echo '$(VAR)'
  65 !,
  66               '', "hi there");
  67
  68 # Verify the gmk-var function with a symbol
  69 run_make_test(q!
  70 VALUE = hi $(shell echo there)
  71 VAR = $(guile (gmk-var 'VALUE))
  72 x:;@echo '$(VAR)'
  73 !,
  74               '', "hi there");
  75
  76 # Write a Guile program using define and run it
  77 run_make_test(q!
  78 # Define the "fib" function in Guile
  79 define fib
  80 ;; A procedure for counting the n:th Fibonacci number
  81 ;; See SICP, p. 37
  82 (define (fib n)
  83   (cond ((= n 0) 0)
  84         ((= n 1) 1)
  85         (else (+ (fib (- n 1))
  86                  (fib (- n 2))))))
  87 endef
  88 $(guile $(fib))
  89
  90 # Now run it
  91 x:;@echo $(guile (fib $(FIB)))
  92 !,
  93               'FIB=10', "55");
  94
  95 1;