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