From 1e002774e3724f21aebfea0d9e64f7dc8bd6c9a0 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 25 May 2023 12:59:36 -0400 Subject: Allow bare When/Claim in subprocess --- test/process.tcl | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) (limited to 'test') diff --git a/test/process.tcl b/test/process.tcl index 3a58a0b9..4e76b7de 100644 --- a/test/process.tcl +++ b/test/process.tcl @@ -17,7 +17,7 @@ Assert when we are running { } } Step -vwait good +vwait ::good Assert when we are running { puts "Core: $::nodename" @@ -27,14 +27,29 @@ Assert when we are running { incr n Commit { Claim the counter is $n } Step + if {$n > 10} { break } } } When the counter is /n/ { if {$n > 5} { - set ::done true + set ::ok true } } } Step -vwait done +vwait ::ok + +Assert when we are running { + On process { + Claim I am in a process + When I am in a process { + Commit { Claim we were in a process } + } + When we were in a process { + set ::wereinaprocess true + } + } +} +Step +vwait ::wereinaprocess -- cgit v1.2.3 From 82f797cbb37432755bbf6a07241e843e90282f1e Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 25 May 2023 14:49:07 -0400 Subject: Implement bidirectional peering & receive statements --- test/process.tcl | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'test') diff --git a/test/process.tcl b/test/process.tcl index 4e76b7de..ca6058f1 100644 --- a/test/process.tcl +++ b/test/process.tcl @@ -53,3 +53,21 @@ Assert when we are running { } Step vwait ::wereinaprocess + +Assert when we are running { + On process { + Wish $::nodename receives statements like [list /x/ claims the main process exists] + When the main process exists { + Commit { + Claim the subprocess heard that the main process exists + } + Step + } + } + Claim the main process exists + When the subprocess heard that the main process exists { + set ::heard true + } +} +Step +vwait ::heard -- cgit v1.2.3 From 38b17c5d6c96d3f4cc4da3a9623d3990e87bfe8e Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 26 May 2023 10:49:28 -0400 Subject: Add shm test --- test/shm.tcl | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 test/shm.tcl (limited to 'test') diff --git a/test/shm.tcl b/test/shm.tcl new file mode 100644 index 00000000..78e93902 --- /dev/null +++ b/test/shm.tcl @@ -0,0 +1,66 @@ +proc assert condition { + set s "{$condition}" + if {![uplevel 1 expr $s]} { + return -code error "assertion failed: $condition" + } +} + + +Assert we are running +Assert when we are running { + On process { + set cc [c create] + $cc include + $cc include + $cc include + $cc include + $cc include + $cc proc shmMount {char* name size_t size void* addr} void { + int fd = shm_open(name, O_RDWR | O_CREAT, S_IROTH | S_IWOTH | S_IRUSR | S_IWUSR); + ftruncate(fd, size); + void* ptr = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_FIXED, fd, 0); + if (ptr == NULL || ptr != addr) { + fprintf(stderr, "shmMount: failed"); exit(1); + } + } + $cc proc blup {} void { + void* ptr = (void*)0x280000000; + shmMount("/folk-images", 1000000000, ptr); + + char* s = (char*)ptr; + snprintf(s, 100, "Hello!"); + } + $cc compile + blup + } + + On process { + set cc [c create] + $cc include + $cc include + $cc include + $cc include + $cc include + $cc proc shmMount {char* name size_t size void* addr} void { + int fd = shm_open(name, O_RDWR | O_CREAT, S_IROTH | S_IWOTH | S_IRUSR | S_IWUSR); + ftruncate(fd, size); + void* ptr = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_FIXED, fd, 0); + if (ptr == NULL || ptr != addr) { + fprintf(stderr, "shmMount: failed"); exit(1); + } + } + $cc proc blup {} void { + void* ptr = (void*)0x280000000; + shmMount("/folk-images", 1000000000, ptr); + + char* s = (char*)ptr; + printf("[%s]\n", s); + } + $cc compile + blup + } +} +Step + +after 1000 {set done true} +vwait done -- cgit v1.2.3 From 2d28e53decf2d774b95a92e3357598503d849cc6 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 15 Jun 2023 17:45:46 -0400 Subject: Simplify test/process --- test/process.tcl | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) (limited to 'test') diff --git a/test/process.tcl b/test/process.tcl index 4056a71d..1895f2d7 100644 --- a/test/process.tcl +++ b/test/process.tcl @@ -8,8 +8,7 @@ Step Assert when we are running {{} { On process { - Assert claims things are good - Step + Claim things are good } When things are good { @@ -20,13 +19,11 @@ Step vwait ::good Assert when we are running {{} { - puts "Core: $::nodename" On process { set n 0 while true { incr n Commit { Claim the counter is $n } - Step if {$n > 10} { break } } } @@ -58,10 +55,7 @@ Assert when we are running {{} { On process { Wish $::nodename receives statements like [list /x/ claims the main process exists] When the main process exists { - Commit { - Claim the subprocess heard that the main process exists - } - Step + Commit { Claim the subprocess heard that the main process exists } } } Claim the main process exists -- cgit v1.2.3 From 54c0ff24020b7e213db477b334a482fe4a041582 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 16 Jun 2023 14:51:10 -0400 Subject: Add python3 test --- test/process.tcl | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) (limited to 'test') diff --git a/test/process.tcl b/test/process.tcl index 1895f2d7..94457d76 100644 --- a/test/process.tcl +++ b/test/process.tcl @@ -65,3 +65,20 @@ Assert when we are running {{} { }} Step vwait ::heard + +Retract when we are running /anything/ +Step + +Assert when we are running {{} { + On process { + eval [python3 { + print("Claim Python is done") + }] + } + When Python is done { + set ::pythondone true + } +}} +Step + +vwait ::pythondone -- cgit v1.2.3 From 02b7a883e3eb5e17426aed71f63c57425cb7f143 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Sun, 18 Jun 2023 16:28:30 -0400 Subject: Introduce fork-zygote process system. Also refactors/separates ::nodename to be ::thisNode (this computer) and ::thisProcess (this OS process). All tests should pass. Zygote-based processes are much faster to start up since they don't need to recompile C code or reload Folk. They still need to connect to Folk via WebSocket for now, and the automatic management we'd want (bidirectional, based on both match lifetime and process lifetime) isn't working yet. Some of the node vs. process distinction in naming still needs to be cleaned up, too, I think. --- test/basic.tcl | 2 +- test/perf.tcl | 12 ++++++------ test/process.tcl | 9 +++++---- test/shm.tcl | 4 ++-- 4 files changed, 14 insertions(+), 13 deletions(-) (limited to 'test') diff --git a/test/basic.tcl b/test/basic.tcl index af2bb16f..78ea97da 100644 --- a/test/basic.tcl +++ b/test/basic.tcl @@ -11,7 +11,7 @@ proc count condition { Assert programOakland has program {{this} { Claim Omar lives in "Oakland" }} -Assert when $::nodename has step count /c/ {{c} { +Assert when $::thisProcess has step count /c/ {{c} { When Omar lives in /place/ { Claim $place is a place where Omar lives } diff --git a/test/perf.tcl b/test/perf.tcl index 97ee79cc..186f997c 100644 --- a/test/perf.tcl +++ b/test/perf.tcl @@ -9,22 +9,22 @@ Assert when /name/ is a /animal/ {{name animal} { Assert when /node/ has step count /c/ {{node c} {}} Assert Bob is a cat -puts "$::nodename: No additional statements:" +puts "$::thisProcess: No additional statements:" puts " [run]" for {set i 0} {$i < 100} {incr i} { Assert $i } -puts "$::nodename: Asserted 100 statements:" +puts "$::thisProcess: Asserted 100 statements:" puts " [run]" Assert Omar is a human -puts "$::nodename: Asserted 100 statements + Omar is a human:" +puts "$::thisProcess: Asserted 100 statements + Omar is a human:" puts " [run]" -puts "$::nodename: Same:" +puts "$::thisProcess: Same:" puts " [run]" -puts "$::nodename: Same:" +puts "$::thisProcess: Same:" puts " [run]" -puts "$::nodename: Same:" +puts "$::thisProcess: Same:" puts " [run]" diff --git a/test/process.tcl b/test/process.tcl index 94457d76..c8d25ba3 100644 --- a/test/process.tcl +++ b/test/process.tcl @@ -53,7 +53,7 @@ vwait ::wereinaprocess Assert when we are running {{} { On process { - Wish $::nodename receives statements like [list /x/ claims the main process exists] + Wish $::thisProcess receives statements like [list /x/ claims the main process exists] When the main process exists { Commit { Claim the subprocess heard that the main process exists } } @@ -70,10 +70,11 @@ Retract when we are running /anything/ Step Assert when we are running {{} { + set x done On process { - eval [python3 { - print("Claim Python is done") - }] + eval [python3 [subst { + print("Claim Python is $x") + }]] } When Python is done { set ::pythondone true diff --git a/test/shm.tcl b/test/shm.tcl index 78e93902..f57e8e83 100644 --- a/test/shm.tcl +++ b/test/shm.tcl @@ -7,7 +7,7 @@ proc assert condition { Assert we are running -Assert when we are running { +Assert when we are running {{} { On process { set cc [c create] $cc include @@ -59,7 +59,7 @@ Assert when we are running { $cc compile blup } -} +}} Step after 1000 {set done true} -- cgit v1.2.3 From db5e849f52f7256d4ab11fef955851f8d7914fdb Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Sun, 18 Jun 2023 18:14:17 -0400 Subject: Add runtime arg typechecks to the C FFI --- test/cstructs.tcl | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'test') diff --git a/test/cstructs.tcl b/test/cstructs.tcl index 17f0fb41..c4849fab 100644 --- a/test/cstructs.tcl +++ b/test/cstructs.tcl @@ -25,3 +25,19 @@ $cc compile puts [omar] assert {[dict get [omar] name last] eq "Rizwan"} + +set cc [c create] +$cc proc plusone {int a} int { + return a + 1; +} +$cc proc dostuff {void* v} int { + return 300; +} +$cc compile +assert {[plusone 3] eq 4} + +catch {plusone Wrong} err +assert {[string match {expected integer but got "Wrong"*} $err]} + +catch {dostuff hi} err +assert {[string match {failed to convert argument from Tcl to C*} $err]} -- cgit v1.2.3 From d34dd912016343bc020572c700790a8c5c6f0dfa Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 19 Jun 2023 00:06:34 -0400 Subject: Fix process sync test --- test/process.tcl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'test') diff --git a/test/process.tcl b/test/process.tcl index c8d25ba3..c69fe26c 100644 --- a/test/process.tcl +++ b/test/process.tcl @@ -43,9 +43,9 @@ Assert when we are running {{} { When I am in a process { Commit { Claim we were in a process } } - When we were in a process { - set ::wereinaprocess true - } + } + When we were in a process { + set ::wereinaprocess true } }} Step -- cgit v1.2.3 From a5b40ecd2ba5e4e04ed35a410d05953d877e0d13 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 19 Jun 2023 13:40:27 -0400 Subject: Add assert to lib/language.tcl --- test/basic.tcl | 6 ------ test/commit.tcl | 7 ------- test/cstructs.tcl | 7 ------- test/joins.tcl | 7 ------- test/negation.tcl | 6 ------ test/shm.tcl | 8 -------- test/trie.tcl | 7 ------- test/with-all.tcl | 11 ----------- 8 files changed, 59 deletions(-) (limited to 'test') diff --git a/test/basic.tcl b/test/basic.tcl index 78ea97da..c39916dd 100644 --- a/test/basic.tcl +++ b/test/basic.tcl @@ -1,9 +1,3 @@ -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - return -code error "assertion failed: $condition" - } -} proc count condition { Statements::count $condition } diff --git a/test/commit.tcl b/test/commit.tcl index 2a8bdaed..1cf780b8 100644 --- a/test/commit.tcl +++ b/test/commit.tcl @@ -1,10 +1,3 @@ -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - return -code error "assertion failed: $condition" - } -} - Assert programBall has program {{this} { Commit { Claim $this has a ball at x 100 y 100 } diff --git a/test/cstructs.tcl b/test/cstructs.tcl index c4849fab..623cd53f 100644 --- a/test/cstructs.tcl +++ b/test/cstructs.tcl @@ -1,10 +1,3 @@ -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - return -code error "assertion failed: $condition" - } -} - set cc [c create] $cc struct Name { char* first; diff --git a/test/joins.tcl b/test/joins.tcl index 799abe0c..57d80300 100644 --- a/test/joins.tcl +++ b/test/joins.tcl @@ -1,10 +1,3 @@ -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - return -code error "assertion failed: $condition" - } -} - Assert Omar is a person Assert Omar lives in "New York" Assert Elmo is a person diff --git a/test/negation.tcl b/test/negation.tcl index 0067783a..501d7295 100644 --- a/test/negation.tcl +++ b/test/negation.tcl @@ -1,9 +1,3 @@ -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - return -code error "assertion failed: $condition" - } -} Assert programNegation has program code { When /nobody/ is booping { set ::booping nope diff --git a/test/shm.tcl b/test/shm.tcl index f57e8e83..c3d63fc7 100644 --- a/test/shm.tcl +++ b/test/shm.tcl @@ -1,11 +1,3 @@ -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - return -code error "assertion failed: $condition" - } -} - - Assert we are running Assert when we are running {{} { On process { diff --git a/test/trie.tcl b/test/trie.tcl index 9e353d58..92ad9efa 100644 --- a/test/trie.tcl +++ b/test/trie.tcl @@ -2,13 +2,6 @@ set t [trie create] trie add t {Omar is a person} 1 trie add t {Generic is a /y/} 2 -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - return -code error "assertion failed: $condition" - } -} - assert {[trie lookup $t {Omar is a person}] eq {1}} assert {[trie lookup $t {/p/ is a person}] eq {1 2}} assert {[trie lookup $t {Omar is a /x/}] eq {1}} diff --git a/test/with-all.tcl b/test/with-all.tcl index d628a9db..27e594bd 100644 --- a/test/with-all.tcl +++ b/test/with-all.tcl @@ -1,14 +1,3 @@ -proc assert condition { - set s "{$condition}" - if {![uplevel 1 expr $s]} { - set errmsg "assertion failed: $condition" - if {[lindex $condition 1] eq "eq" && [string index [lindex $condition 0] 0] eq "$"} { - set errmsg "$errmsg\n[uplevel 1 [list set [string range [lindex $condition 0] 1 end]]] is not equal to [lindex $condition 2]" - } - return -code error $errmsg - } -} - Assert programOakland has program code { Claim Omar lives in "Oakland" } -- cgit v1.2.3