Delete tests.scm
This commit is contained in:
Mike Gran
parent
d3b048cd17
commit
7bf29e34eb
GPG Key ID:
4AEE18F83AFDEB23
349
tests.scm
349
tests.scm
@ -1,349 +0,0 @@
|
||||
#!/usr/bin/env sh
|
||||
exec guile -L . -s "$0" "$@"
|
||||
!#
|
||||
|
||||
(use-modules (potato make)
|
||||
(srfi srfi-1)
|
||||
(srfi srfi-64))
|
||||
|
||||
|
||||
;; These stubs override the driver that calls
|
||||
;; 'system' so we can instead just investigate
|
||||
;; what string it was passed.
|
||||
(define %cmd #f)
|
||||
(define (stub-system-pass cmd)
|
||||
(set! %cmd cmd)
|
||||
0)
|
||||
(define (stub-system-fail cmd)
|
||||
(set! %cmd cmd)
|
||||
1)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; MAKEVARS
|
||||
|
||||
(test-begin "makevars")
|
||||
|
||||
(test-equal "can set makevar with environment"
|
||||
"BAR1"
|
||||
(begin
|
||||
(setenv "FOO1" "BAR1")
|
||||
(initialize '("test" "--environment"))
|
||||
(let ((result ($ FOO1)))
|
||||
(unsetenv "FOO1")
|
||||
result)))
|
||||
|
||||
(test-equal "can set makevar with MAKEFLAGS"
|
||||
"BAR2"
|
||||
(begin
|
||||
(setenv "MAKEFLAGS" "FOO2=BAR2")
|
||||
(initialize '("test" "--environment"))
|
||||
(let ((result ($ FOO2)))
|
||||
(unsetenv "MAKEFLAGS")
|
||||
result)))
|
||||
|
||||
(test-equal "can set makevar with initialize"
|
||||
"BAR3"
|
||||
(begin
|
||||
(initialize '("test" "FOO3=BAR3"))
|
||||
($ FOO3)))
|
||||
|
||||
(test-equal "can set makevar in script"
|
||||
"BAR4"
|
||||
(begin
|
||||
(:= FOO4 "BAR4")
|
||||
($ FOO4)))
|
||||
|
||||
(test-equal "can set makevar lazily in script"
|
||||
"BAR5"
|
||||
(begin
|
||||
(?= FOO5 "BAR5")
|
||||
($ FOO5)))
|
||||
|
||||
(test-assert "a lazy makevar of a procedure is a promise before it is referenced"
|
||||
(begin
|
||||
(?= FOO6 (lambda () "BAR6"))
|
||||
(let ((val (hash-ref (@@ (potato makevars) %makevars) "FOO6")))
|
||||
(promise? (car val)))))
|
||||
|
||||
(test-equal "a lazy makevar of a procedure is a string after it is referenced"
|
||||
"BAR7"
|
||||
(begin
|
||||
(?= FOO7 (lambda () "BAR7"))
|
||||
($ FOO7)
|
||||
(let ((val (hash-ref (@@ (potato makevars) %makevars) "FOO7")))
|
||||
(car val))))
|
||||
|
||||
(test-equal "referencing an unset makevar returns an empty string"
|
||||
""
|
||||
($ FOO8))
|
||||
|
||||
(test-error "referencing an unset makevar throws an error in strict mode"
|
||||
#t
|
||||
(begin
|
||||
(initialize '("test" "--strict"))
|
||||
($ FOO9)))
|
||||
|
||||
(test-equal "assign converts integers to strings"
|
||||
"100"
|
||||
(begin
|
||||
(:= FOO10 100)
|
||||
($ FOO10)))
|
||||
|
||||
(test-equal "assign converts characters to strings"
|
||||
"x"
|
||||
(begin
|
||||
(:= FOO11 #\x)
|
||||
($ FOO11)))
|
||||
|
||||
(test-equal "quote-reference adds quotation marks"
|
||||
"\"BAR 12\""
|
||||
(begin
|
||||
(:= FOO12 "BAR 12")
|
||||
(Q FOO12)))
|
||||
|
||||
(test-equal "quote-reference of an unassigned makevar returns empty quotation marks in non-strict mode"
|
||||
"\"\""
|
||||
(begin
|
||||
(initialize '("test"))
|
||||
(Q FOO13)))
|
||||
|
||||
(test-error "quote-reference of an unassigned makevar throws an error in strict mode"
|
||||
#t
|
||||
(begin
|
||||
(initialize '("test" "--strict"))
|
||||
(Q FOO13)))
|
||||
|
||||
(test-equal "script assignment overrides command-line assignment"
|
||||
"BAZ14"
|
||||
(begin
|
||||
(initialize '("test" "FOO14=BAR14"))
|
||||
(:= FOO14 "BAZ14")
|
||||
($ FOO14)))
|
||||
|
||||
(test-equal "script assignment overrides MAKEFLAGS assignment"
|
||||
"BAZ15"
|
||||
(begin
|
||||
(setenv "MAKEFLAGS" "FOO15=BAR15")
|
||||
(initialize '("test" "--environment"))
|
||||
(:= FOO15 "BAZ15")
|
||||
($ FOO15)))
|
||||
|
||||
(test-equal "script assignment overrides environment assignment"
|
||||
"BAZ16"
|
||||
(begin
|
||||
(setenv "FOO16" "BAR16")
|
||||
(initialize '("test" "--environment"))
|
||||
(unsetenv "FOO16")
|
||||
(:= FOO16 "BAZ16")
|
||||
($ FOO16)))
|
||||
|
||||
(test-equal "command-line assignment overrides script assignment in elevate mode"
|
||||
"BAR14"
|
||||
(begin
|
||||
(initialize '("test" "FOO14=BAR14" "--elevate-environment"))
|
||||
(:= FOO14 "BAZ14")
|
||||
($ FOO14)))
|
||||
|
||||
(test-equal "MAKEFLAGS assignment overrides script assignment in elevate mode"
|
||||
"BAR15"
|
||||
(begin
|
||||
(setenv "MAKEFLAGS" "FOO15=BAR15")
|
||||
(initialize '("test" "--elevate-environment"))
|
||||
(unsetenv "MAKEFLAGS")
|
||||
(:= FOO15 "BAZ15")
|
||||
($ FOO15)))
|
||||
|
||||
(test-equal "environment assignment overrides script assignment in elevate mode"
|
||||
"BAR16"
|
||||
(begin
|
||||
(setenv "FOO16" "BAR16")
|
||||
(initialize '("test" "--elevate-environment"))
|
||||
(:= FOO16 "BAZ16")
|
||||
($ FOO16)))
|
||||
|
||||
|
||||
(test-end "makevars")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; RECIPE HELPERS
|
||||
|
||||
(test-begin "recipe_helpers")
|
||||
|
||||
(test-assert "string-compose returns 'default and procedure"
|
||||
(let ((ret (~ "hello")))
|
||||
(and
|
||||
(eq? (car ret) 'default)
|
||||
(procedure? (cdr ret)))))
|
||||
|
||||
(test-assert "silent-compose returns 'silent and procedure"
|
||||
(let ((ret (~@ "hello")))
|
||||
(and
|
||||
(eq? (car ret) 'silent)
|
||||
(procedure? (cdr ret)))))
|
||||
|
||||
(test-assert "always-execute-compose returns 'always-execute and procedure"
|
||||
(let ((ret (~+ "hello")))
|
||||
(and
|
||||
(eq? (car ret) 'always-execute)
|
||||
(procedure? (cdr ret)))))
|
||||
|
||||
(test-assert "ignore-error-compose returns 'ignore-error and procedure"
|
||||
(let ((ret (~- "hello")))
|
||||
(and
|
||||
(eq? (car ret) 'ignore-error)
|
||||
(procedure? (cdr ret)))))
|
||||
|
||||
(test-equal "string-compose string passthrough"
|
||||
"hello"
|
||||
(let ((ret (~ "hello")))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose two strings passthrough"
|
||||
"hello world"
|
||||
(let ((ret (~ "hello" "world")))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose empty initial string"
|
||||
"world"
|
||||
(let ((ret (~ "" "world")))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose empty terminal string"
|
||||
"hello"
|
||||
(let ((ret (~ "hello" "")))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose empty medial string"
|
||||
"hello world"
|
||||
(let ((ret (~ "hello" "" "world")))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose handles procedure"
|
||||
"hello world"
|
||||
(let ((ret (~ "hello" (lambda () "world"))))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose handles integer"
|
||||
"hello 123"
|
||||
(let ((ret (~ "hello" 123)))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose handles character"
|
||||
"hello w"
|
||||
(let ((ret (~ "hello" #\w)))
|
||||
((cdr ret))))
|
||||
|
||||
(test-equal "string-compose handles makevar"
|
||||
"hello BAR"
|
||||
(begin
|
||||
(:= FOO "BAR")
|
||||
(let ((ret (~ "hello" ($ FOO))))
|
||||
((cdr ret)))))
|
||||
|
||||
(test-equal "empty string-compose"
|
||||
""
|
||||
(let ((ret (~)))
|
||||
((cdr ret))))
|
||||
|
||||
(test-end "recipe_helpers")
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TARGET RULES
|
||||
|
||||
(test-begin "target_rules")
|
||||
|
||||
(test-assert "install alternate system driver"
|
||||
(false-if-exception (install-alternate-system-driver stub-system-pass)))
|
||||
|
||||
(test-equal "target rule is a string"
|
||||
"cc -o foo.exe foo.c"
|
||||
(begin
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
"cc -o foo.exe foo.c")
|
||||
(execute)
|
||||
%cmd))
|
||||
|
||||
(test-assert "target rule is a procedure"
|
||||
(begin
|
||||
(let ((tmpvar #f))
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
(lambda ()
|
||||
(set! tmpvar #t)))
|
||||
(execute)
|
||||
tmpvar)))
|
||||
|
||||
(test-equal "target rule is a procedure returning a string"
|
||||
"cc -o foo.exe foo.c"
|
||||
(begin
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
(lambda ()
|
||||
("cc -o foo.exe foo.c")))
|
||||
(execute)
|
||||
%cmd))
|
||||
|
||||
(test-equal "target rule using string-compose on a string"
|
||||
"cc -o foo.exe foo.c"
|
||||
(begin
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
(~ "cc -o foo.exe foo.c"))
|
||||
(execute)
|
||||
%cmd))
|
||||
|
||||
(test-equal "target rule using string-compose on special variables"
|
||||
"cc -o foo.exe foo.c"
|
||||
(begin
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
(~ "cc -o" $@ $<))
|
||||
(execute)
|
||||
%cmd))
|
||||
|
||||
(test-equal "target rule check success"
|
||||
#t
|
||||
(begin
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
(~ "cc -o" $@ $<))
|
||||
(execute)))
|
||||
|
||||
(test-assert "install failing alternate system driver"
|
||||
(false-if-exception (install-alternate-system-driver stub-system-fail)))
|
||||
|
||||
(test-equal "target rule check failure of system call"
|
||||
#f
|
||||
(begin
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
(~ "cc -o" $@ $<))
|
||||
(execute)))
|
||||
|
||||
(test-equal "target rule check failure of scheme procedure"
|
||||
#f
|
||||
(begin
|
||||
(initialize '("test" "foo.exe"))
|
||||
(: "foo.exe" '("foo.c")
|
||||
(lambda ()
|
||||
#f))
|
||||
(execute)))
|
||||
|
||||
(test-end "target_rules")
|
||||
|
||||
(test-begin "suffix_rules")
|
||||
|
||||
(test-assert "install alternate system driver"
|
||||
(false-if-exception (install-alternate-system-driver stub-system-pass)))
|
||||
|
||||
(test-equal "suffix rule simple"
|
||||
"cc -c foo.c"
|
||||
(begin
|
||||
(initialize '("test" "foo.o"))
|
||||
(-> ".c" ".o"
|
||||
(~ "cc -c" $<))
|
||||
(execute)
|
||||
%cmd))
|
||||
|
||||
(test-end "suffix_rules")
|
||||
Loading…
Reference in New Issue
Block a user