97 lines
		
	
	
		
			2.3 KiB
		
	
	
	
		
			Factor
		
	
	
		
			Executable File
		
	
			
		
		
	
	
			97 lines
		
	
	
		
			2.3 KiB
		
	
	
	
		
			Factor
		
	
	
		
			Executable File
		
	
| IN: tools.deploy.tests
 | |
| USING: tools.test system io.files kernel tools.deploy.config
 | |
| tools.deploy.backend math sequences io.launcher arrays
 | |
| namespaces continuations layouts accessors ;
 | |
| 
 | |
| : shake-and-bake ( vocab -- )
 | |
|     [ "test.image" temp-file delete-file ] ignore-errors
 | |
|     "resource:" [
 | |
|         >r vm
 | |
|         "test.image" temp-file
 | |
|         r> dup deploy-config make-deploy-image
 | |
|     ] with-directory ;
 | |
| 
 | |
| : small-enough? ( n -- ? )
 | |
|     >r "test.image" temp-file file-info size>> r> cell 4 / * <= ;
 | |
| 
 | |
| [ ] [ "hello-world" shake-and-bake ] unit-test
 | |
| 
 | |
| [ t ] [ 500000 small-enough? ] unit-test
 | |
| 
 | |
| [ ] [ "sudoku" shake-and-bake ] unit-test
 | |
| 
 | |
| [ t ] [ 800000 small-enough? ] unit-test
 | |
| 
 | |
| [ ] [ "hello-ui" shake-and-bake ] unit-test
 | |
| 
 | |
| [ t ] [ 1300000 small-enough? ] unit-test
 | |
| 
 | |
| [ "staging.math-compiler-threads-ui-strip.image" ] [
 | |
|     "hello-ui" deploy-config
 | |
|     [ bootstrap-profile staging-image-name file-name ] bind
 | |
| ] unit-test
 | |
| 
 | |
| [ ] [ "maze" shake-and-bake ] unit-test
 | |
| 
 | |
| [ t ] [ 1200000 small-enough? ] unit-test
 | |
| 
 | |
| ! [ ] [ "tetris" shake-and-bake ] unit-test
 | |
| ! 
 | |
| ! [ t ] [ 1500000 small-enough? ] unit-test
 | |
| ! 
 | |
| [ ] [ "bunny" shake-and-bake ] unit-test
 | |
| 
 | |
| [ t ] [ 2500000 small-enough? ] unit-test
 | |
| 
 | |
| {
 | |
|     "tools.deploy.test.1"
 | |
|     "tools.deploy.test.2"
 | |
|     "tools.deploy.test.3"
 | |
|     "tools.deploy.test.4"
 | |
| } [
 | |
|     [ ] swap [
 | |
|         shake-and-bake
 | |
|         vm
 | |
|         "-i=" "test.image" temp-file append
 | |
|         2array try-process
 | |
|     ] curry unit-test
 | |
| ] each
 | |
| 
 | |
| USING: http.client http.server http.server.dispatchers
 | |
| http.server.responses http.server.static io.servers.connection ;
 | |
| 
 | |
| SINGLETON: quit-responder
 | |
| 
 | |
| M: quit-responder call-responder*
 | |
|     2drop stop-server "Goodbye" "text/html" <content> ;
 | |
| 
 | |
| : add-quot-responder ( responder -- responder )
 | |
|     quit-responder "quit" add-responder ;
 | |
| 
 | |
| : test-httpd ( -- )
 | |
|     #! Return as soon as server is running.
 | |
|     <http-server>
 | |
|         1237 >>insecure
 | |
|         f >>secure
 | |
|     start-server* ;
 | |
| 
 | |
| [ ] [
 | |
|     [
 | |
|         <dispatcher>
 | |
|             add-quot-responder
 | |
|             "resource:basis/http/test" <static> >>default
 | |
|         main-responder set
 | |
| 
 | |
|         test-httpd
 | |
|     ] with-scope
 | |
| ] unit-test
 | |
| 
 | |
| [ ] [
 | |
|     "tools.deploy.test.5" shake-and-bake
 | |
|     vm
 | |
|     "-i=" "test.image" temp-file append
 | |
|     2array try-process
 | |
| ] unit-test
 | |
| 
 | |
| [ ] [ "http://localhost:1237/quit" http-get 2drop ] unit-test
 |