Artifact 1a6959f1b09594d7342752cdde97ac2cc1a73102:
- File tests/client-tests.fs — part of check-in [ad3b70a512] at 2016-05-01 21:41:59 on branch trunk — Move tests (need to make them run again) (user: bernd size: 6510)
\ Test lib clients require ../net2o.fs UValue test# 0 to test# 1 Value total-tests : .test# ( -- ) test# 0>= IF test# 0 .r THEN ; : >timing ( -- ) [: ." timing" .test# ;] $tmp w/o create-file throw >r ['] .rec-timing r@ outfile-execute r> close-file throw ; : >cache ( addr u -- addr' u' ) [: ." .cache" .test# ." /" type ;] $tmp ; : init-cache' ( -- ) "" >cache 1- file-status nip no-file# = IF "" >cache 1- $1FF =mkdir throw THEN ; : c:add-me ( -- ) +addme net2o-code expect-reply get-ip cookie+request end-code| -setip ; : c:add-tag ( -- ) +addme net2o-code expect-reply log s" DHT test" $, type cr endwith get-ip pkc keysize 2* $, dht-id forever "test:tag" pkc keysize 2* gen-tag-del $, dht-tags- forever "test:tag" pkc keysize 2* gen-tag $, dht-tags+ endwith end-code| -setip ; : c:fetch-tag ( nick u -- ) net2o-code expect-reply nick-key .ke-pk $@ $, dht-id dht-host? dht-tags? endwith cookie+request end-code| ; : c:fetch-host ( nick u -- ) net2o-code expect-reply fetch-host, cookie+request end-code| ; \ : c:fetch-tags ( -- ) \ net2o-code \ expect-reply \ 0 ulit, dht-open pkc keysize 2* $, $FE ulit, 0 ulit, dht-query \ n2o:done \ end-code| ; Variable connect-nick "test" connect-nick $! : c:dht ( n -- ) $8 $8 connect-nick $@ nick>pk ins-ip pk:connect 0 ?DO c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags LOOP disconnect-me ; : std-block ( -- ) $10 blocksize! $A blockalign! ; : c:download1 ( -- ) [: .time ." Download test: 1 text file and 2 photos" cr ;] $err net2o-code expect-reply log !time .time s" Download test " $, type 1 ulit, . pi float, f. cr endwith get-ip std-block stat( request-stats ) "net2o.fs" "net2o.fs" >cache n2o:copy "data/2011-05-13_11-26-57-small.jpg" "photo000s.jpg" >cache n2o:copy "data/2011-05-20_17-01-12-small.jpg" "photo001s.jpg" >cache n2o:copy n2o:done push' log 0 ulit, words push' cr push' endwith end-code| n2o:close-all ['] .time $err ; : c:download2 ( -- ) [: ." Download test 2: 7 medium photos" cr ;] $err net2o-code expect-reply close-all \ rewind-total log .time s" Download test 2" $, type cr endwith std-block stat( request-stats ) "data/2011-06-02_15-02-38-small.jpg" "photo002s.jpg" >cache n2o:copy "data/2011-06-03_10-26-49-small.jpg" "photo003s.jpg" >cache n2o:copy "data/2011-06-15_12-27-03-small.jpg" "photo004s.jpg" >cache n2o:copy "data/2011-06-24_11-26-36-small.jpg" "photo005s.jpg" >cache n2o:copy "data/2011-06-27_19-33-04-small.jpg" "photo006s.jpg" >cache n2o:copy "data/2011-06-27_19-55-48-small.jpg" "photo007s.jpg" >cache n2o:copy "data/2011-06-28_06-54-09-small.jpg" "photo008s.jpg" >cache n2o:copy n2o:done push' log log $20 ulit, words push' cr endwith end-code| n2o:close-all ['] .time $err ; : c:download3 ( -- ) [: ." Download test 3: 2 big photos" cr ;] $err net2o-code expect-reply close-all \ rewind-total log .time s" Download test 3" $, type cr endwith std-block stat( request-stats ) "data/2011-05-13_11-26-57.jpg" "photo000.jpg" >cache n2o:copy "data/2011-05-20_17-01-12.jpg" "photo001.jpg" >cache n2o:copy n2o:done 0 ulit, file-id push' endwith push' log $20 ulit, words push' cr endwith end-code| n2o:close-all ['] .time $err ; : c:download4 ( -- ) [: ." Download test 4: 7 big photos, partial files" cr ;] $err net2o-code expect-reply close-all \ rewind-total log .time s" Download test 4" $, type cr endwith std-block stat( request-stats ) "data/2011-06-02_15-02-38.jpg" "photo002.jpg" >cache n2o:copy "data/2011-06-03_10-26-49.jpg" "photo003.jpg" >cache n2o:copy "data/2011-06-15_12-27-03.jpg" "photo004.jpg" >cache n2o:copy "data/2011-06-24_11-26-36.jpg" "photo005.jpg" >cache n2o:copy "data/2011-06-27_19-33-04.jpg" "photo006.jpg" >cache n2o:copy "data/2011-06-27_19-55-48.jpg" "photo007.jpg" >cache n2o:copy "data/2011-06-28_06-54-09.jpg" "photo008.jpg" >cache n2o:copy $10000. 0 limit! $20000. 1 limit! $30000. 2 limit! $40000. 3 limit! $50000. 4 limit! $60000. 5 limit! $70000. 6 limit! n2o:done "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" $, dht-id push' endwith push' log $20 ulit, words push' cr endwith end-code| ['] .time $err ; : c:download4a ( -- ) [: ." Download test 4a: 7 big photos, rest" cr ;] $err net2o-code expect-reply log .time s" Download test 4a" $, type cr endwith 7 0 DO -1. I limit! LOOP n2o:done end-code| ['] .time $err n2o:close-all ; : c:test-rest ( -- ) c:download1 7e @time f> IF c:download2 waitkey( 8e )else( 15e ) @time f> IF c:download3 waitkey( 16e )else( 20e ) @time f> IF waitkey( ." Press key to continue" key drop cr ) c:download4 c:download4a THEN THEN THEN >timing c:disconnect ; : c:test ( -- ) init-cache' $a $e connect-nick $@ nick>pk ins-ip pk:connect c:test-rest ; Variable reqdone# event: ->reqdone -1 reqdone# +! ; : c:test& ( n -- ) \ in background up@ 2 stacksize4 NewTask4 pass >r alloc-io ['] c:test catch ?dup-IF elit, ->throw drop ELSE drop ->reqdone THEN r> event> ; #100 Value req-ms# : c:tests ( n -- ) dup 0< IF abs to test# 1 THEN dup to total-tests dup reqdone# ! 0 ?DO I c:test& req-ms# ms test# 1+ to test# LOOP BEGIN stop reqdone# @ 0= UNTIL ; \ lookup for other users : nat:connect ( addr u -- ) $A $E nick-connect ." Connected!" cr ; \ some more helpers : sha-3 ( addr u -- ) c:0key slurp-file 2dup c:hash drop free throw pad c:key> ; : sha-3-256 ( addr u -- ) sha-3 pad $20 85type ; : sha-3-512 ( addr u -- ) sha-3 pad $40 85type ; : sha-3-256s ( -- ) [: 2dup sha-3-256 space type cr ;] arg-loop ; : sha-3-512s ( -- ) [: 2dup sha-3-512 space type cr ;] arg-loop ; \ terminal connection : c:terminal ( -- ) $a $e connect-nick $@ nick>pk ins-ip pk:connect [: .time ." Terminal test: connect to server" cr ;] $err tc-permit# fs-class-permit or to fs-class-permit net2o-code expect-reply log .time "Terminal test" $, type cr endwith std-block stat( request-stats ) [: 3 ulit, file-type "" $, 0 ulit, open-file state-addr >o 2 fs-class! o> ;] n2o>file end-code| ['] .time $err ;