From e397e8d8bab395fc9198e5b1d4b4469315b97a29 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 19 Feb 2024 11:46:48 +0100 Subject: [PATCH 001/121] tc file created --- troupecheck/tc.trp | 1 + 1 file changed, 1 insertion(+) create mode 100644 troupecheck/tc.trp diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp new file mode 100644 index 0000000..f70d7bb --- /dev/null +++ b/troupecheck/tc.trp @@ -0,0 +1 @@ +42 \ No newline at end of file From 87a4b57ae7b654a34cdd0b6d90eab09b5d7029f5 Mon Sep 17 00:00:00 2001 From: Selma Birkedal Date: Mon, 19 Feb 2024 11:53:11 +0100 Subject: [PATCH 002/121] tc --- troupecheck/tc.trp | 130 ++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 129 insertions(+), 1 deletion(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index f70d7bb..acb0395 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1 +1,129 @@ -42 \ No newline at end of file +import lists + +datatype Atoms = Success | Failure + +(* Generates a random Number in the interval ]0;1000000000[ (Note: generates a decimal!) *) +let fun generate_number() = + let val rnd = random()*10 + val mult = if rnd < 1 then 10 else + if rnd < 2 then 100 else + if rnd < 3 then 1000 else + if rnd < 4 then 10000 else + if rnd < 5 then 100000 else + if rnd < 6 then 1000000 else + if rnd < 7 then 10000000 else + if rnd < 8 then 100000000 else + if rnd < 9 then 1000000000 else + 1 in + random()*mult end + +(* Generates a random boolean *) + fun generate_bool() = + let val rnd = random()*10 + val res = if rnd < 5 then false + else true in + res end + +(* Helper function to create a list of some determined size. + f - the function determining what to element to put into the list. + i - the number of elements to be added to the list. *) + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + +(* Generates a random list of random Numbers with size interval [0;9] *) + fun generate_list() = + let val rnd = random()*10 + val noOfItems = if rnd < 1 then 0 else + if rnd < 2 then 1 else + if rnd < 3 then 2 else + if rnd < 4 then 3 else + if rnd < 5 then 4 else + if rnd < 6 then 5 else + if rnd < 7 then 6 else + if rnd < 8 then 7 else + if rnd < 9 then 8 else + 9 in + make_list (generate_number, noOfItems) end + +(* Runs a property with some arguments. + prop - the property function to test. + args - a list of arguments - must match number of arguments needed for the property function. *) + fun run_test (prop, args) = + let val res = + case args of + [] => prop + | (x::xs) => + let val newProp = prop x in run_test(newProp, xs) end + in res end + +(* Runs a single test and determines wether result is a Success or a Failure + prop - the property function to test. + args - a list of arguments - must match number of arguments needed for the property function. *) + fun check_success prop args = + if run_test (prop, args) then (Success, []) else (Failure, args) + +(* Runs however many tests specified on a single (Number)property, while always generating new inputs. + Drops further execution if a Failure is found. + prop - the property function to test. + noOfArgs - number of arguments the property function takes. + noOfTests - number of tests to be run. + generator - the function that should be used to generate input values. *) + fun run_all_tests (prop, noOfArgs, noOfTests, generator) = + let val argsList = make_list (generator, noOfArgs) + val (succRes, args) = check_success prop argsList + val res = + case succRes of + Failure => (Failure, args) + | Success => + case noOfTests of + 0 => (Success, []) + |_ => run_all_tests (prop, noOfArgs, noOfTests-1, generator) + in res end + +(* Tests a property function - by default 100 times. + noOfArgs - number of arguemnts the property takes + generator - the generator function to generate inputs + prop - the property function to test. + (Optional) noOfTests - how many tests should be run*) + fun tc noOfArgs generator prop = + let val (succRes, args) = run_all_tests (prop, noOfArgs, 100, generator) in + case succRes of + Failure => let val _ = print "Failure at input: " + in print args end + | Success => print "OK: Passed after 100 tests!" + end + fun tc noOfArgs generator prop noOfTests = + let val (succRes, args) = run_all_tests (prop, noOfArgs, noOfTests, generator) in + case succRes of + Failure => let val _ = print "Failure at input: " + in print args end + | Success => let val _ = print "OK: Passed after" + val _ = print noOfTests in + print "tests!" end + end + +(* A succesful boolean property created for testing purposes + x,y - should be booleans *) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + +(* A succesful property for numbers created for testing purposes + x,y - should be numbers. *) + fun number_commutative x y = + x * y = y * x + +(* A succesful property for lists created for testing purposes + xs - should be a list. *) + fun list_reverse xs = + reverse(reverse xs) = xs + + val _ = print "Testing on lists:" + val listTestRes = tc 1 generate_list list_reverse 3 + val _ = print "Testing on bools:" + val boolTestRes = tc 2 generate_bool bool_commutative 3 + val _ = print "Testing on numbers:" + val numberTestRes = tc 2 generate_number number_commutative 2 +in print "done" end + From da9e6b20e586e61affdb3df632c266cda99474df Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 19 Feb 2024 12:42:36 +0100 Subject: [PATCH 003/121] added new core funs --- troupecheck/tc-Lukas.trp | 115 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) create mode 100644 troupecheck/tc-Lukas.trp diff --git a/troupecheck/tc-Lukas.trp b/troupecheck/tc-Lukas.trp new file mode 100644 index 0000000..b8b20f5 --- /dev/null +++ b/troupecheck/tc-Lukas.trp @@ -0,0 +1,115 @@ +import lists + +datatype Atoms = Success | Failure + +(* Generates a random Number in the interval ]0;1000000000[ (Note: generates a decimal!) *) +let fun generate_number() = + let val rnd = random()*10 + val mult = if rnd < 1 then 10 else + if rnd < 2 then 100 else + if rnd < 3 then 1000 else + if rnd < 4 then 10000 else + if rnd < 5 then 100000 else + if rnd < 6 then 1000000 else + if rnd < 7 then 10000000 else + if rnd < 8 then 100000000 else + if rnd < 9 then 1000000000 else + 1 in + random()*mult end + +(* Generates a random boolean *) + fun generate_bool() = + let val rnd = random()*10 + val res = if rnd < 5 then false + else true in + res end + +(* Helper function to create a list of some determined size. + f - the function determining what to element to put into the list. + i - the number of elements to be added to the list. *) + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + +(* Generates a random list of random Numbers with size interval [0;9] *) + fun generate_list() = + let val rnd = random()*10 + val noOfItems = if rnd < 1 then 0 else + if rnd < 2 then 1 else + if rnd < 3 then 2 else + if rnd < 4 then 3 else + if rnd < 5 then 4 else + if rnd < 6 then 5 else + if rnd < 7 then 6 else + if rnd < 8 then 7 else + if rnd < 9 then 8 else + 9 in + make_list (generate_number, noOfItems) end + + +(* Runs however many tests specified on a property, while always generating new inputs. + Drops further execution if a Failure is found. + prop - the property function to test. + noOfArgs - number of arguments the property function takes. + noOfTests - number of tests to be run. + generator - the function that should be used to generate input values. *) + fun core_forall (generator, prop, 0) = (Success, (), ()) + |core_forall (generator, prop, i) = + let val args = generator() in + if prop (args) then core_forall (generator, prop, i-1) + else (Failure, args, i) end + +(* Tests a property function - by default 100 times. + noOfArgs - number of arguemnts the property takes + generator - the generator function to generate inputs + prop - the property function to test. *) + fun tc generator prop = + let val (succRes, args, leftOverTests) = core_forall (generator, prop, 100) in + case succRes of + Failure => print "Failure at input:"; + print args; + print "After running:"; + print (100-leftOverTests); + print "tests..." + | Success => print "OK: Passed after 100 tests!" + end + +(* Tests a property function a given number of times. + generator - the generator function to generate inputs + prop - the property function to test. + noOfTests - how many tests should be run. *) + fun tc_n generator prop noOfTests = + let val (succRes, args, leftOverTests) = core_forall (generator, prop, noOfTests) in + case succRes of + Failure => print "Failure at input:"; + print args; + print "After running:"; + print noOfTests-leftOverTests; + print "tests..." + | Success => let val _ = print "OK: Passed after" + val _ = print noOfTests in + print "tests!" end + end + +(* A succesful boolean property created for testing purposes + x,y - should be booleans *) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + +(* A succesful property for numbers created for testing purposes + x,y - should be numbers. *) + fun number_commutative (x, y) = + x < y + + fun my_reverse xs = + xs +(* A succesful property for lists created for testing purposes + xs - should be a list. *) + fun list_reverse xs = + reverse xs = my_reverse xs + in + + print "Testing on lists:"; + tc (fn () => (generate_number(), generate_number())) number_commutative end + From 950bee8a01abaf43cc5d0b29050e2adc96d2614b Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 19 Feb 2024 13:24:30 +0100 Subject: [PATCH 004/121] removed unnecessary Atoms datatype --- troupecheck/tc-Lukas.trp | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/troupecheck/tc-Lukas.trp b/troupecheck/tc-Lukas.trp index b8b20f5..f9421ca 100644 --- a/troupecheck/tc-Lukas.trp +++ b/troupecheck/tc-Lukas.trp @@ -1,7 +1,5 @@ import lists -datatype Atoms = Success | Failure - (* Generates a random Number in the interval ]0;1000000000[ (Note: generates a decimal!) *) let fun generate_number() = let val rnd = random()*10 @@ -54,11 +52,11 @@ let fun generate_number() = noOfArgs - number of arguments the property function takes. noOfTests - number of tests to be run. generator - the function that should be used to generate input values. *) - fun core_forall (generator, prop, 0) = (Success, (), ()) + fun core_forall (generator, prop, 0) = (true, (), ()) |core_forall (generator, prop, i) = let val args = generator() in if prop (args) then core_forall (generator, prop, i-1) - else (Failure, args, i) end + else (false, args, i) end (* Tests a property function - by default 100 times. noOfArgs - number of arguemnts the property takes @@ -67,12 +65,12 @@ let fun generate_number() = fun tc generator prop = let val (succRes, args, leftOverTests) = core_forall (generator, prop, 100) in case succRes of - Failure => print "Failure at input:"; + false => print "Failure at input:"; print args; print "After running:"; print (100-leftOverTests); print "tests..." - | Success => print "OK: Passed after 100 tests!" + | true => print "OK: Passed after 100 tests!" end (* Tests a property function a given number of times. @@ -82,12 +80,12 @@ let fun generate_number() = fun tc_n generator prop noOfTests = let val (succRes, args, leftOverTests) = core_forall (generator, prop, noOfTests) in case succRes of - Failure => print "Failure at input:"; + false => print "Failure at input:"; print args; print "After running:"; print noOfTests-leftOverTests; print "tests..." - | Success => let val _ = print "OK: Passed after" + | true => let val _ = print "OK: Passed after" val _ = print noOfTests in print "tests!" end end @@ -100,7 +98,7 @@ let fun generate_number() = (* A succesful property for numbers created for testing purposes x,y - should be numbers. *) fun number_commutative (x, y) = - x < y + x * y = y * x fun my_reverse xs = xs From a045a22c69a596cdd9a6b747e894abe13695b1bb Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 20 Feb 2024 08:57:19 +0100 Subject: [PATCH 005/121] added a few tests + using func to invoke prop function --- troupecheck/tc-Lukas.trp | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/troupecheck/tc-Lukas.trp b/troupecheck/tc-Lukas.trp index f9421ca..4fe03d4 100644 --- a/troupecheck/tc-Lukas.trp +++ b/troupecheck/tc-Lukas.trp @@ -68,7 +68,7 @@ let fun generate_number() = false => print "Failure at input:"; print args; print "After running:"; - print (100-leftOverTests); + print (100-leftOverTests+1); print "tests..." | true => print "OK: Passed after 100 tests!" end @@ -83,7 +83,7 @@ let fun generate_number() = false => print "Failure at input:"; print args; print "After running:"; - print noOfTests-leftOverTests; + print (noOfTests-leftOverTests+1); print "tests..." | true => let val _ = print "OK: Passed after" val _ = print noOfTests in @@ -105,9 +105,13 @@ let fun generate_number() = (* A succesful property for lists created for testing purposes xs - should be a list. *) fun list_reverse xs = - reverse xs = my_reverse xs + reverse(reverse xs) = xs in + print "Testing on bools:"; + tc (fn () => (generate_bool(), generate_bool())) (fn(x,y) => bool_commutative x y); + print "Testing on numbers:"; + tc (fn () => (generate_number(), generate_number())) number_commutative; print "Testing on lists:"; - tc (fn () => (generate_number(), generate_number())) number_commutative end + tc (fn () => (generate_list())) list_reverse end From e93011ef77a017f63be79b535396b4f0d69c7ef6 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 21 Feb 2024 10:02:45 +0100 Subject: [PATCH 006/121] generate_list_of added --- troupecheck/tc-Lukas.trp | 34 ++++++++++++++++++---------------- 1 file changed, 18 insertions(+), 16 deletions(-) diff --git a/troupecheck/tc-Lukas.trp b/troupecheck/tc-Lukas.trp index 4fe03d4..375807f 100644 --- a/troupecheck/tc-Lukas.trp +++ b/troupecheck/tc-Lukas.trp @@ -14,14 +14,15 @@ let fun generate_number() = if rnd < 9 then 1000000000 else 1 in random()*mult end - -(* Generates a random boolean *) + +(* Generates a random boolean *) fun generate_bool() = let val rnd = random()*10 val res = if rnd < 5 then false else true in res end + (* Helper function to create a list of some determined size. f - the function determining what to element to put into the list. i - the number of elements to be added to the list. *) @@ -29,21 +30,22 @@ let fun generate_number() = case i of 0 => [] | _ => append [f()] (make_list (f, i-1)) + + and generate_list_of(generator) = + let val noOfItems = floor (random()*10) in + make_list (generator, noOfItems) end + + fun generate_generator() = + let val rnd = random() + val res = if rnd <= 1/3 then (fn() => generate_number()) else + if rnd <= 2/3 then (fn() => generate_bool()) else + print "list gen"; (fn() => generate_list_of(generate_number)) in + res end (* Generates a random list of random Numbers with size interval [0;9] *) - fun generate_list() = - let val rnd = random()*10 - val noOfItems = if rnd < 1 then 0 else - if rnd < 2 then 1 else - if rnd < 3 then 2 else - if rnd < 4 then 3 else - if rnd < 5 then 4 else - if rnd < 6 then 5 else - if rnd < 7 then 6 else - if rnd < 8 then 7 else - if rnd < 9 then 8 else - 9 in - make_list (generate_number, noOfItems) end + and generate_list() = + let val generator = generate_generator() in + generate_list_of(generator) end (* Runs however many tests specified on a property, while always generating new inputs. @@ -105,7 +107,7 @@ let fun generate_number() = (* A succesful property for lists created for testing purposes xs - should be a list. *) fun list_reverse xs = - reverse(reverse xs) = xs + reverse xs = my_reverse xs in print "Testing on bools:"; From b31a3decf6801ae60a5123303b869e83451ffbf1 Mon Sep 17 00:00:00 2001 From: Selma Birkedal Date: Wed, 21 Feb 2024 10:03:21 +0100 Subject: [PATCH 007/121] generate_number w noOfTests --- troupecheck/tc-Selma.trp | 129 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 129 insertions(+) create mode 100644 troupecheck/tc-Selma.trp diff --git a/troupecheck/tc-Selma.trp b/troupecheck/tc-Selma.trp new file mode 100644 index 0000000..aa65a22 --- /dev/null +++ b/troupecheck/tc-Selma.trp @@ -0,0 +1,129 @@ +import lists + +datatype Atoms = Success | Failure + +(* Generates a random Number in the interval ]0;1000000000[ (Note: generates a decimal!) *) +let fun generate_number(noOfTests) = + let val res = if noOfTests = 0 then 0 else + if noOfTests = 1 then 1 else + if noOfTests < 10 then random()*10 else + if noOfTests < 100 then random()*100 else + if noOfTests < 1000 then random()*1000 else + if noOfTests < 10000 then random()*10000 else + if noOfTests < 100000 then random()*100000 else + if noOfTests < 1000000 then random()*1000000 else + if noOfTests < 10000000 then random()*10000000 else + if noOfTests < 100000000 then random()*100000000 else + random()*1000000000 in + res end + +(* Generates a random boolean *) + fun generate_bool() = + let val rnd = random()*10 + val res = if rnd < 5 then false + else true in + res end + +(* Helper function to create a list of some determined size. + f - the function determining what to element to put into the list. + i - the number of elements to be added to the list. *) + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + +(* Generates a random list of random Numbers with size interval [0;9] *) + fun generate_list() = + let val rnd = random()*10 + val noOfItems = if rnd < 1 then 0 else + if rnd < 2 then 1 else + if rnd < 3 then 2 else + if rnd < 4 then 3 else + if rnd < 5 then 4 else + if rnd < 6 then 5 else + if rnd < 7 then 6 else + if rnd < 8 then 7 else + if rnd < 9 then 8 else + 9 in + make_list (generate_number, noOfItems) end + +(* Runs a property with some arguments. + prop - the property function to test. + args - a list of arguments - must match number of arguments needed for the property function. *) + fun run_test (prop, args) = + let val res = + case args of + [] => prop + | (x::xs) => + let val newProp = prop x in run_test(newProp, xs) end + in res end + +(* Runs a single test and determines wether result is a Success or a Failure + prop - the property function to test. + args - a list of arguments - must match number of arguments needed for the property function. *) + fun check_success prop args = + if run_test (prop, args) then (Success, []) else (Failure, args) + +(* Runs however many tests specified on a single (Number)property, while always generating new inputs. + Drops further execution if a Failure is found. + prop - the property function to test. + noOfArgs - number of arguments the property function takes. + noOfTests - number of tests to be run. + generator - the function that should be used to generate input values. *) + fun run_all_tests (prop, noOfArgs, noOfTests, generator) = + let val argsList = make_list (generator, noOfArgs) + val (succRes, args) = check_success prop argsList + val res = + case succRes of + Failure => (Failure, args) + | Success => + case noOfTests of + 0 => (Success, []) + |_ => run_all_tests (prop, noOfArgs, noOfTests-1, generator) + in res end + +(* Tests a property function - by default 100 times. + noOfArgs - number of arguemnts the property takes + generator - the generator function to generate inputs + prop - the property function to test. + (Optional) noOfTests - how many tests should be run*) + fun tc noOfArgs generator prop = + let val (succRes, args) = run_all_tests (prop, noOfArgs, 100, generator) in + case succRes of + Failure => let val _ = print "Failure at input: " + in print args end + | Success => print "OK: Passed after 100 tests!" + end + fun tc noOfArgs generator prop noOfTests = + let val (succRes, args) = run_all_tests (prop, noOfArgs, noOfTests, generator) in + case succRes of + Failure => let val _ = print "Failure at input: " + in print args end + | Success => let val _ = print "OK: Passed after" + val _ = print noOfTests in + print "tests!" end + end + +(* A succesful boolean property created for testing purposes + x,y - should be booleans *) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + +(* A succesful property for numbers created for testing purposes + x,y - should be numbers. *) + fun number_commutative x y = + x * y = y * x + +(* A succesful property for lists created for testing purposes + xs - should be a list. *) + fun list_reverse xs = + reverse(reverse xs) = xs + + val _ = print "Testing on lists:" + val listTestRes = tc 1 generate_list list_reverse 3 + val _ = print "Testing on bools:" + val boolTestRes = tc 2 generate_bool bool_commutative 3 + val _ = print "Testing on numbers:" + val numberTestRes = tc 2 generate_number number_commutative 2 +in print "done" end + From 2f27f5d27303d0a63cbaec88688a7d07cb81fdca Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 21 Feb 2024 11:15:27 +0100 Subject: [PATCH 008/121] tc file updated (does not work for lists) --- troupecheck/tc-Lukas.trp | 119 ----------------------------- troupecheck/tc-Selma.trp | 129 ------------------------------- troupecheck/tc.trp | 160 +++++++++++++++++++-------------------- 3 files changed, 76 insertions(+), 332 deletions(-) delete mode 100644 troupecheck/tc-Lukas.trp delete mode 100644 troupecheck/tc-Selma.trp diff --git a/troupecheck/tc-Lukas.trp b/troupecheck/tc-Lukas.trp deleted file mode 100644 index 375807f..0000000 --- a/troupecheck/tc-Lukas.trp +++ /dev/null @@ -1,119 +0,0 @@ -import lists - -(* Generates a random Number in the interval ]0;1000000000[ (Note: generates a decimal!) *) -let fun generate_number() = - let val rnd = random()*10 - val mult = if rnd < 1 then 10 else - if rnd < 2 then 100 else - if rnd < 3 then 1000 else - if rnd < 4 then 10000 else - if rnd < 5 then 100000 else - if rnd < 6 then 1000000 else - if rnd < 7 then 10000000 else - if rnd < 8 then 100000000 else - if rnd < 9 then 1000000000 else - 1 in - random()*mult end - -(* Generates a random boolean *) - fun generate_bool() = - let val rnd = random()*10 - val res = if rnd < 5 then false - else true in - res end - - -(* Helper function to create a list of some determined size. - f - the function determining what to element to put into the list. - i - the number of elements to be added to the list. *) - fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) - - and generate_list_of(generator) = - let val noOfItems = floor (random()*10) in - make_list (generator, noOfItems) end - - fun generate_generator() = - let val rnd = random() - val res = if rnd <= 1/3 then (fn() => generate_number()) else - if rnd <= 2/3 then (fn() => generate_bool()) else - print "list gen"; (fn() => generate_list_of(generate_number)) in - res end - -(* Generates a random list of random Numbers with size interval [0;9] *) - and generate_list() = - let val generator = generate_generator() in - generate_list_of(generator) end - - -(* Runs however many tests specified on a property, while always generating new inputs. - Drops further execution if a Failure is found. - prop - the property function to test. - noOfArgs - number of arguments the property function takes. - noOfTests - number of tests to be run. - generator - the function that should be used to generate input values. *) - fun core_forall (generator, prop, 0) = (true, (), ()) - |core_forall (generator, prop, i) = - let val args = generator() in - if prop (args) then core_forall (generator, prop, i-1) - else (false, args, i) end - -(* Tests a property function - by default 100 times. - noOfArgs - number of arguemnts the property takes - generator - the generator function to generate inputs - prop - the property function to test. *) - fun tc generator prop = - let val (succRes, args, leftOverTests) = core_forall (generator, prop, 100) in - case succRes of - false => print "Failure at input:"; - print args; - print "After running:"; - print (100-leftOverTests+1); - print "tests..." - | true => print "OK: Passed after 100 tests!" - end - -(* Tests a property function a given number of times. - generator - the generator function to generate inputs - prop - the property function to test. - noOfTests - how many tests should be run. *) - fun tc_n generator prop noOfTests = - let val (succRes, args, leftOverTests) = core_forall (generator, prop, noOfTests) in - case succRes of - false => print "Failure at input:"; - print args; - print "After running:"; - print (noOfTests-leftOverTests+1); - print "tests..." - | true => let val _ = print "OK: Passed after" - val _ = print noOfTests in - print "tests!" end - end - -(* A succesful boolean property created for testing purposes - x,y - should be booleans *) - fun bool_commutative x y = - (x andalso y) = (y andalso x) - -(* A succesful property for numbers created for testing purposes - x,y - should be numbers. *) - fun number_commutative (x, y) = - x * y = y * x - - fun my_reverse xs = - xs -(* A succesful property for lists created for testing purposes - xs - should be a list. *) - fun list_reverse xs = - reverse xs = my_reverse xs - in - - print "Testing on bools:"; - tc (fn () => (generate_bool(), generate_bool())) (fn(x,y) => bool_commutative x y); - print "Testing on numbers:"; - tc (fn () => (generate_number(), generate_number())) number_commutative; - print "Testing on lists:"; - tc (fn () => (generate_list())) list_reverse end - diff --git a/troupecheck/tc-Selma.trp b/troupecheck/tc-Selma.trp deleted file mode 100644 index aa65a22..0000000 --- a/troupecheck/tc-Selma.trp +++ /dev/null @@ -1,129 +0,0 @@ -import lists - -datatype Atoms = Success | Failure - -(* Generates a random Number in the interval ]0;1000000000[ (Note: generates a decimal!) *) -let fun generate_number(noOfTests) = - let val res = if noOfTests = 0 then 0 else - if noOfTests = 1 then 1 else - if noOfTests < 10 then random()*10 else - if noOfTests < 100 then random()*100 else - if noOfTests < 1000 then random()*1000 else - if noOfTests < 10000 then random()*10000 else - if noOfTests < 100000 then random()*100000 else - if noOfTests < 1000000 then random()*1000000 else - if noOfTests < 10000000 then random()*10000000 else - if noOfTests < 100000000 then random()*100000000 else - random()*1000000000 in - res end - -(* Generates a random boolean *) - fun generate_bool() = - let val rnd = random()*10 - val res = if rnd < 5 then false - else true in - res end - -(* Helper function to create a list of some determined size. - f - the function determining what to element to put into the list. - i - the number of elements to be added to the list. *) - fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) - -(* Generates a random list of random Numbers with size interval [0;9] *) - fun generate_list() = - let val rnd = random()*10 - val noOfItems = if rnd < 1 then 0 else - if rnd < 2 then 1 else - if rnd < 3 then 2 else - if rnd < 4 then 3 else - if rnd < 5 then 4 else - if rnd < 6 then 5 else - if rnd < 7 then 6 else - if rnd < 8 then 7 else - if rnd < 9 then 8 else - 9 in - make_list (generate_number, noOfItems) end - -(* Runs a property with some arguments. - prop - the property function to test. - args - a list of arguments - must match number of arguments needed for the property function. *) - fun run_test (prop, args) = - let val res = - case args of - [] => prop - | (x::xs) => - let val newProp = prop x in run_test(newProp, xs) end - in res end - -(* Runs a single test and determines wether result is a Success or a Failure - prop - the property function to test. - args - a list of arguments - must match number of arguments needed for the property function. *) - fun check_success prop args = - if run_test (prop, args) then (Success, []) else (Failure, args) - -(* Runs however many tests specified on a single (Number)property, while always generating new inputs. - Drops further execution if a Failure is found. - prop - the property function to test. - noOfArgs - number of arguments the property function takes. - noOfTests - number of tests to be run. - generator - the function that should be used to generate input values. *) - fun run_all_tests (prop, noOfArgs, noOfTests, generator) = - let val argsList = make_list (generator, noOfArgs) - val (succRes, args) = check_success prop argsList - val res = - case succRes of - Failure => (Failure, args) - | Success => - case noOfTests of - 0 => (Success, []) - |_ => run_all_tests (prop, noOfArgs, noOfTests-1, generator) - in res end - -(* Tests a property function - by default 100 times. - noOfArgs - number of arguemnts the property takes - generator - the generator function to generate inputs - prop - the property function to test. - (Optional) noOfTests - how many tests should be run*) - fun tc noOfArgs generator prop = - let val (succRes, args) = run_all_tests (prop, noOfArgs, 100, generator) in - case succRes of - Failure => let val _ = print "Failure at input: " - in print args end - | Success => print "OK: Passed after 100 tests!" - end - fun tc noOfArgs generator prop noOfTests = - let val (succRes, args) = run_all_tests (prop, noOfArgs, noOfTests, generator) in - case succRes of - Failure => let val _ = print "Failure at input: " - in print args end - | Success => let val _ = print "OK: Passed after" - val _ = print noOfTests in - print "tests!" end - end - -(* A succesful boolean property created for testing purposes - x,y - should be booleans *) - fun bool_commutative x y = - (x andalso y) = (y andalso x) - -(* A succesful property for numbers created for testing purposes - x,y - should be numbers. *) - fun number_commutative x y = - x * y = y * x - -(* A succesful property for lists created for testing purposes - xs - should be a list. *) - fun list_reverse xs = - reverse(reverse xs) = xs - - val _ = print "Testing on lists:" - val listTestRes = tc 1 generate_list list_reverse 3 - val _ = print "Testing on bools:" - val boolTestRes = tc 2 generate_bool bool_commutative 3 - val _ = print "Testing on numbers:" - val numberTestRes = tc 2 generate_number number_commutative 2 -in print "done" end - diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index acb0395..42cc64b 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,105 +1,96 @@ import lists -datatype Atoms = Success | Failure - -(* Generates a random Number in the interval ]0;1000000000[ (Note: generates a decimal!) *) -let fun generate_number() = - let val rnd = random()*10 - val mult = if rnd < 1 then 10 else - if rnd < 2 then 100 else - if rnd < 3 then 1000 else - if rnd < 4 then 10000 else - if rnd < 5 then 100000 else - if rnd < 6 then 1000000 else - if rnd < 7 then 10000000 else - if rnd < 8 then 100000000 else - if rnd < 9 then 1000000000 else - 1 in - random()*mult end - -(* Generates a random boolean *) - fun generate_bool() = +let +(* Generates a random boolean *) + fun generate_bool noOfTests = let val rnd = random()*10 val res = if rnd < 5 then false else true in res end -(* Helper function to create a list of some determined size. +(* Generates a random float based on number of tests that has been run so far. + noOfTests - a non negative integer to determin the size*) + fun generate_float noOfTests = + let val x = random()*noOfTests + val is_pos = generate_bool() in + if is_pos then x else (-x) end + +(* Generates a random integer based on number of tests that has been run so far. + noOfTests - a non negative integer to determin the size*) + fun generate_int noOfTests = + floor (generate_float(noOfTests)) + +(* Create a list of some determined size. f - the function determining what to element to put into the list. i - the number of elements to be added to the list. *) fun make_list (f, i) = case i of 0 => [] | _ => append [f()] (make_list (f, i-1)) - -(* Generates a random list of random Numbers with size interval [0;9] *) - fun generate_list() = - let val rnd = random()*10 - val noOfItems = if rnd < 1 then 0 else - if rnd < 2 then 1 else - if rnd < 3 then 2 else - if rnd < 4 then 3 else - if rnd < 5 then 4 else - if rnd < 6 then 5 else - if rnd < 7 then 6 else - if rnd < 8 then 7 else - if rnd < 9 then 8 else - 9 in - make_list (generate_number, noOfItems) end -(* Runs a property with some arguments. - prop - the property function to test. - args - a list of arguments - must match number of arguments needed for the property function. *) - fun run_test (prop, args) = - let val res = - case args of - [] => prop - | (x::xs) => - let val newProp = prop x in run_test(newProp, xs) end - in res end +(* Generates a randomly sized list of some specified type of elements. + generator - the generator that should be used to create elements. + noOfTests - some non negative integer *) + and generate_list_of (generator) noOfTests = + let val size = generate_int(noOfTests) in + make_list ((fn () => generator noOfTests), size) end -(* Runs a single test and determines wether result is a Success or a Failure - prop - the property function to test. - args - a list of arguments - must match number of arguments needed for the property function. *) - fun check_success prop args = - if run_test (prop, args) then (Success, []) else (Failure, args) +(* Generates a random generator + noOfTests - some non negative integer *) + fun generate_generator noOfTests = + let val rnd = random() + val res = if rnd <= 1/3 then (fn() => generate_int()) else + if rnd <= 2/3 then (fn() => generate_bool()) else + (fn() => generate_list_of(generate_int)) in + res end + +(* Generates a randomly sized list of a randomly chosen type of elements + noOfTests - some non negative integer *) + and generate_list noOfTests = + let val generator = generate_generator noOfTests in + generate_list_of(generator) noOfTests end -(* Runs however many tests specified on a single (Number)property, while always generating new inputs. + +(* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. prop - the property function to test. noOfArgs - number of arguments the property function takes. noOfTests - number of tests to be run. generator - the function that should be used to generate input values. *) - fun run_all_tests (prop, noOfArgs, noOfTests, generator) = - let val argsList = make_list (generator, noOfArgs) - val (succRes, args) = check_success prop argsList - val res = - case succRes of - Failure => (Failure, args) - | Success => - case noOfTests of - 0 => (Success, []) - |_ => run_all_tests (prop, noOfArgs, noOfTests-1, generator) - in res end + fun core_forall (generator, prop, 0, noOfTests) = (true, (), ()) + |core_forall (generator, prop, i, noOfTests) = + let val args = generator noOfTests in + if prop args then core_forall (generator, prop, i-1, noOfTests+1) + else (false, args, noOfTests) end (* Tests a property function - by default 100 times. noOfArgs - number of arguemnts the property takes generator - the generator function to generate inputs - prop - the property function to test. - (Optional) noOfTests - how many tests should be run*) - fun tc noOfArgs generator prop = - let val (succRes, args) = run_all_tests (prop, noOfArgs, 100, generator) in + prop - the property function to test. *) + fun tc generator prop = + let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0) in case succRes of - Failure => let val _ = print "Failure at input: " - in print args end - | Success => print "OK: Passed after 100 tests!" + false => print "Failure at input:"; + print args; + print "After running:"; + print (successfulTests+1); + print "tests" + | true => print "OK: Passed after 100 tests!" end - fun tc noOfArgs generator prop noOfTests = - let val (succRes, args) = run_all_tests (prop, noOfArgs, noOfTests, generator) in + +(* Tests a property function a given number of times. + generator - the generator function to generate inputs + prop - the property function to test. + noOfTests - how many tests should be run. *) + fun tc_n generator prop noOfTests = + let val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0) in case succRes of - Failure => let val _ = print "Failure at input: " - in print args end - | Success => let val _ = print "OK: Passed after" + false => print "Failure at input:"; + print args; + print "After running:"; + print (successfulTests+1); + print "test(s)" + | true => let val _ = print "OK: Passed after" val _ = print noOfTests in print "tests!" end end @@ -111,19 +102,20 @@ let fun generate_number() = (* A succesful property for numbers created for testing purposes x,y - should be numbers. *) - fun number_commutative x y = - x * y = y * x + fun number_commutative (x, y) = + x < y + fun my_reverse xs = + xs (* A succesful property for lists created for testing purposes xs - should be a list. *) fun list_reverse xs = reverse(reverse xs) = xs + in - val _ = print "Testing on lists:" - val listTestRes = tc 1 generate_list list_reverse 3 - val _ = print "Testing on bools:" - val boolTestRes = tc 2 generate_bool bool_commutative 3 - val _ = print "Testing on numbers:" - val numberTestRes = tc 2 generate_number number_commutative 2 -in print "done" end - + print "Testing on bools:"; + tc (fn i => (generate_bool i, generate_bool i)) (fn(x,y) => bool_commutative x y); + print "Testing on numbers:"; + tc (fn i => (generate_int i, generate_int i)) number_commutative; + print "Testing on lists:"; + tc (fn i => (generate_list_of(generate_int) i)) list_reverse end \ No newline at end of file From 1c197171a9f2181f2dd407f764a96dca23a76fa6 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 21 Feb 2024 12:07:03 +0100 Subject: [PATCH 009/121] tests on lists works + implemented pick random int --- troupecheck/tc.trp | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 42cc64b..edfcf9e 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,6 +1,6 @@ import lists -let +let (* Generates a random boolean *) fun generate_bool noOfTests = let val rnd = random()*10 @@ -20,6 +20,11 @@ let fun generate_int noOfTests = floor (generate_float(noOfTests)) + + fun pick_rand_int (i) = + let val seed = generate_int i in + if seed < 0 then (-seed) mod (i+1) else + seed mod (i+1) end (* Create a list of some determined size. f - the function determining what to element to put into the list. i - the number of elements to be added to the list. *) @@ -32,7 +37,7 @@ let generator - the generator that should be used to create elements. noOfTests - some non negative integer *) and generate_list_of (generator) noOfTests = - let val size = generate_int(noOfTests) in + let val size = pick_rand_int(noOfTests) in make_list ((fn () => generator noOfTests), size) end (* Generates a random generator @@ -111,11 +116,23 @@ let xs - should be a list. *) fun list_reverse xs = reverse(reverse xs) = xs + + fun pick_rand_int_stays_in_interval i = + pick_rand_int i <= i + + fun pick_rand_int_stays_in_interval_fifty() = + pick_rand_int 50 <= 50 in - print "Testing on bools:"; + print "Testing on bools commutative:"; tc (fn i => (generate_bool i, generate_bool i)) (fn(x,y) => bool_commutative x y); - print "Testing on numbers:"; + print "Testing on numbers commutative:"; tc (fn i => (generate_int i, generate_int i)) number_commutative; - print "Testing on lists:"; - tc (fn i => (generate_list_of(generate_int) i)) list_reverse end \ No newline at end of file + print "Testing on list reverse:"; + tc (fn i => (generate_list_of(generate_int) i)) list_reverse; + print "Testing on pick_rand_int:"; + tc_n (fn i => let val x = generate_int i in + if x < 0 then -x else x end) pick_rand_int_stays_in_interval 1000; + print "Testing on pick_rand_int (again):"; + tc (fn i => ()) pick_rand_int_stays_in_interval_fifty + end From f2a028bd9c6384215cf7ce1350d14821377b3cef Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 22 Feb 2024 23:41:46 +0100 Subject: [PATCH 010/121] added list and char generator + cleaned up generator signatures that doesn't need a size param --- troupecheck/tc.trp | 69 ++++++++++++++++++++++++++++++---------------- 1 file changed, 46 insertions(+), 23 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index edfcf9e..b03f56d 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -2,7 +2,7 @@ import lists let (* Generates a random boolean *) - fun generate_bool noOfTests = + fun generate_bool () = let val rnd = random()*10 val res = if rnd < 5 then false else true in @@ -20,7 +20,12 @@ let fun generate_int noOfTests = floor (generate_float(noOfTests)) - +(* Generates a random positive integer based on number of tests that has been run so far. + noOfTests - a non negative integer to determin the size*) + fun generate_pos_int noOfTests = + let val x = floor (generate_float(noOfTests)) in + if x < 0 then -x else x end + fun pick_rand_int (i) = let val seed = generate_int i in if seed < 0 then (-seed) mod (i+1) else @@ -40,21 +45,44 @@ let let val size = pick_rand_int(noOfTests) in make_list ((fn () => generator noOfTests), size) end -(* Generates a random generator - noOfTests - some non negative integer *) - fun generate_generator noOfTests = +(* Generates a random generator *) + fun generate_generator () = let val rnd = random() - val res = if rnd <= 1/3 then (fn() => generate_int()) else - if rnd <= 2/3 then (fn() => generate_bool()) else - (fn() => generate_list_of(generate_int)) in + val res = if rnd <= 1/3 then (fn i => generate_int i) else + if rnd <= 2/3 then (fn i => generate_bool()) else + (fn i => generate_list_of (generate_int) i) in res end (* Generates a randomly sized list of a randomly chosen type of elements noOfTests - some non negative integer *) and generate_list noOfTests = - let val generator = generate_generator noOfTests in - generate_list_of(generator) noOfTests end + let val generator = generate_generator() in + generate_list_of (generator) noOfTests end +(* Copied from list lib, becuase it doesn't seem to be imported with the library?*) + fun nth (x::l) 1 = x + | nth (x::l) n = nth l (n - 1) + +(* Generates a random character - no spaces or sepcial characters, + only letters (upper and lower case) and numbers. *) + fun generate_char () = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = pick_rand_int (length chars-1) +1 in + print x; + nth chars x end + +(* Generates a random string, with length ranging from 0 to noOfTest, + only letters (upper and lower case) and numbers. *) + fun generate_string noOfTests = + let val x = pick_rand_int noOfTests + fun fold f acc 0 = acc + | fold f acc i = fold f (acc ^ f()) (i-1) in + fold generate_char "" x end (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. @@ -68,6 +96,7 @@ let if prop args then core_forall (generator, prop, i-1, noOfTests+1) else (false, args, noOfTests) end + (* Tests a property function - by default 100 times. noOfArgs - number of arguemnts the property takes generator - the generator function to generate inputs @@ -77,9 +106,7 @@ let case succRes of false => print "Failure at input:"; print args; - print "After running:"; - print (successfulTests+1); - print "tests" + print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") | true => print "OK: Passed after 100 tests!" end @@ -92,12 +119,8 @@ let case succRes of false => print "Failure at input:"; print args; - print "After running:"; - print (successfulTests+1); - print "test(s)" - | true => let val _ = print "OK: Passed after" - val _ = print noOfTests in - print "tests!" end + print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") + | true => print ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).") end (* A succesful boolean property created for testing purposes @@ -122,17 +145,17 @@ let fun pick_rand_int_stays_in_interval_fifty() = pick_rand_int 50 <= 50 + in print "Testing on bools commutative:"; - tc (fn i => (generate_bool i, generate_bool i)) (fn(x,y) => bool_commutative x y); + tc (fn i => (generate_bool (), generate_bool ())) (fn(x,y) => bool_commutative x y); print "Testing on numbers commutative:"; tc (fn i => (generate_int i, generate_int i)) number_commutative; print "Testing on list reverse:"; - tc (fn i => (generate_list_of(generate_int) i)) list_reverse; + tc (fn i => (generate_list i )) list_reverse; print "Testing on pick_rand_int:"; - tc_n (fn i => let val x = generate_int i in - if x < 0 then -x else x end) pick_rand_int_stays_in_interval 1000; + tc_n (fn i => generate_pos_int i) pick_rand_int_stays_in_interval 1000; print "Testing on pick_rand_int (again):"; tc (fn i => ()) pick_rand_int_stays_in_interval_fifty end From bf45af0cb8f0cf8f118123fb7dcaac6580da14a0 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 22 Feb 2024 23:43:16 +0100 Subject: [PATCH 011/121] Updated .gitignore to include a "test.trp" file in tc folder --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 8d39ced..9f0e2a1 100644 --- a/.gitignore +++ b/.gitignore @@ -33,3 +33,4 @@ yarn-error.log bin/troupe bin/understudy trp-rt/out/ +troupecheck/test.trp \ No newline at end of file From 21709fc8e20bb5d82d76a2499f37e5fc16db9891 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 23 Feb 2024 10:08:42 +0100 Subject: [PATCH 012/121] Additional comments --- troupecheck/tc.trp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index b03f56d..bf449fa 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,6 +1,7 @@ import lists let +(* -----------------GENERATORS AND UTILS--------------------------*) (* Generates a random boolean *) fun generate_bool () = let val rnd = random()*10 @@ -83,7 +84,8 @@ let fun fold f acc 0 = acc | fold f acc i = fold f (acc ^ f()) (i-1) in fold generate_char "" x end - + +(* -----------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. prop - the property function to test. From b5313f1fb1d174a6a58e0a89ee4c5ad9b37277cf Mon Sep 17 00:00:00 2001 From: Selma Birkedal Date: Fri, 23 Feb 2024 10:41:03 +0100 Subject: [PATCH 013/121] Adding some tests and convenience functions --- troupecheck/tc.trp | 41 +++++++++++++++++++++++++++++++---------- 1 file changed, 31 insertions(+), 10 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index bf449fa..057f4fd 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -23,10 +23,6 @@ let (* Generates a random positive integer based on number of tests that has been run so far. noOfTests - a non negative integer to determin the size*) - fun generate_pos_int noOfTests = - let val x = floor (generate_float(noOfTests)) in - if x < 0 then -x else x end - fun pick_rand_int (i) = let val seed = generate_int i in if seed < 0 then (-seed) mod (i+1) else @@ -84,7 +80,17 @@ let fun fold f acc 0 = acc | fold f acc i = fold f (acc ^ f()) (i-1) in fold generate_char "" x end - + + fun one_of_two x y = + let val bool = generate_bool () in + if bool then x + else y end + + fun abs_value x = + if x < 0 then -x else x + + fun generate_pos_int noOfTests = + abs_value(generate_int noOfTests) (* -----------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. @@ -125,6 +131,14 @@ let | true => print ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).") end +(* *) + fun my_reverse xs = + xs + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + (* A succesful boolean property created for testing purposes x,y - should be booleans *) fun bool_commutative x y = @@ -133,10 +147,7 @@ let (* A succesful property for numbers created for testing purposes x,y - should be numbers. *) fun number_commutative (x, y) = - x < y - - fun my_reverse xs = - xs + x * y = y * x (* A succesful property for lists created for testing purposes xs - should be a list. *) fun list_reverse xs = @@ -145,9 +156,15 @@ let fun pick_rand_int_stays_in_interval i = pick_rand_int i <= i + fun abs_value_is_always_pos i = + abs_value i >= 0 + fun pick_rand_int_stays_in_interval_fifty() = pick_rand_int 50 <= 50 + fun my_floor_test i = + my_floor i = floor i + in print "Testing on bools commutative:"; @@ -159,5 +176,9 @@ let print "Testing on pick_rand_int:"; tc_n (fn i => generate_pos_int i) pick_rand_int_stays_in_interval 1000; print "Testing on pick_rand_int (again):"; - tc (fn i => ()) pick_rand_int_stays_in_interval_fifty + tc (fn i => ()) pick_rand_int_stays_in_interval_fifty; + print "Testing on abs_value:"; + tc (fn i => (one_of_two generate_int generate_float) i) abs_value_is_always_pos; + print "Testing on my_floor:"; + tc (fn i => generate_float i) my_floor_test end From 93d4cda2d0b3489ddf81fc82656253d76ed2a80d Mon Sep 17 00:00:00 2001 From: Selma Birkedal Date: Fri, 23 Feb 2024 12:15:08 +0100 Subject: [PATCH 014/121] More tests and convenience funktions --- troupecheck/tc-Selma.trp | 224 +++++++++++++++++++++++++++++++++++++++ troupecheck/tc.trp | 20 +++- 2 files changed, 242 insertions(+), 2 deletions(-) create mode 100644 troupecheck/tc-Selma.trp diff --git a/troupecheck/tc-Selma.trp b/troupecheck/tc-Selma.trp new file mode 100644 index 0000000..862aaa7 --- /dev/null +++ b/troupecheck/tc-Selma.trp @@ -0,0 +1,224 @@ +import lists + +let +(* -----------------GENERATORS AND UTILS--------------------------*) +(* Generates a random boolean *) + fun generate_bool () = + let val rnd = random()*10 + val res = if rnd < 5 then false + else true in + res end + +(* Generates a random float based on number of tests that has been run so far. + noOfTests - a non negative integer to determin the size*) + fun generate_float noOfTests = + let val x = random()*noOfTests + val is_pos = generate_bool() in + if is_pos then x else (-x) end + +(* Generates a random integer based on number of tests that has been run so far. + noOfTests - a non negative integer to determin the size*) + fun generate_int noOfTests = + floor (generate_float(noOfTests)) + +(* Generates a random positive integer based on number of tests that has been run so far. + noOfTests - a non negative integer to determin the size*) + fun pick_rand_int (i) = + let val seed = generate_int i in + if seed < 0 then (-seed) mod (i+1) else + seed mod (i+1) end +(* Create a list of some determined size. + f - the function determining what to element to put into the list. + i - the number of elements to be added to the list. *) + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + +(* Generates a randomly sized list of some specified type of elements. + generator - the generator that should be used to create elements. + noOfTests - some non negative integer *) + and generate_list_of (generator) noOfTests = + let val size = pick_rand_int(noOfTests) in + make_list ((fn () => generator noOfTests), size) end + +(* Generates a random generator *) + fun generate_generator () = + let val rnd = random() + val res = if rnd <= 1/3 then (fn i => generate_int i) else + if rnd <= 2/3 then (fn i => generate_bool()) else + (fn i => generate_list_of (generate_int) i) in + res end + +(* Generates a randomly sized list of a randomly chosen type of elements + noOfTests - some non negative integer *) + and generate_list noOfTests = + let val generator = generate_generator() in + generate_list_of (generator) noOfTests end + +(* Copied from list lib, becuase it doesn't seem to be imported with the library?*) + fun nth (x::l) 1 = x + | nth (x::l) n = nth l (n - 1) + +(* Generates a random character - no spaces or sepcial characters, + only letters (upper and lower case) and numbers. *) + fun generate_char () = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = pick_rand_int (length chars-1) +1 in + print x; + nth chars x end + +(* Generates a random string, with length ranging from 0 to noOfTest, + only letters (upper and lower case) and numbers. *) + fun generate_string noOfTests = + let val x = pick_rand_int noOfTests + fun fold f acc 0 = acc + | fold f acc i = fold f (acc ^ f()) (i-1) in + fold generate_char "" x end + + fun one_of_two x y = + let val bool = generate_bool () in + if bool then x + else y end + + fun abs_value x = + if x < 0 then -x else x + + fun generate_pos_int noOfTests = + abs_value(generate_int noOfTests) + + fun sign x = + if x = 0 then 0 + else if x > 0 then 1 + else -1 +(* -----------------CORE FUNCTIONALITY--------------------------*) +(* Runs however many tests specified on a property, while always generating new inputs. + Drops further execution if a Failure is found. + prop - the property function to test. + noOfArgs - number of arguments the property function takes. + noOfTests - number of tests to be run. + generator - the function that should be used to generate input values. *) + fun core_forall (generator, prop, 0, noOfTests) = (true, (), ()) + |core_forall (generator, prop, i, noOfTests) = + let val args = generator noOfTests in + if prop args then core_forall (generator, prop, i-1, noOfTests+1) + else (false, args, noOfTests) end + + +(* Tests a property function - by default 100 times. + noOfArgs - number of arguemnts the property takes + generator - the generator function to generate inputs + prop - the property function to test. *) + fun tc generator prop = + let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0) in + case succRes of + false => print "Failure at input:"; + print args; + print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") + | true => print "OK: Passed after 100 tests!" + end + +(* Tests a property function a given number of times. + generator - the generator function to generate inputs + prop - the property function to test. + noOfTests - how many tests should be run. *) + fun tc_n generator prop noOfTests = + let val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0) in + case succRes of + false => print "Failure at input:"; + print args; + print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") + | true => print ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).") + end + +(* *) + fun my_reverse xs = + xs + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_ceil_1 i = + if i > 0 then i + (1 - (i mod 1)) + else i + (1 - (i mod 1)) - 1 + + fun my_ceil_2 i = + if i > 0 then (my_floor i) + 1 + else if i = 0 then 0 + else (my_floor i) + 1 + + (*Virker ikke for negative tal (endnu)*) + fun my_mod x y = + if y = 0 then 0 + else x - (my_floor(x/y) * y) + +(* A succesful boolean property created for testing purposes + x,y - should be booleans *) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + +(* A succesful property for numbers created for testing purposes + x,y - should be numbers. *) + fun number_commutative (x, y) = + x * y = y * x +(* A succesful property for lists created for testing purposes + xs - should be a list. *) + fun list_reverse xs = + reverse(reverse xs) = xs + + fun pick_rand_int_stays_in_interval i = + pick_rand_int i <= i + + fun abs_value_is_always_pos i = + abs_value i >= 0 + + fun pick_rand_int_stays_in_interval_fifty() = + pick_rand_int 50 <= 50 + + fun my_floor_test i = + my_floor i = floor i + + fun my_ceil_1_test i = + my_ceil_1 i = ceil i + + fun my_ceil_2_test i = + my_ceil_2 i = ceil i + + fun both_ceil_test i = + my_ceil_1 i = my_ceil_1 i + + fun my_mod_test (x, y) = + if y = 0 then true + else my_mod x y = (x mod y) + + in + + print "Testing on bools commutative:"; + tc (fn i => (generate_bool (), generate_bool ())) (fn(x,y) => bool_commutative x y); + print "Testing on numbers commutative:"; + tc (fn i => (generate_int i, generate_int i)) number_commutative; + print "Testing on list reverse:"; + tc (fn i => (generate_list i )) list_reverse; + print "Testing on pick_rand_int:"; + tc_n (fn i => generate_pos_int i) pick_rand_int_stays_in_interval 1000; + print "Testing on pick_rand_int (again):"; + tc (fn i => ()) pick_rand_int_stays_in_interval_fifty; + print "Testing on abs_value:"; + tc (fn i => (one_of_two generate_int generate_float) i) abs_value_is_always_pos; + print "Testing on my_floor:"; + tc (fn i => generate_float i) my_floor_test; + print "Testing on my_ceil_1:"; + tc (fn i => generate_float i) my_ceil_1_test; + print "Testing on my_ceil_2:"; + tc (fn i => generate_float i) my_ceil_2_test; + print "Testing on both ceil functions:"; + tc (fn i => generate_float i) both_ceil_test; + print "Testing on my_mod:"; + tc (fn i => (generate_int i, generate_int i)) my_mod_test + end diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 057f4fd..74b905b 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,5 +1,4 @@ import lists - let (* -----------------GENERATORS AND UTILS--------------------------*) (* Generates a random boolean *) @@ -91,6 +90,23 @@ let fun generate_pos_int noOfTests = abs_value(generate_int noOfTests) + + fun run_gen f i= + case f of + generate_bool => generate_bool() + | generate_char => generate_char() + | _ => f i + + fun make_func xs = + case xs of + [] => fn i => () + | _ => + let fun make_func_aux f [] = f + | make_func_aux f (x::xs) = make_func_aux (fn i => (f i, run_gen x i)) xs + in + make_func_aux (fn i => ()) (reverse xs) end + + (* -----------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. @@ -168,7 +184,7 @@ let in print "Testing on bools commutative:"; - tc (fn i => (generate_bool (), generate_bool ())) (fn(x,y) => bool_commutative x y); + tc (make_func [generate_bool, generate_bool]) (fn(x,y) => bool_commutative x y); print "Testing on numbers commutative:"; tc (fn i => (generate_int i, generate_int i)) number_commutative; print "Testing on list reverse:"; From 3584b344a9a2e938359452dc3280f497f925a3bf Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 26 Feb 2024 18:13:36 +0100 Subject: [PATCH 015/121] updated the generators to match proper --- troupecheck/tc.trp | 143 ++++++++++++++++++++++----------------------- 1 file changed, 71 insertions(+), 72 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 74b905b..8d740cb 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,31 +1,35 @@ import lists -let +let (* -----------------GENERATORS AND UTILS--------------------------*) + val inf = 1 / 0 (* Generates a random boolean *) - fun generate_bool () = - let val rnd = random()*10 - val res = if rnd < 5 then false + fun bool_gen size = + let val rnd = random() + val res = if rnd < 1/2 then false else true in res end (* Generates a random float based on number of tests that has been run so far. - noOfTests - a non negative integer to determin the size*) - fun generate_float noOfTests = - let val x = random()*noOfTests - val is_pos = generate_bool() in - if is_pos then x else (-x) end + (low, high) - a tuple of values specifying the interval numbers should be generated between + size - a non negative integer*) + fun float_gen (low, high) size = + let val x = random() + val lInf = low = inf + val hInf = high = inf + in + case (lInf, hInf) of + (true, true) => if (bool_gen size) then x*size else -x*size + | (true, false) => high - (x*size) + | (false, true) => low + (x*size) + | (false, false) => low + (x * (high-low)) + end (* Generates a random integer based on number of tests that has been run so far. - noOfTests - a non negative integer to determin the size*) - fun generate_int noOfTests = - floor (generate_float(noOfTests)) - -(* Generates a random positive integer based on number of tests that has been run so far. - noOfTests - a non negative integer to determin the size*) - fun pick_rand_int (i) = - let val seed = generate_int i in - if seed < 0 then (-seed) mod (i+1) else - seed mod (i+1) end + (low, high) - a tuple of values specifying the interval numbers should be generated between + size - a non negative integer*) + fun int_gen (low, high) size = + floor (float_gen(low, high) size) + (* Create a list of some determined size. f - the function determining what to element to put into the list. i - the number of elements to be added to the list. *) @@ -37,23 +41,19 @@ let (* Generates a randomly sized list of some specified type of elements. generator - the generator that should be used to create elements. noOfTests - some non negative integer *) - and generate_list_of (generator) noOfTests = - let val size = pick_rand_int(noOfTests) in - make_list ((fn () => generator noOfTests), size) end + and list_gen (generator) size = + let val length = (int_gen(0, size) size) in + make_list ((fn () => generator size), length) end (* Generates a random generator *) - fun generate_generator () = + fun generator_gen size = let val rnd = random() - val res = if rnd <= 1/3 then (fn i => generate_int i) else - if rnd <= 2/3 then (fn i => generate_bool()) else - (fn i => generate_list_of (generate_int) i) in + val res = if rnd <= 1/4 then (fn i => int_gen(inf, inf) i) else + if rnd <= 2/4 then (fn i => bool_gen i) else + if rnd <= 3/4 then (fn i => float_gen(inf, inf) i) else + (fn i => list_gen (int_gen(inf, inf)) i) in res end - -(* Generates a randomly sized list of a randomly chosen type of elements - noOfTests - some non negative integer *) - and generate_list noOfTests = - let val generator = generate_generator() in - generate_list_of (generator) noOfTests end + (* Copied from list lib, becuase it doesn't seem to be imported with the library?*) fun nth (x::l) 1 = x @@ -61,51 +61,31 @@ let (* Generates a random character - no spaces or sepcial characters, only letters (upper and lower case) and numbers. *) - fun generate_char () = + fun char_gen size = let val chars = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = pick_rand_int (length chars-1) +1 in - print x; + val x = int_gen (1, ((length chars)-1)) size in nth chars x end (* Generates a random string, with length ranging from 0 to noOfTest, only letters (upper and lower case) and numbers. *) - fun generate_string noOfTests = - let val x = pick_rand_int noOfTests + fun string_gen size = + let val x = int_gen (0, size) size fun fold f acc 0 = acc | fold f acc i = fold f (acc ^ f()) (i-1) in - fold generate_char "" x end + fold char_gen "" x end fun one_of_two x y = - let val bool = generate_bool () in + let val bool = bool_gen 0 in if bool then x else y end fun abs_value x = if x < 0 then -x else x - - fun generate_pos_int noOfTests = - abs_value(generate_int noOfTests) - - fun run_gen f i= - case f of - generate_bool => generate_bool() - | generate_char => generate_char() - | _ => f i - - fun make_func xs = - case xs of - [] => fn i => () - | _ => - let fun make_func_aux f [] = f - | make_func_aux f (x::xs) = make_func_aux (fn i => (f i, run_gen x i)) xs - in - make_func_aux (fn i => ()) (reverse xs) end - (* -----------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. @@ -155,6 +135,15 @@ let if i >=0 then i - (i mod 1) else i - (i mod 1) - 1 + fun my_length [] = 0 + | my_length (x::xs) = 1 + (my_length xs) + + fun my_count y [] = 0 + | my_count y (x::xs) = + let val z = + if y = x then 1 else 0 + in + z + my_count y xs end (* A succesful boolean property created for testing purposes x,y - should be booleans *) fun bool_commutative x y = @@ -169,32 +158,42 @@ let fun list_reverse xs = reverse(reverse xs) = xs - fun pick_rand_int_stays_in_interval i = - pick_rand_int i <= i + fun int_gen_stays_in_interval i = + int_gen (0, i) i <= i fun abs_value_is_always_pos i = abs_value i >= 0 - fun pick_rand_int_stays_in_interval_fifty() = - pick_rand_int 50 <= 50 - fun my_floor_test i = my_floor i = floor i + + fun my_length_test xs = + my_length xs = length xs + + fun make_list_test i = + length (make_list ((fn ()=> (generator_gen i) (int_gen(0,inf) i)), i)) = i + + fun my_count_returns_non_negative_int (x, xs) = + (my_count x xs) >= 0 in print "Testing on bools commutative:"; - tc (make_func [generate_bool, generate_bool]) (fn(x,y) => bool_commutative x y); + tc (fn i => (bool_gen i, bool_gen i)) (fn(x,y) => bool_commutative x y); print "Testing on numbers commutative:"; - tc (fn i => (generate_int i, generate_int i)) number_commutative; + tc (fn i => (int_gen(inf, inf) i, int_gen(inf, inf) i)) number_commutative; print "Testing on list reverse:"; - tc (fn i => (generate_list i )) list_reverse; - print "Testing on pick_rand_int:"; - tc_n (fn i => generate_pos_int i) pick_rand_int_stays_in_interval 1000; - print "Testing on pick_rand_int (again):"; - tc (fn i => ()) pick_rand_int_stays_in_interval_fifty; + tc (fn i => (list_gen(int_gen) i )) list_reverse; + print "Testing on int_gen interval:"; + tc_n (fn i => int_gen(0, inf) i) int_gen_stays_in_interval 1000; print "Testing on abs_value:"; - tc (fn i => (one_of_two generate_int generate_float) i) abs_value_is_always_pos; + tc (fn i => (one_of_two (int_gen(inf, inf)) (float_gen(inf, inf))) i) abs_value_is_always_pos; print "Testing on my_floor:"; - tc (fn i => generate_float i) my_floor_test + tc (fn i => float_gen(inf, inf) i) my_floor_test; + print "Testing that my_count always return non-negative result:"; + tc_n (fn i => (int_gen(inf,inf) i, list_gen(int_gen(inf,inf)) i)) my_count_returns_non_negative_int 1000; + print "Testing my_length:"; + tc (fn i => list_gen (generator_gen) i) my_length_test; + print "Testing make_list:"; + tc (fn i => int_gen(0, inf) i) make_list_test end From eecace17669248272bb9b3d8aaed27981be3e4b5 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 26 Feb 2024 23:40:48 +0100 Subject: [PATCH 016/121] Added convenience functions for the user --- troupecheck/tc.trp | 62 +++++++++++++++++++++++++++++++++------------- 1 file changed, 45 insertions(+), 17 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 8d740cb..90e94c8 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -79,7 +79,7 @@ let | fold f acc i = fold f (acc ^ f()) (i-1) in fold char_gen "" x end - fun one_of_two x y = + fun one_of_two (x, y) = let val bool = bool_gen 0 in if bool then x else y end @@ -126,8 +126,40 @@ let print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") | true => print ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).") end +(* User convenience functions *) + fun integer() = int_gen(inf, inf) + | integer (h, l) = int_gen(h, l) -(* *) + fun pos_integer() = int_gen(0, inf) + + fun neg_integer() = int_gen(inf, 0) + + fun float() = float_gen(inf, inf) + | float(h, l) = float_gen(h, l) + + fun pos_float() = float_gen(0, inf) + + fun neg_float() = float_gen(inf, 0) + + fun boolean() = bool_gen + + fun list() = list_gen(generator_gen) + |list(type) = list_gen(type) + + fun string() = string_gen + + fun char() = char_gen + + fun tuple ts = + case ts of + [] => (fn i => ()) + | (y::ys) => + let fun tuple_aux (f, []) = f + | tuple_aux (f, (x::xs)) = tuple_aux ((fn i => (f i, x i)), xs) + in + tuple_aux ((fn i => y i), ys) end + +(* functions to test with *) fun my_reverse xs = xs @@ -144,17 +176,13 @@ let if y = x then 1 else 0 in z + my_count y xs end -(* A succesful boolean property created for testing purposes - x,y - should be booleans *) +(* Propterties to test*) fun bool_commutative x y = (x andalso y) = (y andalso x) -(* A succesful property for numbers created for testing purposes - x,y - should be numbers. *) fun number_commutative (x, y) = x * y = y * x -(* A succesful property for lists created for testing purposes - xs - should be a list. *) + fun list_reverse xs = reverse(reverse xs) = xs @@ -179,21 +207,21 @@ let in print "Testing on bools commutative:"; - tc (fn i => (bool_gen i, bool_gen i)) (fn(x,y) => bool_commutative x y); + tc (tuple [boolean(), boolean()]) (fn(x,y) => bool_commutative x y); print "Testing on numbers commutative:"; - tc (fn i => (int_gen(inf, inf) i, int_gen(inf, inf) i)) number_commutative; + tc (tuple [integer(), integer()]) number_commutative; print "Testing on list reverse:"; - tc (fn i => (list_gen(int_gen) i )) list_reverse; + tc (list(integer())) list_reverse; print "Testing on int_gen interval:"; - tc_n (fn i => int_gen(0, inf) i) int_gen_stays_in_interval 1000; + tc_n (pos_integer()) int_gen_stays_in_interval 1000; print "Testing on abs_value:"; - tc (fn i => (one_of_two (int_gen(inf, inf)) (float_gen(inf, inf))) i) abs_value_is_always_pos; + tc (one_of_two (integer(), float())) abs_value_is_always_pos; print "Testing on my_floor:"; - tc (fn i => float_gen(inf, inf) i) my_floor_test; + tc (float()) my_floor_test; print "Testing that my_count always return non-negative result:"; - tc_n (fn i => (int_gen(inf,inf) i, list_gen(int_gen(inf,inf)) i)) my_count_returns_non_negative_int 1000; + tc_n (tuple ([integer(), list(integer())])) my_count_returns_non_negative_int 1000; print "Testing my_length:"; - tc (fn i => list_gen (generator_gen) i) my_length_test; + tc (list()) my_length_test; print "Testing make_list:"; - tc (fn i => int_gen(0, inf) i) make_list_test + tc (pos_integer()) make_list_test end From 9ad94450f71b748b37bdbd149ce7e50f70843374 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 27 Feb 2024 10:03:51 +0100 Subject: [PATCH 017/121] fixed printing --- troupecheck/tc.trp | 50 +++++++++++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 21 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 90e94c8..cd98ca0 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,5 +1,13 @@ import lists let +(* ----------------USED FOR PRINTING TO CONSOLE-------------------- *) + val out = getStdout authority + fun write x = fwrite (out, x) + fun tc_toString x = + case x of + (y, ys) => "(" ^ (tc_toString y) ^ ", " ^ (tc_toString ys) ^ ")" + | (y::ys) => "[" ^ (tc_toString y) ^ ", " ^ (tc_toString ys) ^ "]" + | _ => toString x (* -----------------GENERATORS AND UTILS--------------------------*) val inf = 1 / 0 (* Generates a random boolean *) @@ -108,10 +116,10 @@ let fun tc generator prop = let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0) in case succRes of - false => print "Failure at input:"; - print args; - print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") - | true => print "OK: Passed after 100 tests!" + false => write "Failure at input: "; + write (tc_toString args); + write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") + | true => write "OK: Passed after 100 tests!\n" end (* Tests a property function a given number of times. @@ -121,12 +129,12 @@ let fun tc_n generator prop noOfTests = let val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0) in case succRes of - false => print "Failure at input:"; - print args; - print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") - | true => print ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).") + false => write "Failure at input: "; + write args; + write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") + | true => write ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).\n") end -(* User convenience functions *) +(* --------------------------User convenience functions -------------------------*) fun integer() = int_gen(inf, inf) | integer (h, l) = int_gen(h, l) @@ -159,7 +167,7 @@ let in tuple_aux ((fn i => y i), ys) end -(* functions to test with *) +(* --------------------------functions to test on-------------------------------- *) fun my_reverse xs = xs @@ -176,12 +184,12 @@ let if y = x then 1 else 0 in z + my_count y xs end -(* Propterties to test*) +(* --------------------------Propterties to run-------------------------*) fun bool_commutative x y = (x andalso y) = (y andalso x) fun number_commutative (x, y) = - x * y = y * x + x = y fun list_reverse xs = reverse(reverse xs) = xs @@ -206,22 +214,22 @@ let in - print "Testing on bools commutative:"; + write "Testing on bools commutative:\n"; tc (tuple [boolean(), boolean()]) (fn(x,y) => bool_commutative x y); - print "Testing on numbers commutative:"; + write "Testing on numbers commutative:\n"; tc (tuple [integer(), integer()]) number_commutative; - print "Testing on list reverse:"; + write "Testing on list reverse:\n"; tc (list(integer())) list_reverse; - print "Testing on int_gen interval:"; + write "Testing on int_gen interval:\n"; tc_n (pos_integer()) int_gen_stays_in_interval 1000; - print "Testing on abs_value:"; + write "Testing on abs_value:\n"; tc (one_of_two (integer(), float())) abs_value_is_always_pos; - print "Testing on my_floor:"; + write "Testing on my_floor:\n"; tc (float()) my_floor_test; - print "Testing that my_count always return non-negative result:"; + write "Testing that my_count always return non-negative result:\n"; tc_n (tuple ([integer(), list(integer())])) my_count_returns_non_negative_int 1000; - print "Testing my_length:"; + write "Testing my_length:\n"; tc (list()) my_length_test; - print "Testing make_list:"; + write "Testing make_list:\n"; tc (pos_integer()) make_list_test end From cac5eb6041ebed8a275aa22092275bfb72b29464 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 27 Feb 2024 12:20:06 +0100 Subject: [PATCH 018/121] Added simple preconditions --- troupecheck/tc.trp | 71 ++++++++++++++++++++++++++++++---------------- 1 file changed, 46 insertions(+), 25 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index cd98ca0..e8ca4ed 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -102,11 +102,19 @@ let noOfArgs - number of arguments the property function takes. noOfTests - number of tests to be run. generator - the function that should be used to generate input values. *) - fun core_forall (generator, prop, 0, noOfTests) = (true, (), ()) - |core_forall (generator, prop, i, noOfTests) = + fun core_forall (generator, prop, 0, noOfTests, pre) = (true, (), ()) + |core_forall (generator, prop, i, noOfTests, pre) = let val args = generator noOfTests in - if prop args then core_forall (generator, prop, i-1, noOfTests+1) - else (false, args, noOfTests) end + case pre of + () => + if prop args then core_forall (generator, prop, i-1, noOfTests+1, pre) + else (false, args, noOfTests) + | _ => + if (pre args) then + if (prop args) then (write "."; core_forall (generator, prop, i-1, noOfTests+1, pre)) + else (false, args, noOfTests) + else (write "x"; core_forall (generator, prop, i, noOfTests+1, pre)) + end (* Tests a property function - by default 100 times. @@ -114,12 +122,12 @@ let generator - the generator function to generate inputs prop - the property function to test. *) fun tc generator prop = - let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0) in + let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0, ()) in case succRes of - false => write "Failure at input: "; + false => write "\nFailure at input: "; write (tc_toString args); - write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") - | true => write "OK: Passed after 100 tests!\n" + write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)") + | true => write "\nOK: Passed after 100 tests!\n" end (* Tests a property function a given number of times. @@ -127,13 +135,24 @@ let prop - the property function to test. noOfTests - how many tests should be run. *) fun tc_n generator prop noOfTests = - let val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0) in - case succRes of - false => write "Failure at input: "; - write args; - write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") - | true => write ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).\n") - end + let val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0, ()) in + case succRes of + false => write "\nFailure at input: "; + write args; + write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)") + | true => write ("\nSuccess: Passed all " ^ (toString noOfTests) ^ " test(s).\n") + end + + fun tc_pre generator prop pre = + let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0, pre) in + case succRes of + false => write "\nFailure at input: "; + write args; + write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)") + | true => write ("\nSuccess: Passed all 100 test(s).\n") + end + + (* --------------------------User convenience functions -------------------------*) fun integer() = int_gen(inf, inf) | integer (h, l) = int_gen(h, l) @@ -212,24 +231,26 @@ let fun my_count_returns_non_negative_int (x, xs) = (my_count x xs) >= 0 + fun pre_pos x = + x > 3 in - write "Testing on bools commutative:\n"; + write "\nTesting on bools commutative:"; tc (tuple [boolean(), boolean()]) (fn(x,y) => bool_commutative x y); - write "Testing on numbers commutative:\n"; + write "\nTesting on numbers commutative:"; tc (tuple [integer(), integer()]) number_commutative; - write "Testing on list reverse:\n"; + write "\nTesting on list reverse:"; tc (list(integer())) list_reverse; - write "Testing on int_gen interval:\n"; - tc_n (pos_integer()) int_gen_stays_in_interval 1000; - write "Testing on abs_value:\n"; + write "\nTesting on int_gen interval:"; + tc_pre (pos_integer()) int_gen_stays_in_interval pre_pos; + write "\nTesting on abs_value:"; tc (one_of_two (integer(), float())) abs_value_is_always_pos; - write "Testing on my_floor:\n"; + write "\nTesting on my_floor:"; tc (float()) my_floor_test; - write "Testing that my_count always return non-negative result:\n"; + write "\nTesting that my_count always return non-negative result:"; tc_n (tuple ([integer(), list(integer())])) my_count_returns_non_negative_int 1000; - write "Testing my_length:\n"; + write "\nTesting my_length:"; tc (list()) my_length_test; - write "Testing make_list:\n"; + write "\nTesting make_list:"; tc (pos_integer()) make_list_test end From 31904e575eeaa2b7b74e6a8880c4ad603cf88741 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 29 Feb 2024 18:45:59 +0100 Subject: [PATCH 019/121] removed tc_pre - and moved its functionality into tc --- troupecheck/tc.trp | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index e8ca4ed..7d0dc0c 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -95,7 +95,7 @@ let fun abs_value x = if x < 0 then -x else x -(* -----------------CORE FUNCTIONALITY--------------------------*) +(* ----------------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. prop - the property function to test. @@ -121,8 +121,12 @@ let noOfArgs - number of arguemnts the property takes generator - the generator function to generate inputs prop - the property function to test. *) - fun tc generator prop = - let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0, ()) in + fun tc generator p = + let val (prop, pre) = + case p of + (x,y) => (x,y) + | x => (x, ()) + val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0, pre) in case succRes of false => write "\nFailure at input: "; write (tc_toString args); @@ -142,15 +146,6 @@ let write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)") | true => write ("\nSuccess: Passed all " ^ (toString noOfTests) ^ " test(s).\n") end - - fun tc_pre generator prop pre = - let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0, pre) in - case succRes of - false => write "\nFailure at input: "; - write args; - write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)") - | true => write ("\nSuccess: Passed all 100 test(s).\n") - end (* --------------------------User convenience functions -------------------------*) @@ -208,7 +203,7 @@ let (x andalso y) = (y andalso x) fun number_commutative (x, y) = - x = y + x * y = y * x fun list_reverse xs = reverse(reverse xs) = xs @@ -242,7 +237,7 @@ let write "\nTesting on list reverse:"; tc (list(integer())) list_reverse; write "\nTesting on int_gen interval:"; - tc_pre (pos_integer()) int_gen_stays_in_interval pre_pos; + tc (pos_integer()) (int_gen_stays_in_interval, pre_pos); write "\nTesting on abs_value:"; tc (one_of_two (integer(), float())) abs_value_is_always_pos; write "\nTesting on my_floor:"; From 7d7581dc543d84aac6a1389fe5cd7f9ef8cfa542 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 3 Mar 2024 10:42:14 +0100 Subject: [PATCH 020/121] Updated lists lib to export nth function + changed tc console outputs --- .gitignore | 3 +- lib/lists.trp | 1 + lib/out/lists.exports | 3 +- troupecheck/tc.trp | 122 +++++++++++++++++++++++++++--------------- 4 files changed, 85 insertions(+), 44 deletions(-) diff --git a/.gitignore b/.gitignore index 9f0e2a1..0d13f63 100644 --- a/.gitignore +++ b/.gitignore @@ -33,4 +33,5 @@ yarn-error.log bin/troupe bin/understudy trp-rt/out/ -troupecheck/test.trp \ No newline at end of file +troupecheck/test.trp +troupecheck/test.py \ No newline at end of file diff --git a/lib/lists.trp b/lib/lists.trp index 482f875..5725846 100644 --- a/lib/lists.trp +++ b/lib/lists.trp @@ -69,5 +69,6 @@ in , ("length", length) , ("append", append) , ("partition", partition) + , ("nth", nth) ] end diff --git a/lib/out/lists.exports b/lib/out/lists.exports index d0a5830..aa028fe 100644 --- a/lib/out/lists.exports +++ b/lib/out/lists.exports @@ -7,4 +7,5 @@ lookup elem length append -partition \ No newline at end of file +partition +nth \ No newline at end of file diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 7d0dc0c..466c7f3 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -9,7 +9,6 @@ let | (y::ys) => "[" ^ (tc_toString y) ^ ", " ^ (tc_toString ys) ^ "]" | _ => toString x (* -----------------GENERATORS AND UTILS--------------------------*) - val inf = 1 / 0 (* Generates a random boolean *) fun bool_gen size = let val rnd = random() @@ -22,8 +21,8 @@ let size - a non negative integer*) fun float_gen (low, high) size = let val x = random() - val lInf = low = inf - val hInf = high = inf + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 in case (lInf, hInf) of (true, true) => if (bool_gen size) then x*size else -x*size @@ -56,17 +55,13 @@ let (* Generates a random generator *) fun generator_gen size = let val rnd = random() + val inf = 1/0 val res = if rnd <= 1/4 then (fn i => int_gen(inf, inf) i) else if rnd <= 2/4 then (fn i => bool_gen i) else if rnd <= 3/4 then (fn i => float_gen(inf, inf) i) else (fn i => list_gen (int_gen(inf, inf)) i) in res end - -(* Copied from list lib, becuase it doesn't seem to be imported with the library?*) - fun nth (x::l) 1 = x - | nth (x::l) n = nth l (n - 1) - (* Generates a random character - no spaces or sepcial characters, only letters (upper and lower case) and numbers. *) fun char_gen size = @@ -107,8 +102,8 @@ let let val args = generator noOfTests in case pre of () => - if prop args then core_forall (generator, prop, i-1, noOfTests+1, pre) - else (false, args, noOfTests) + if prop args then (write "."; core_forall (generator, prop, i-1, noOfTests+1, pre)) + else (write "!"; (false, args, noOfTests) ) | _ => if (pre args) then if (prop args) then (write "."; core_forall (generator, prop, i-1, noOfTests+1, pre)) @@ -128,27 +123,32 @@ let | x => (x, ()) val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0, pre) in case succRes of - false => write "\nFailure at input: "; - write (tc_toString args); - write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)") - | true => write "\nOK: Passed after 100 tests!\n" + false => write "\nFailure at input: "; + print (args); + write ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") + | true => write "\nOK: Passed after 100 tests!\n" end (* Tests a property function a given number of times. generator - the generator function to generate inputs prop - the property function to test. noOfTests - how many tests should be run. *) - fun tc_n generator prop noOfTests = - let val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0, ()) in - case succRes of + fun tc_n generator p noOfTests = + let val (prop, pre) = + case p of + (x,y) => (x,y) + | x => (x, ()) + val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0, pre) in + case succRes of false => write "\nFailure at input: "; - write args; - write ("\nAfter running: " ^ (toString (successfulTests+1)) ^ " test(s)") + print args; + write ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") | true => write ("\nSuccess: Passed all " ^ (toString noOfTests) ^ " test(s).\n") - end + end (* --------------------------User convenience functions -------------------------*) + val inf = 1 / 0 fun integer() = int_gen(inf, inf) | integer (h, l) = int_gen(h, l) @@ -227,25 +227,63 @@ let (my_count x xs) >= 0 fun pre_pos x = - x > 3 - in - - write "\nTesting on bools commutative:"; - tc (tuple [boolean(), boolean()]) (fn(x,y) => bool_commutative x y); - write "\nTesting on numbers commutative:"; - tc (tuple [integer(), integer()]) number_commutative; - write "\nTesting on list reverse:"; - tc (list(integer())) list_reverse; - write "\nTesting on int_gen interval:"; - tc (pos_integer()) (int_gen_stays_in_interval, pre_pos); - write "\nTesting on abs_value:"; - tc (one_of_two (integer(), float())) abs_value_is_always_pos; - write "\nTesting on my_floor:"; - tc (float()) my_floor_test; - write "\nTesting that my_count always return non-negative result:"; - tc_n (tuple ([integer(), list(integer())])) my_count_returns_non_negative_int 1000; - write "\nTesting my_length:"; - tc (list()) my_length_test; - write "\nTesting make_list:"; - tc (pos_integer()) make_list_test - end + x >= 0 +(* ----------------------------For the userguide------------------------------- *) + fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + + fun ordered [] = true + | ordered (x::[]) = true + | ordered (x::y::ys) = + if x <= y then ordered (y::ys) else false + + fun my_sort_is_ordered xs = + ordered (my_quicksort xs) + + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + + fun pre_list_size_greater_than_one xs = + if (length xs) <= 1 then false else true + + fun no_duplicates[] = true + | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs + + fun append_length_increase (xs, x) = + (length (append xs [x])) = ((length xs) + 1) + +in +(* tc (tuple[list(integer()), integer()]) (append_length_increase) + *) +tc (list(integer())) my_sort_is_ordered +(* write "\nTesting on bools commutative:"; +tc (tuple [boolean(), boolean()]) (fn(x,y) => bool_commutative x y); +write "\nTesting on numbers commutative:";¢¢ +tc (tuple [integer(), integer()]) number_commutative; +write "\nTesting on list reverse:"; +tc (list(integer())) list_reverse; +write "\nTesting on int_gen interval:"; +tc (integer()) (int_gen_stays_in_interval, pre_pos); +write "\nTesting on abs_value:"; +tc (one_of_two (integer(), float())) abs_value_is_always_pos; +write "\nTesting on my_floor:"; +tc (float()) my_floor_test; +write "\nTesting that my_count always return non-negative result:"; +tc_n (tuple ([integer(), list(integer())])) my_count_returns_non_negative_int 1000; +write "\nTesting my_length:"; +tc (list()) my_length_test; +write "\nTesting make_list:"; +tc (pos_integer()) make_list_test *) +end From 35bff01434768e901fcc91ebc3cd45f82c983a68 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 11 Mar 2024 08:58:20 +0100 Subject: [PATCH 021/121] implemented record generator - changed use of tuples to use of records, and started simple error handling --- troupecheck/tc.trp | 85 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 60 insertions(+), 25 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 466c7f3..2e67c01 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -90,44 +90,61 @@ let fun abs_value x = if x < 0 then -x else x +(* -------------------------------Error Handling-------------------------------- *) +(* +arity_limit -> +Error: Couldn't produce a function of the desired arity, please + recompile PropEr with an increased value for ?MAX_ARITY. +cant_satisfy -> + Error: No valid test could be generated. + *) + fun report_error error_reason = + case error_reason of + ("cant_generate", tries) => write "\nError: Couldn't produce an instance that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => write "\nError: The property code returned a non-boolean result.\n" + | ("rejected", _) => write "\nError: The input doesn't correspond to this property: It failed to match precondition check.\n" + | ("too_many_instances", _) => write "\nError: The input doesn't correspond to this property: It's too long.\n" + | ("type_mismatch", _) => write "\nError: The variables' and types' structures don't match.\n" + | ("record_mismatch", _) => write "\nError: the number of names provided for record generation, does not match the number of types provided.\n"; + exit (authority, 0) + (* ----------------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. prop - the property function to test. - noOfArgs - number of arguments the property function takes. noOfTests - number of tests to be run. generator - the function that should be used to generate input values. *) - fun core_forall (generator, prop, 0, noOfTests, pre) = (true, (), ()) + fun core_forall (generator, prop, 0, noOfTests, pre) = {success = true, cEx = (), remTests = ()} |core_forall (generator, prop, i, noOfTests, pre) = let val args = generator noOfTests in case pre of () => if prop args then (write "."; core_forall (generator, prop, i-1, noOfTests+1, pre)) - else (write "!"; (false, args, noOfTests) ) + else (write "!"; {success = false, cEx = args, remTests = i}) | _ => if (pre args) then if (prop args) then (write "."; core_forall (generator, prop, i-1, noOfTests+1, pre)) - else (false, args, noOfTests) + else {success = false, cEx = args, remTests = i} else (write "x"; core_forall (generator, prop, i, noOfTests+1, pre)) end -(* Tests a property function - by default 100 times. - noOfArgs - number of arguemnts the property takes +(* Tests a property function - by default 100 times. generator - the generator function to generate inputs - prop - the property function to test. *) + p - the property function to test. *) fun tc generator p = let val (prop, pre) = case p of (x,y) => (x,y) | x => (x, ()) - val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0, pre) in - case succRes of + val res = core_forall (generator, prop, 100, 0, pre) in + case res.success of false => write "\nFailure at input: "; - print (args); - write ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") + print (res.cEx); + write ("After running: " ^ (toString (100 - res.remTests + 1)) ^ " test(s)\n") | true => write "\nOK: Passed after 100 tests!\n" - end + end (* Tests a property function a given number of times. generator - the generator function to generate inputs @@ -138,15 +155,14 @@ let case p of (x,y) => (x,y) | x => (x, ()) - val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0, pre) in - case succRes of + val res = core_forall (generator, prop, noOfTests, 0, pre) in + case res.success of false => write "\nFailure at input: "; - print args; - write ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)\n") + print (res.cEx); + write ("After running: " ^ (toString (noOfTests - res.remTests + 1)) ^ " test(s)\n") | true => write ("\nSuccess: Passed all " ^ (toString noOfTests) ^ " test(s).\n") end - (* --------------------------User convenience functions -------------------------*) val inf = 1 / 0 fun integer() = int_gen(inf, inf) @@ -179,7 +195,20 @@ let let fun tuple_aux (f, []) = f | tuple_aux (f, (x::xs)) = tuple_aux ((fn i => (f i, x i)), xs) in - tuple_aux ((fn i => y i), ys) end + (tuple_aux ((fn i => y i), ys)) end + + fun record ns ts = + let val noOfElems = length ts + in if (length ns) <> noOfElems then + report_error ("record_mismatch", 0) + else + case (ns, ts) of + ([],[]) => (fn i => {}) + | ((y::ys), (v::vs)) => + let fun record_aux (f, [], []) = f + | record_aux (f, (x::xs), (z::zs)) = record_aux ((fn i => {(f i) with x = (z i)}), xs, zs) + in + (record_aux ((fn i => {y = (v i)}), ys, vs)) end end (* --------------------------functions to test on-------------------------------- *) fun my_reverse xs = @@ -226,6 +255,9 @@ let fun my_count_returns_non_negative_int (x, xs) = (my_count x xs) >= 0 + fun rec_test (rec, i) = + {x = rec.x, y = rec.y, z = i} = {rec with z = i} + fun pre_pos x = x >= 0 (* ----------------------------For the userguide------------------------------- *) @@ -261,16 +293,19 @@ let fun no_duplicates[] = true | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs - fun append_length_increase (xs, x) = - (length (append xs [x])) = ((length xs) + 1) + fun cons_length_increase (xs, x) = + (length (x::xs)) = ((length xs) + 1) in -(* tc (tuple[list(integer()), integer()]) (append_length_increase) - *) -tc (list(integer())) my_sort_is_ordered -(* write "\nTesting on bools commutative:"; + +tc (tuple[(record ["y"][integer(), string()]), integer()]) rec_test +(* tc (tuple[list(integer()), integer()]) cons_length_increase; +tc (list(integer())) my_sort_is_ordered; +tc (list(integer())) my_sort_keep_length; +tc (list(integer())) (my_sort_keep_length, no_duplicates); +write "\nTesting on bools commutative:"; tc (tuple [boolean(), boolean()]) (fn(x,y) => bool_commutative x y); -write "\nTesting on numbers commutative:";¢¢ +write "\nTesting on numbers commutative:"; tc (tuple [integer(), integer()]) number_commutative; write "\nTesting on list reverse:"; tc (list(integer())) list_reverse; From bc8ff893ed3b83398da81a1f426044520756c56f Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 11 Mar 2024 12:04:17 +0100 Subject: [PATCH 022/121] Error messages printed in red color + records updated to function correcty using "recordExtend" function --- troupecheck/tc.trp | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 2e67c01..fd70c25 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -99,14 +99,16 @@ cant_satisfy -> Error: No valid test could be generated. *) fun report_error error_reason = + write "\u001B[31m \nError: "; (* Changing the print color to red *) case error_reason of - ("cant_generate", tries) => write "\nError: Couldn't produce an instance that satisfies all strict constraints after " + ("cant_generate", tries) => write "Couldn't produce an instance that satisfies all strict constraints after " ^ (toString tries) ^ " tries.\n" - | ("non_boolean_result", _) => write "\nError: The property code returned a non-boolean result.\n" - | ("rejected", _) => write "\nError: The input doesn't correspond to this property: It failed to match precondition check.\n" - | ("too_many_instances", _) => write "\nError: The input doesn't correspond to this property: It's too long.\n" - | ("type_mismatch", _) => write "\nError: The variables' and types' structures don't match.\n" - | ("record_mismatch", _) => write "\nError: the number of names provided for record generation, does not match the number of types provided.\n"; + | ("non_boolean_result", _) => write "The property code returned a non-boolean result.\n" + | ("rejected", _) => write "The input doesn't correspond to this property: It failed to match precondition check.\n" + | ("too_many_instances", _) => write "The input doesn't correspond to this property: It's too long.\n" + | ("type_mismatch", _) => write "The variables' and types' structures don't match.\n" + | ("record_mismatch", _) => write "the number of names provided for record generation, does not match the number of types provided.\n"; + write "\u001B[0m"; (* Changing the color back *) exit (authority, 0) (* ----------------------CORE FUNCTIONALITY--------------------------*) @@ -206,9 +208,9 @@ cant_satisfy -> ([],[]) => (fn i => {}) | ((y::ys), (v::vs)) => let fun record_aux (f, [], []) = f - | record_aux (f, (x::xs), (z::zs)) = record_aux ((fn i => {(f i) with x = (z i)}), xs, zs) + | record_aux (f, (x::xs), (z::zs)) = record_aux ((fn i => recordExtend((f i), x, (z i))), xs, zs) in - (record_aux ((fn i => {y = (v i)}), ys, vs)) end end + (record_aux ((fn i => recordExtend({}, y, (v i))), ys, vs)) end end (* --------------------------functions to test on-------------------------------- *) fun my_reverse xs = @@ -256,7 +258,7 @@ cant_satisfy -> (my_count x xs) >= 0 fun rec_test (rec, i) = - {x = rec.x, y = rec.y, z = i} = {rec with z = i} + {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} fun pre_pos x = x >= 0 @@ -297,8 +299,7 @@ cant_satisfy -> (length (x::xs)) = ((length xs) + 1) in - -tc (tuple[(record ["y"][integer(), string()]), integer()]) rec_test +tc (tuple[(record ["theInteger", "theString"][integer(), string()]), integer()]) rec_test (* tc (tuple[list(integer()), integer()]) cons_length_increase; tc (list(integer())) my_sort_is_ordered; tc (list(integer())) my_sort_keep_length; From 5d9870333e7d389811bec38ae371569d0f764d01 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 12 Mar 2024 14:09:48 +0100 Subject: [PATCH 023/121] Added error handling for non boolean prop or precond functions --- troupecheck/tc-Selma.trp | 224 --------------------------------------- troupecheck/tc.trp | 107 +++++++++++++------ 2 files changed, 72 insertions(+), 259 deletions(-) delete mode 100644 troupecheck/tc-Selma.trp diff --git a/troupecheck/tc-Selma.trp b/troupecheck/tc-Selma.trp deleted file mode 100644 index 862aaa7..0000000 --- a/troupecheck/tc-Selma.trp +++ /dev/null @@ -1,224 +0,0 @@ -import lists - -let -(* -----------------GENERATORS AND UTILS--------------------------*) -(* Generates a random boolean *) - fun generate_bool () = - let val rnd = random()*10 - val res = if rnd < 5 then false - else true in - res end - -(* Generates a random float based on number of tests that has been run so far. - noOfTests - a non negative integer to determin the size*) - fun generate_float noOfTests = - let val x = random()*noOfTests - val is_pos = generate_bool() in - if is_pos then x else (-x) end - -(* Generates a random integer based on number of tests that has been run so far. - noOfTests - a non negative integer to determin the size*) - fun generate_int noOfTests = - floor (generate_float(noOfTests)) - -(* Generates a random positive integer based on number of tests that has been run so far. - noOfTests - a non negative integer to determin the size*) - fun pick_rand_int (i) = - let val seed = generate_int i in - if seed < 0 then (-seed) mod (i+1) else - seed mod (i+1) end -(* Create a list of some determined size. - f - the function determining what to element to put into the list. - i - the number of elements to be added to the list. *) - fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) - -(* Generates a randomly sized list of some specified type of elements. - generator - the generator that should be used to create elements. - noOfTests - some non negative integer *) - and generate_list_of (generator) noOfTests = - let val size = pick_rand_int(noOfTests) in - make_list ((fn () => generator noOfTests), size) end - -(* Generates a random generator *) - fun generate_generator () = - let val rnd = random() - val res = if rnd <= 1/3 then (fn i => generate_int i) else - if rnd <= 2/3 then (fn i => generate_bool()) else - (fn i => generate_list_of (generate_int) i) in - res end - -(* Generates a randomly sized list of a randomly chosen type of elements - noOfTests - some non negative integer *) - and generate_list noOfTests = - let val generator = generate_generator() in - generate_list_of (generator) noOfTests end - -(* Copied from list lib, becuase it doesn't seem to be imported with the library?*) - fun nth (x::l) 1 = x - | nth (x::l) n = nth l (n - 1) - -(* Generates a random character - no spaces or sepcial characters, - only letters (upper and lower case) and numbers. *) - fun generate_char () = - let val chars = - ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", - "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", - "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = pick_rand_int (length chars-1) +1 in - print x; - nth chars x end - -(* Generates a random string, with length ranging from 0 to noOfTest, - only letters (upper and lower case) and numbers. *) - fun generate_string noOfTests = - let val x = pick_rand_int noOfTests - fun fold f acc 0 = acc - | fold f acc i = fold f (acc ^ f()) (i-1) in - fold generate_char "" x end - - fun one_of_two x y = - let val bool = generate_bool () in - if bool then x - else y end - - fun abs_value x = - if x < 0 then -x else x - - fun generate_pos_int noOfTests = - abs_value(generate_int noOfTests) - - fun sign x = - if x = 0 then 0 - else if x > 0 then 1 - else -1 -(* -----------------CORE FUNCTIONALITY--------------------------*) -(* Runs however many tests specified on a property, while always generating new inputs. - Drops further execution if a Failure is found. - prop - the property function to test. - noOfArgs - number of arguments the property function takes. - noOfTests - number of tests to be run. - generator - the function that should be used to generate input values. *) - fun core_forall (generator, prop, 0, noOfTests) = (true, (), ()) - |core_forall (generator, prop, i, noOfTests) = - let val args = generator noOfTests in - if prop args then core_forall (generator, prop, i-1, noOfTests+1) - else (false, args, noOfTests) end - - -(* Tests a property function - by default 100 times. - noOfArgs - number of arguemnts the property takes - generator - the generator function to generate inputs - prop - the property function to test. *) - fun tc generator prop = - let val (succRes, args, successfulTests) = core_forall (generator, prop, 100, 0) in - case succRes of - false => print "Failure at input:"; - print args; - print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") - | true => print "OK: Passed after 100 tests!" - end - -(* Tests a property function a given number of times. - generator - the generator function to generate inputs - prop - the property function to test. - noOfTests - how many tests should be run. *) - fun tc_n generator prop noOfTests = - let val (succRes, args, successfulTests) = core_forall (generator, prop, noOfTests, 0) in - case succRes of - false => print "Failure at input:"; - print args; - print ("After running: " ^ (toString (successfulTests+1)) ^ " test(s)") - | true => print ("Success: Passed all " ^ (toString noOfTests) ^ " test(s).") - end - -(* *) - fun my_reverse xs = - xs - - fun my_floor i = - if i >=0 then i - (i mod 1) - else i - (i mod 1) - 1 - - fun my_ceil_1 i = - if i > 0 then i + (1 - (i mod 1)) - else i + (1 - (i mod 1)) - 1 - - fun my_ceil_2 i = - if i > 0 then (my_floor i) + 1 - else if i = 0 then 0 - else (my_floor i) + 1 - - (*Virker ikke for negative tal (endnu)*) - fun my_mod x y = - if y = 0 then 0 - else x - (my_floor(x/y) * y) - -(* A succesful boolean property created for testing purposes - x,y - should be booleans *) - fun bool_commutative x y = - (x andalso y) = (y andalso x) - -(* A succesful property for numbers created for testing purposes - x,y - should be numbers. *) - fun number_commutative (x, y) = - x * y = y * x -(* A succesful property for lists created for testing purposes - xs - should be a list. *) - fun list_reverse xs = - reverse(reverse xs) = xs - - fun pick_rand_int_stays_in_interval i = - pick_rand_int i <= i - - fun abs_value_is_always_pos i = - abs_value i >= 0 - - fun pick_rand_int_stays_in_interval_fifty() = - pick_rand_int 50 <= 50 - - fun my_floor_test i = - my_floor i = floor i - - fun my_ceil_1_test i = - my_ceil_1 i = ceil i - - fun my_ceil_2_test i = - my_ceil_2 i = ceil i - - fun both_ceil_test i = - my_ceil_1 i = my_ceil_1 i - - fun my_mod_test (x, y) = - if y = 0 then true - else my_mod x y = (x mod y) - - in - - print "Testing on bools commutative:"; - tc (fn i => (generate_bool (), generate_bool ())) (fn(x,y) => bool_commutative x y); - print "Testing on numbers commutative:"; - tc (fn i => (generate_int i, generate_int i)) number_commutative; - print "Testing on list reverse:"; - tc (fn i => (generate_list i )) list_reverse; - print "Testing on pick_rand_int:"; - tc_n (fn i => generate_pos_int i) pick_rand_int_stays_in_interval 1000; - print "Testing on pick_rand_int (again):"; - tc (fn i => ()) pick_rand_int_stays_in_interval_fifty; - print "Testing on abs_value:"; - tc (fn i => (one_of_two generate_int generate_float) i) abs_value_is_always_pos; - print "Testing on my_floor:"; - tc (fn i => generate_float i) my_floor_test; - print "Testing on my_ceil_1:"; - tc (fn i => generate_float i) my_ceil_1_test; - print "Testing on my_ceil_2:"; - tc (fn i => generate_float i) my_ceil_2_test; - print "Testing on both ceil functions:"; - tc (fn i => generate_float i) both_ceil_test; - print "Testing on my_mod:"; - tc (fn i => (generate_int i, generate_int i)) my_mod_test - end diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index fd70c25..8f5f7d9 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -100,58 +100,62 @@ cant_satisfy -> *) fun report_error error_reason = write "\u001B[31m \nError: "; (* Changing the print color to red *) - case error_reason of - ("cant_generate", tries) => write "Couldn't produce an instance that satisfies all strict constraints after " + let val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " ^ (toString tries) ^ " tries.\n" - | ("non_boolean_result", _) => write "The property code returned a non-boolean result.\n" - | ("rejected", _) => write "The input doesn't correspond to this property: It failed to match precondition check.\n" - | ("too_many_instances", _) => write "The input doesn't correspond to this property: It's too long.\n" - | ("type_mismatch", _) => write "The variables' and types' structures don't match.\n" - | ("record_mismatch", _) => write "the number of names provided for record generation, does not match the number of types provided.\n"; - write "\u001B[0m"; (* Changing the color back *) - exit (authority, 0) - + | ("cant_satisfy", _) => "No valid test could be generated.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("rejected", _) => "The input doesn't correspond to this property: It failed to match precondition check.\n" + | ("too_many_instances", _) => "The input doesn't correspond to this property: It's too long.\n" + | ("type_mismatch", _) => "The variables' and types' structures don't match.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + in + write (err_string ^ "\u001B[0m"); (* Changing the color back *) + exit (authority, 0) end + +(* Checks that a function returns a boolean - reports an error if not. *) + fun bool_function_check gen p = + let val b = p (gen 1) in + case b of + true => p + |false => p + | _ => report_error ("non_boolean_result", 0) end (* ----------------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. - Drops further execution if a Failure is found. - prop - the property function to test. - noOfTests - number of tests to be run. - generator - the function that should be used to generate input values. *) - fun core_forall (generator, prop, 0, noOfTests, pre) = {success = true, cEx = (), remTests = ()} - |core_forall (generator, prop, i, noOfTests, pre) = - let val args = generator noOfTests in + Drops further execution if a Failure is found. *) + fun core_forall (generator, prop, 0, size, pre) = {success = true, cEx = (), remTests = 0} + |core_forall (generator, prop, i, size, pre) = + let val args = generator size + val triesCap = i*5 in case pre of () => - if prop args then (write "."; core_forall (generator, prop, i-1, noOfTests+1, pre)) + if prop args then (write "."; core_forall (generator, prop, i-1, size+1, pre)) else (write "!"; {success = false, cEx = args, remTests = i}) | _ => if (pre args) then - if (prop args) then (write "."; core_forall (generator, prop, i-1, noOfTests+1, pre)) + if (prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre)) else {success = false, cEx = args, remTests = i} - else (write "x"; core_forall (generator, prop, i, noOfTests+1, pre)) + else + (write "x"; core_forall (generator, prop, i, size+1, pre)) end -(* Tests a property function - by default 100 times. - generator - the generator function to generate inputs - p - the property function to test. *) +(* Tests a property function 100 times. *) fun tc generator p = - let val (prop, pre) = - case p of - (x,y) => (x,y) - | x => (x, ()) + let val return_bool_check = bool_function_check generator + val (prop, pre) = + case p of + (x,y) => ((return_bool_check x),(return_bool_check y)) (* Maybe need to do check in core for all for each run - see no_duplicates *) + | x => ((return_bool_check x), ()) val res = core_forall (generator, prop, 100, 0, pre) in case res.success of false => write "\nFailure at input: "; print (res.cEx); write ("After running: " ^ (toString (100 - res.remTests + 1)) ^ " test(s)\n") - | true => write "\nOK: Passed after 100 tests!\n" + | true => write ("\nOK: Passed after " ^ (toString (100 - res.remTests)) ^ " test(s)!\n") end -(* Tests a property function a given number of times. - generator - the generator function to generate inputs - prop - the property function to test. - noOfTests - how many tests should be run. *) +(* Tests a property function a given number of times. *) fun tc_n generator p noOfTests = let val (prop, pre) = case p of @@ -228,7 +232,20 @@ cant_satisfy -> let val z = if y = x then 1 else 0 in - z + my_count y xs end + z + my_count y xs end + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_ceil_1 i = + if i > 0 then i + (1 - (i mod 1)) + else i + (1 - (i mod 1)) - 1 + + fun my_ceil_2 i = + if i > 0 then (my_floor i) + 1 + else if i = 0 then 0 + else (my_floor i) + 1 (* --------------------------Propterties to run-------------------------*) fun bool_commutative x y = (x andalso y) = (y andalso x) @@ -262,6 +279,18 @@ cant_satisfy -> fun pre_pos x = x >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_ceil_1_test i = + my_ceil_1 i = ceil i + + fun my_ceil_2_test i = + my_ceil_2 i = ceil i + + fun both_ceil_test i = + my_ceil_1 i = my_ceil_2 i (* ----------------------------For the userguide------------------------------- *) fun filter_less ([], _) = [] | filter_less ((x::xs), p) = @@ -299,7 +328,9 @@ cant_satisfy -> (length (x::xs)) = ((length xs) + 1) in -tc (tuple[(record ["theInteger", "theString"][integer(), string()]), integer()]) rec_test + +tc (list(integer())) (my_sort_keep_length, no_duplicates) +(* tc (tuple[(record ["theInteger", "theString"][integer(), string()]), integer()]) rec_test *) (* tc (tuple[list(integer()), integer()]) cons_length_increase; tc (list(integer())) my_sort_is_ordered; tc (list(integer())) my_sort_keep_length; @@ -321,5 +352,11 @@ tc_n (tuple ([integer(), list(integer())])) my_count_returns_non_negative_int 10 write "\nTesting my_length:"; tc (list()) my_length_test; write "\nTesting make_list:"; -tc (pos_integer()) make_list_test *) +tc (pos_integer()) make_list_test; +print "Testing on my_ceil_1:"; +tc (fn i => generate_float i) my_ceil_1_test; +print "Testing on my_ceil_2:"; +tc (fn i => generate_float i) my_ceil_2_test; +print "Testing on both ceil functions:"; +tc (fn i => generate_float i) both_ceil_test *) end From 02fd0f752a18eaee3bf66cc21c7104cd7c2565dd Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 12 Mar 2024 22:41:01 +0100 Subject: [PATCH 024/121] Cleaned up the code a bit (tc now just calls tc_n with 100 hardcoded) + added errorhandling for unsatisfiable precond + changed console printing look --- troupecheck/tc.trp | 80 ++++++++++++++++++++++++---------------------- 1 file changed, 41 insertions(+), 39 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 8f5f7d9..e9525c7 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -95,19 +95,16 @@ let arity_limit -> Error: Couldn't produce a function of the desired arity, please recompile PropEr with an increased value for ?MAX_ARITY. -cant_satisfy -> - Error: No valid test could be generated. *) fun report_error error_reason = write "\u001B[31m \nError: "; (* Changing the print color to red *) let val err_string = case error_reason of ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " ^ (toString tries) ^ " tries.\n" - | ("cant_satisfy", _) => "No valid test could be generated.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" - | ("rejected", _) => "The input doesn't correspond to this property: It failed to match precondition check.\n" - | ("too_many_instances", _) => "The input doesn't correspond to this property: It's too long.\n" - | ("type_mismatch", _) => "The variables' and types' structures don't match.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" in write (err_string ^ "\u001B[0m"); (* Changing the color back *) @@ -120,54 +117,60 @@ cant_satisfy -> true => p |false => p | _ => report_error ("non_boolean_result", 0) end + + fun generator_check gen = + case gen of + (x) => print "test1" + | _ => print "test3" (* ----------------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. *) - fun core_forall (generator, prop, 0, size, pre) = {success = true, cEx = (), remTests = 0} - |core_forall (generator, prop, i, size, pre) = - let val args = generator size - val triesCap = i*5 in + fun core_forall (generator, prop, 0, size, pre, cap) = {success = true, cEx = (), remTests = 0} + |core_forall (generator, prop, i, size, pre, cap) = + let val args = generator size in case pre of () => - if prop args then (write "."; core_forall (generator, prop, i-1, size+1, pre)) + if prop args then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) else (write "!"; {success = false, cEx = args, remTests = i}) | _ => if (pre args) then - if (prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre)) + if (prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) else {success = false, cEx = args, remTests = i} else - (write "x"; core_forall (generator, prop, i, size+1, pre)) + (write "x"; + if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) + else if size = cap then {success = true, cEx = (), remTests = i} + else core_forall (generator, prop, i, size+1, pre, cap)) end - -(* Tests a property function 100 times. *) - fun tc generator p = + (* Tests a property function a given number of times. *) + fun tc_n generator p noOfTests = let val return_bool_check = bool_function_check generator val (prop, pre) = case p of (x,y) => ((return_bool_check x),(return_bool_check y)) (* Maybe need to do check in core for all for each run - see no_duplicates *) | x => ((return_bool_check x), ()) - val res = core_forall (generator, prop, 100, 0, pre) in + val res = core_forall (generator, prop, noOfTests, 0, pre, (noOfTests*5)) in case res.success of false => write "\nFailure at input: "; - print (res.cEx); - write ("After running: " ^ (toString (100 - res.remTests + 1)) ^ " test(s)\n") - | true => write ("\nOK: Passed after " ^ (toString (100 - res.remTests)) ^ " test(s)!\n") + print (res.cEx); + write ("After running: " ^ (toString (noOfTests - res.remTests + 1)) ^ " test(s)\n") + | true => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n") end - -(* Tests a property function a given number of times. *) - fun tc_n generator p noOfTests = - let val (prop, pre) = - case p of - (x,y) => (x,y) - | x => (x, ()) - val res = core_forall (generator, prop, noOfTests, 0, pre) in +(* Tests a property function 100 times. *) + fun tc generator p = tc_n generator p 100 + (* let val return_bool_check = bool_function_check generator + val (prop, pre) = + case p of + (x,y) => ((return_bool_check x),(return_bool_check y)) (* Maybe need to do check in core for all for each run - see no_duplicates *) + | x => ((return_bool_check x), ()) + val res = core_forall (generator, prop, 100, 0, pre, (100*5)) in case res.success of false => write "\nFailure at input: "; - print (res.cEx); - write ("After running: " ^ (toString (noOfTests - res.remTests + 1)) ^ " test(s)\n") - | true => write ("\nSuccess: Passed all " ^ (toString noOfTests) ^ " test(s).\n") - end + print (res.cEx); + write ("After running: " ^ (toString (100 - res.remTests + 1)) ^ " test(s)\n") + | true => write ("\nOK: Passed after " ^ (toString (100 - res.remTests)) ^ " test(s)!\n") + end *) (* --------------------------User convenience functions -------------------------*) val inf = 1 / 0 @@ -176,7 +179,7 @@ cant_satisfy -> fun pos_integer() = int_gen(0, inf) - fun neg_integer() = int_gen(inf, 0) + fun neg_integer() = int_gen(inf, -1) fun float() = float_gen(inf, inf) | float(h, l) = float_gen(h, l) @@ -329,9 +332,8 @@ cant_satisfy -> in -tc (list(integer())) (my_sort_keep_length, no_duplicates) -(* tc (tuple[(record ["theInteger", "theString"][integer(), string()]), integer()]) rec_test *) -(* tc (tuple[list(integer()), integer()]) cons_length_increase; +tc (tuple[(record ["theInteger", "theString"][integer(), string()]), integer()]) rec_test; +tc (tuple[list(integer()), integer()]) cons_length_increase; tc (list(integer())) my_sort_is_ordered; tc (list(integer())) my_sort_keep_length; tc (list(integer())) (my_sort_keep_length, no_duplicates); @@ -354,9 +356,9 @@ tc (list()) my_length_test; write "\nTesting make_list:"; tc (pos_integer()) make_list_test; print "Testing on my_ceil_1:"; -tc (fn i => generate_float i) my_ceil_1_test; +tc (fn i => float() i) my_ceil_1_test; print "Testing on my_ceil_2:"; -tc (fn i => generate_float i) my_ceil_2_test; +tc (fn i => float() i) my_ceil_2_test; print "Testing on both ceil functions:"; -tc (fn i => generate_float i) both_ceil_test *) +tc (fn i => float() i) both_ceil_test end From dc0879ea257bcfa16a878ea8d70d53b92614d477 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 15 Mar 2024 11:37:01 +0100 Subject: [PATCH 025/121] tc and tc_n now takes a list of generators instead of a single generatort (tuple function does not work as expected) --- troupecheck/tc.trp | 230 ++++++++++++++++++++++++--------------------- 1 file changed, 122 insertions(+), 108 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index e9525c7..53debab 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -8,6 +8,42 @@ let (y, ys) => "(" ^ (tc_toString y) ^ ", " ^ (tc_toString ys) ^ ")" | (y::ys) => "[" ^ (tc_toString y) ^ ", " ^ (tc_toString ys) ^ "]" | _ => toString x +(* -------------------------------Error Handling-------------------------------- *) +(* +arity_limit -> +Error: Couldn't produce a function of the desired arity, please + recompile PropEr with an increased value for ?MAX_ARITY. + *) + fun report_error error_reason = + write "\u001B[31m \nError: "; (* Changing the print color to red *) + let val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an insta ^nce that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + in + write (err_string ^ "\u001B[0m"); (* Changing the color back *) + exit (authority, 0) end + +(* Checks that a function returns a boolean - reports an error if not. *) + fun bool_function_check gen p = + let val b = p (gen 1) in + case b of + true => p + |false => p + | _ => report_error ("non_boolean_result", 0) end + + fun tuple_size_count (x, xs) acc = print("tesgs"); tuple_size_count xs (acc+1) + | tuple_size_count(_) = acc+1 + | tuple_size_count () acc = acc + + fun generator_check gen = + case gen of + (x, xs) => report_error ("illegal_gen_def", 0) + | _ => () (* -----------------GENERATORS AND UTILS--------------------------*) (* Generates a random boolean *) fun bool_gen size = @@ -16,9 +52,7 @@ let else true in res end -(* Generates a random float based on number of tests that has been run so far. - (low, high) - a tuple of values specifying the interval numbers should be generated between - size - a non negative integer*) +(* Generates a random float based on number of tests that has been run so far. *) fun float_gen (low, high) size = let val x = random() val lInf = low = 1/0 (* check for inf *) @@ -31,37 +65,21 @@ let | (false, false) => low + (x * (high-low)) end -(* Generates a random integer based on number of tests that has been run so far. - (low, high) - a tuple of values specifying the interval numbers should be generated between - size - a non negative integer*) +(* Generates a random integer based on number of tests that has been run so far. *) fun int_gen (low, high) size = floor (float_gen(low, high) size) -(* Create a list of some determined size. - f - the function determining what to element to put into the list. - i - the number of elements to be added to the list. *) +(* Create a list of some determined size. *) fun make_list (f, i) = case i of 0 => [] | _ => append [f()] (make_list (f, i-1)) -(* Generates a randomly sized list of some specified type of elements. - generator - the generator that should be used to create elements. - noOfTests - some non negative integer *) +(* Generates a randomly sized list of some specified type of elements. *) and list_gen (generator) size = let val length = (int_gen(0, size) size) in make_list ((fn () => generator size), length) end -(* Generates a random generator *) - fun generator_gen size = - let val rnd = random() - val inf = 1/0 - val res = if rnd <= 1/4 then (fn i => int_gen(inf, inf) i) else - if rnd <= 2/4 then (fn i => bool_gen i) else - if rnd <= 3/4 then (fn i => float_gen(inf, inf) i) else - (fn i => list_gen (int_gen(inf, inf)) i) in - res end - (* Generates a random character - no spaces or sepcial characters, only letters (upper and lower case) and numbers. *) fun char_gen size = @@ -74,13 +92,48 @@ let val x = int_gen (1, ((length chars)-1)) size in nth chars x end -(* Generates a random string, with length ranging from 0 to noOfTest, +(* Generates a random string, with length ranging from 0 to size, only letters (upper and lower case) and numbers. *) fun string_gen size = let val x = int_gen (0, size) size fun fold f acc 0 = acc | fold f acc i = fold f (acc ^ f()) (i-1) in fold char_gen "" x end + + fun tuple_gen ts = + case ts of + [] => (fn i => ()) + | (y::ys) => + let fun tuple_aux (f, []) = f + | tuple_aux (f, (x::xs)) = tuple_aux ((fn i => (f i, x i)), xs) + in + (tuple_aux ((fn i => y i), ys)) end + + fun rec_gen ns ts = + let val noOfElems = length ts + in if (length ns) <> noOfElems then + report_error ("record_mismatch", 0) + else + case (ns, ts) of + ([],[]) => (fn i => {}) + | ((y::ys), (v::vs)) => + let fun record_aux (f, [], []) = f + | record_aux (f, (x::xs), (z::zs)) = record_aux ((fn i => recordExtend((f i), x, (z i))), xs, zs) + in + (record_aux ((fn i => recordExtend({}, y, (v i))), ys, vs)) end end + +(* Generates a random generator *) + fun generator_gen size = + let val rnd = random() + val inf = 1/0 + val res = if rnd <= 1/7 then ((fn i => int_gen(inf, inf) i)) else + if rnd <= 2/7 then ((fn i => bool_gen i)) else + if rnd <= 3/7 then ((fn i => float_gen(inf, inf) i)) else + if rnd <= 4/7 then ((fn i => string_gen i)) else + if rnd <= 5/7 then ((fn i => char_gen i)) else + if rnd <= 6/7 then ((fn i => tuple_gen (list_gen (fn _ => int_gen(inf, inf)) i) i)) else + ((fn i => list_gen (int_gen(inf, inf)) i)) in + res end fun one_of_two (x, y) = let val bool = bool_gen 0 in @@ -90,51 +143,38 @@ let fun abs_value x = if x < 0 then -x else x -(* -------------------------------Error Handling-------------------------------- *) -(* -arity_limit -> -Error: Couldn't produce a function of the desired arity, please - recompile PropEr with an increased value for ?MAX_ARITY. - *) - fun report_error error_reason = - write "\u001B[31m \nError: "; (* Changing the print color to red *) - let val err_string = case error_reason of - ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " - ^ (toString tries) ^ " tries.\n" - | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" - | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" - | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" - | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" - | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" - in - write (err_string ^ "\u001B[0m"); (* Changing the color back *) - exit (authority, 0) end + +(* ----------------------CORE FUNCTIONALITY--------------------------*) + fun apply_args p l = + case l of + [] => p + | (x::xs) => apply_args (p x) xs + + fun args_from_gen gens = + let fun args_aux [] acc = acc + | args_aux (x::xs) acc = args_aux xs (fn i => append (acc i) [(x i)]) in + args_aux gens (fn i => []) end (* Checks that a function returns a boolean - reports an error if not. *) fun bool_function_check gen p = - let val b = p (gen 1) in + let val b = apply_args p (args_from_gen gen 1) in case b of true => p |false => p | _ => report_error ("non_boolean_result", 0) end - fun generator_check gen = - case gen of - (x) => print "test1" - | _ => print "test3" -(* ----------------------CORE FUNCTIONALITY--------------------------*) (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. *) fun core_forall (generator, prop, 0, size, pre, cap) = {success = true, cEx = (), remTests = 0} - |core_forall (generator, prop, i, size, pre, cap) = - let val args = generator size in + |core_forall (generator, prop, i, size, pre, cap) = + let val args = (args_from_gen generator) size in case pre of () => - if prop args then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + if (apply_args prop args ) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) else (write "!"; {success = false, cEx = args, remTests = i}) | _ => - if (pre args) then - if (prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + if (apply_args pre args) then + if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) else {success = false, cEx = args, remTests = i} else (write "x"; @@ -159,18 +199,6 @@ Error: Couldn't produce a function of the desired arity, please end (* Tests a property function 100 times. *) fun tc generator p = tc_n generator p 100 - (* let val return_bool_check = bool_function_check generator - val (prop, pre) = - case p of - (x,y) => ((return_bool_check x),(return_bool_check y)) (* Maybe need to do check in core for all for each run - see no_duplicates *) - | x => ((return_bool_check x), ()) - val res = core_forall (generator, prop, 100, 0, pre, (100*5)) in - case res.success of - false => write "\nFailure at input: "; - print (res.cEx); - write ("After running: " ^ (toString (100 - res.remTests + 1)) ^ " test(s)\n") - | true => write ("\nOK: Passed after " ^ (toString (100 - res.remTests)) ^ " test(s)!\n") - end *) (* --------------------------User convenience functions -------------------------*) val inf = 1 / 0 @@ -190,34 +218,18 @@ Error: Couldn't produce a function of the desired arity, please fun boolean() = bool_gen - fun list() = list_gen(generator_gen) + fun list() = list_gen(generator_gen()) |list(type) = list_gen(type) fun string() = string_gen fun char() = char_gen - fun tuple ts = - case ts of - [] => (fn i => ()) - | (y::ys) => - let fun tuple_aux (f, []) = f - | tuple_aux (f, (x::xs)) = tuple_aux ((fn i => (f i, x i)), xs) - in - (tuple_aux ((fn i => y i), ys)) end + fun tuple ts = tuple_gen ts + - fun record ns ts = - let val noOfElems = length ts - in if (length ns) <> noOfElems then - report_error ("record_mismatch", 0) - else - case (ns, ts) of - ([],[]) => (fn i => {}) - | ((y::ys), (v::vs)) => - let fun record_aux (f, [], []) = f - | record_aux (f, (x::xs), (z::zs)) = record_aux ((fn i => recordExtend((f i), x, (z i))), xs, zs) - in - (record_aux ((fn i => recordExtend({}, y, (v i))), ys, vs)) end end + fun record ns ts = rec_gen ns ts + (* --------------------------functions to test on-------------------------------- *) fun my_reverse xs = @@ -253,7 +265,7 @@ Error: Couldn't produce a function of the desired arity, please fun bool_commutative x y = (x andalso y) = (y andalso x) - fun number_commutative (x, y) = + fun number_commutative x y = x * y = y * x fun list_reverse xs = @@ -274,10 +286,10 @@ Error: Couldn't produce a function of the desired arity, please fun make_list_test i = length (make_list ((fn ()=> (generator_gen i) (int_gen(0,inf) i)), i)) = i - fun my_count_returns_non_negative_int (x, xs) = + fun my_count_returns_non_negative_int x xs = (my_count x xs) >= 0 - fun rec_test (rec, i) = + fun rec_test rec i = {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} fun pre_pos x = @@ -294,6 +306,8 @@ Error: Couldn't produce a function of the desired arity, please fun both_ceil_test i = my_ceil_1 i = my_ceil_2 i + + fun tup_test x y z w = x+y+z+w = w+z+y+x (* ----------------------------For the userguide------------------------------- *) fun filter_less ([], _) = [] | filter_less ((x::xs), p) = @@ -327,38 +341,38 @@ Error: Couldn't produce a function of the desired arity, please fun no_duplicates[] = true | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs - fun cons_length_increase (xs, x) = + fun cons_length_increase xs x = (length (x::xs)) = ((length xs) + 1) - in -tc (tuple[(record ["theInteger", "theString"][integer(), string()]), integer()]) rec_test; -tc (tuple[list(integer()), integer()]) cons_length_increase; -tc (list(integer())) my_sort_is_ordered; -tc (list(integer())) my_sort_keep_length; -tc (list(integer())) (my_sort_keep_length, no_duplicates); +tc [integer(), integer(), integer(), integer()] tup_test; +tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +tc [list(integer()), integer()] cons_length_increase; +tc [list(integer())] my_sort_is_ordered; +tc [list(integer())] my_sort_keep_length; +tc [list(integer())] (my_sort_keep_length, no_duplicates); write "\nTesting on bools commutative:"; -tc (tuple [boolean(), boolean()]) (fn(x,y) => bool_commutative x y); +tc [boolean(), boolean()] bool_commutative; write "\nTesting on numbers commutative:"; -tc (tuple [integer(), integer()]) number_commutative; +tc [integer(), integer()] number_commutative; write "\nTesting on list reverse:"; -tc (list(integer())) list_reverse; +tc [list(integer())] list_reverse; write "\nTesting on int_gen interval:"; -tc (integer()) (int_gen_stays_in_interval, pre_pos); +tc [integer()] (int_gen_stays_in_interval, pre_pos); write "\nTesting on abs_value:"; -tc (one_of_two (integer(), float())) abs_value_is_always_pos; +tc [one_of_two (integer(), float())] abs_value_is_always_pos; write "\nTesting on my_floor:"; -tc (float()) my_floor_test; +tc [float()] my_floor_test; write "\nTesting that my_count always return non-negative result:"; -tc_n (tuple ([integer(), list(integer())])) my_count_returns_non_negative_int 1000; +tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; write "\nTesting my_length:"; -tc (list()) my_length_test; +tc [list()] my_length_test; write "\nTesting make_list:"; -tc (pos_integer()) make_list_test; +tc [pos_integer()] make_list_test; print "Testing on my_ceil_1:"; -tc (fn i => float() i) my_ceil_1_test; +tc [float()] my_ceil_1_test; print "Testing on my_ceil_2:"; -tc (fn i => float() i) my_ceil_2_test; +tc [float()] my_ceil_2_test; print "Testing on both ceil functions:"; -tc (fn i => float() i) both_ceil_test +tc [float()] both_ceil_test end From eafc43a2e891c09c499409481e4a036c4245aa5f Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 17 Mar 2024 16:14:36 +0100 Subject: [PATCH 026/121] Added more errorhandling for checking generators (cannot handle generators passed to a porperty that takes no generators) --- troupecheck/tc.trp | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 53debab..0f99ee3 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -145,11 +145,18 @@ Error: Couldn't produce a function of the desired arity, please (* ----------------------CORE FUNCTIONALITY--------------------------*) + fun apply_args p l = case l of - [] => p - | (x::xs) => apply_args (p x) xs - + [] => if (p() <> true) andalso (p() <> false) then report_error ("non_boolean_result", 0) else p() (* this case is only reached if there are no generators to beign with*) + | [x] => + if (p = true) orelse (p = false) then report_error ("type_mismatch", 0) + else if ((p x) <> true) andalso ((p x) <> false) then report_error ("non_boolean_result", 0) + else(p x) + | (x::xs) => + if (p = true) orelse (p = false) then report_error ("type_mismatch", 0) + else apply_args (p x) xs + fun args_from_gen gens = let fun args_aux [] acc = acc | args_aux (x::xs) acc = args_aux xs (fn i => append (acc i) [(x i)]) in @@ -162,15 +169,20 @@ Error: Couldn't produce a function of the desired arity, please true => p |false => p | _ => report_error ("non_boolean_result", 0) end + + fun prop_takes_no_args p = + print p; + if ((p()) = true) orelse ((p()) = false) then p() + else p (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. *) fun core_forall (generator, prop, 0, size, pre, cap) = {success = true, cEx = (), remTests = 0} - |core_forall (generator, prop, i, size, pre, cap) = + |core_forall (generator, prop, i, size, pre, cap) = let val args = (args_from_gen generator) size in case pre of () => - if (apply_args prop args ) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) else (write "!"; {success = false, cEx = args, remTests = i}) | _ => if (apply_args pre args) then @@ -188,8 +200,8 @@ Error: Couldn't produce a function of the desired arity, please let val return_bool_check = bool_function_check generator val (prop, pre) = case p of - (x,y) => ((return_bool_check x),(return_bool_check y)) (* Maybe need to do check in core for all for each run - see no_duplicates *) - | x => ((return_bool_check x), ()) + (x,y) => (x,y) + | x => (x, ()) val res = core_forall (generator, prop, noOfTests, 0, pre, (noOfTests*5)) in case res.success of false => write "\nFailure at input: "; @@ -343,8 +355,11 @@ Error: Couldn't produce a function of the desired arity, please fun cons_length_increase xs x = (length (x::xs)) = ((length xs) + 1) + + fun no_args() = true in +tc [] no_args; tc [integer(), integer(), integer(), integer()] tup_test; tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [list(integer()), integer()] cons_length_increase; From b2f966d34c0045e543b540259e896114a982a030 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 17 Mar 2024 16:43:37 +0100 Subject: [PATCH 027/121] Added documentation --- troupecheck/tc.trp | 22 ++++++---------------- 1 file changed, 6 insertions(+), 16 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 0f99ee3..399b9ad 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -35,15 +35,6 @@ Error: Couldn't produce a function of the desired arity, please true => p |false => p | _ => report_error ("non_boolean_result", 0) end - - fun tuple_size_count (x, xs) acc = print("tesgs"); tuple_size_count xs (acc+1) - | tuple_size_count(_) = acc+1 - | tuple_size_count () acc = acc - - fun generator_check gen = - case gen of - (x, xs) => report_error ("illegal_gen_def", 0) - | _ => () (* -----------------GENERATORS AND UTILS--------------------------*) (* Generates a random boolean *) fun bool_gen size = @@ -100,6 +91,8 @@ Error: Couldn't produce a function of the desired arity, please | fold f acc i = fold f (acc ^ f()) (i-1) in fold char_gen "" x end +(* Generates a tuple *) +(* can only generate tuples of two for now... if list is longer will nest them *) fun tuple_gen ts = case ts of [] => (fn i => ()) @@ -108,7 +101,7 @@ Error: Couldn't produce a function of the desired arity, please | tuple_aux (f, (x::xs)) = tuple_aux ((fn i => (f i, x i)), xs) in (tuple_aux ((fn i => y i), ys)) end - +(* Generates a record with fields corresponding to first list of strings, and values corresponding to second list *) fun rec_gen ns ts = let val noOfElems = length ts in if (length ns) <> noOfElems then @@ -145,7 +138,8 @@ Error: Couldn't produce a function of the desired arity, please (* ----------------------CORE FUNCTIONALITY--------------------------*) - +(* applies the list of arguments to the property - one by one - reporting errors along the way *) +(* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l = case l of [] => if (p() <> true) andalso (p() <> false) then report_error ("non_boolean_result", 0) else p() (* this case is only reached if there are no generators to beign with*) @@ -157,6 +151,7 @@ Error: Couldn't produce a function of the desired arity, please if (p = true) orelse (p = false) then report_error ("type_mismatch", 0) else apply_args (p x) xs +(* takes a list of generator, and returns a function that when given an integer returns a list of elements created by the generators *) fun args_from_gen gens = let fun args_aux [] acc = acc | args_aux (x::xs) acc = args_aux xs (fn i => append (acc i) [(x i)]) in @@ -169,11 +164,6 @@ Error: Couldn't produce a function of the desired arity, please true => p |false => p | _ => report_error ("non_boolean_result", 0) end - - fun prop_takes_no_args p = - print p; - if ((p()) = true) orelse ((p()) = false) then p() - else p (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. *) From 6c06154e21f25acb5b23e06c4679c570a639c61c Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 20 Mar 2024 09:33:33 +0100 Subject: [PATCH 028/121] Cleaned up the code a bit using map and fold + added initial tc^2 test --- troupecheck/tc.trp | 94 ++++++++++++++++++++++------------------------ 1 file changed, 45 insertions(+), 49 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 399b9ad..ee53c2f 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -17,7 +17,7 @@ Error: Couldn't produce a function of the desired arity, please fun report_error error_reason = write "\u001B[31m \nError: "; (* Changing the print color to red *) let val err_string = case error_reason of - ("cant_generate", tries) => "Couldn't produce an insta ^nce that satisfies all strict constraints after " + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " ^ (toString tries) ^ " tries.\n" | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" @@ -28,13 +28,6 @@ Error: Couldn't produce a function of the desired arity, please write (err_string ^ "\u001B[0m"); (* Changing the color back *) exit (authority, 0) end -(* Checks that a function returns a boolean - reports an error if not. *) - fun bool_function_check gen p = - let val b = p (gen 1) in - case b of - true => p - |false => p - | _ => report_error ("non_boolean_result", 0) end (* -----------------GENERATORS AND UTILS--------------------------*) (* Generates a random boolean *) fun bool_gen size = @@ -92,15 +85,22 @@ Error: Couldn't produce a function of the desired arity, please fold char_gen "" x end (* Generates a tuple *) -(* can only generate tuples of two for now... if list is longer will nest them *) - fun tuple_gen ts = +(* Hardcoded for tuple of up to 10 elements *) + fun tuple_gen ts i = case ts of - [] => (fn i => ()) - | (y::ys) => - let fun tuple_aux (f, []) = f - | tuple_aux (f, (x::xs)) = tuple_aux ((fn i => (f i, x i)), xs) - in - (tuple_aux ((fn i => y i), ys)) end + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) + (* Generates a record with fields corresponding to first list of strings, and values corresponding to second list *) fun rec_gen ns ts = let val noOfElems = length ts @@ -138,38 +138,26 @@ Error: Couldn't produce a function of the desired arity, please (* ----------------------CORE FUNCTIONALITY--------------------------*) + fun boolean_check x = + if (x <> true) andalso (x <> false) then report_error ("non_boolean_result", 0) else () + + fun function_not_done_check p = + if (p = true) orelse (p = false) then report_error ("type_mismatch", 0) else () (* applies the list of arguments to the property - one by one - reporting errors along the way *) (* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l = case l of - [] => if (p() <> true) andalso (p() <> false) then report_error ("non_boolean_result", 0) else p() (* this case is only reached if there are no generators to beign with*) - | [x] => - if (p = true) orelse (p = false) then report_error ("type_mismatch", 0) - else if ((p x) <> true) andalso ((p x) <> false) then report_error ("non_boolean_result", 0) - else(p x) + [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) | (x::xs) => - if (p = true) orelse (p = false) then report_error ("type_mismatch", 0) - else apply_args (p x) xs - -(* takes a list of generator, and returns a function that when given an integer returns a list of elements created by the generators *) - fun args_from_gen gens = - let fun args_aux [] acc = acc - | args_aux (x::xs) acc = args_aux xs (fn i => append (acc i) [(x i)]) in - args_aux gens (fn i => []) end - -(* Checks that a function returns a boolean - reports an error if not. *) - fun bool_function_check gen p = - let val b = apply_args p (args_from_gen gen 1) in - case b of - true => p - |false => p - | _ => report_error ("non_boolean_result", 0) end + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in + boolean_check res; + res end (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. *) fun core_forall (generator, prop, 0, size, pre, cap) = {success = true, cEx = (), remTests = 0} |core_forall (generator, prop, i, size, pre, cap) = - let val args = (args_from_gen generator) size in + let val args = map (fn x => x size) generator in case pre of () => if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) @@ -186,9 +174,9 @@ Error: Couldn't produce a function of the desired arity, please end (* Tests a property function a given number of times. *) + (* test tc itself - maybe by returning result *) fun tc_n generator p noOfTests = - let val return_bool_check = bool_function_check generator - val (prop, pre) = + let val (prop, pre) = case p of (x,y) => (x,y) | x => (x, ()) @@ -196,8 +184,8 @@ Error: Couldn't produce a function of the desired arity, please case res.success of false => write "\nFailure at input: "; print (res.cEx); - write ("After running: " ^ (toString (noOfTests - res.remTests + 1)) ^ " test(s)\n") - | true => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n") + write ("After running: " ^ (toString (noOfTests - res.remTests + 1)) ^ " test(s)\n"); false + | true => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true end (* Tests a property function 100 times. *) fun tc generator p = tc_n generator p 100 @@ -286,7 +274,7 @@ Error: Couldn't produce a function of the desired arity, please my_length xs = length xs fun make_list_test i = - length (make_list ((fn ()=> (generator_gen i) (int_gen(0,inf) i)), i)) = i + length (make_list ((fn () => (generator_gen i) (int_gen(0,inf) i)), i)) = i fun my_count_returns_non_negative_int x xs = (my_count x xs) >= 0 @@ -347,15 +335,23 @@ Error: Couldn't produce a function of the desired arity, please (length (x::xs)) = ((length xs) + 1) fun no_args() = true +(* ----------------------------For tc^2---------------------------------------- *) + fun tc_sort_length_always_fails () = + tc [list(integer())] my_sort_keep_length = false in -tc [] no_args; -tc [integer(), integer(), integer(), integer()] tup_test; +(* tc^2 tests *) +tc [] tc_sort_length_always_fails + +(* (* User guide tests *) tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; tc [list(integer())] (my_sort_keep_length, no_duplicates); +(* General functionality tests *) +tc [] no_args; +tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; tc [boolean(), boolean()] bool_commutative; write "\nTesting on numbers commutative:"; @@ -374,10 +370,10 @@ write "\nTesting my_length:"; tc [list()] my_length_test; write "\nTesting make_list:"; tc [pos_integer()] make_list_test; -print "Testing on my_ceil_1:"; +write "Testing on my_ceil_1:"; tc [float()] my_ceil_1_test; -print "Testing on my_ceil_2:"; +write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; -print "Testing on both ceil functions:"; -tc [float()] both_ceil_test +write "Testing on both ceil functions:"; +tc [float()] both_ceil_test *) end From ece3e9f380fee82743e4dcaf87186ca21ab16735 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 20 Mar 2024 09:40:25 +0100 Subject: [PATCH 029/121] added another tc^2 test --- troupecheck/tc.trp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index ee53c2f..4ec6524 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -338,10 +338,13 @@ Error: Couldn't produce a function of the desired arity, please (* ----------------------------For tc^2---------------------------------------- *) fun tc_sort_length_always_fails () = tc [list(integer())] my_sort_keep_length = false + + fun tc_sort_ordered_always_true () = + tc [list(integer())] my_sort_is_ordered = true in (* tc^2 tests *) -tc [] tc_sort_length_always_fails +tc [] tc_sort_ordered_always_true (* (* User guide tests *) tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; From a0a757fd19b8118c2d90d9b3d474281a8acef3f9 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 22 Mar 2024 08:37:00 +0100 Subject: [PATCH 030/121] Fixed printing of arguments --- troupecheck/tc.trp | 57 +++++++++++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 24 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 4ec6524..d931112 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -3,11 +3,11 @@ let (* ----------------USED FOR PRINTING TO CONSOLE-------------------- *) val out = getStdout authority fun write x = fwrite (out, x) - fun tc_toString x = - case x of - (y, ys) => "(" ^ (tc_toString y) ^ ", " ^ (tc_toString ys) ^ ")" - | (y::ys) => "[" ^ (tc_toString y) ^ ", " ^ (tc_toString ys) ^ "]" - | _ => toString x + (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) + fun args_toString args = + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x) in + aux_toString "" args end (* -------------------------------Error Handling-------------------------------- *) (* arity_limit -> @@ -139,10 +139,11 @@ Error: Couldn't produce a function of the desired arity, please (* ----------------------CORE FUNCTIONALITY--------------------------*) fun boolean_check x = - if (x <> true) andalso (x <> false) then report_error ("non_boolean_result", 0) else () + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () fun function_not_done_check p = - if (p = true) orelse (p = false) then report_error ("type_mismatch", 0) else () + if (getType p)<>"function" then report_error ("type_mismatch", 0) else () + (* applies the list of arguments to the property - one by one - reporting errors along the way *) (* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l = @@ -155,24 +156,31 @@ Error: Couldn't produce a function of the desired arity, please (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. *) - fun core_forall (generator, prop, 0, size, pre, cap) = {success = true, cEx = (), remTests = 0} + fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} |core_forall (generator, prop, i, size, pre, cap) = let val args = map (fn x => x size) generator in case pre of () => if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {success = false, cEx = args, remTests = i}) + else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) | _ => if (apply_args pre args) then if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else {success = false, cEx = args, remTests = i} + else {failReason = "false_prop", cEx = args, remTests = i} else (write "x"; if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) - else if size = cap then {success = true, cEx = (), remTests = i} + else if size = cap then {failReason = (), cEx = (), remTests = i} else core_forall (generator, prop, i, size+1, pre, cap)) end + fun report_fail_reason rec noOfTests= + case rec.failReason of + "false_prop" => write "\nFailure at input: "; + write (args_toString rec.cEx); + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") + + (* Tests a property function a given number of times. *) (* test tc itself - maybe by returning result *) fun tc_n generator p noOfTests = @@ -181,15 +189,16 @@ Error: Couldn't produce a function of the desired arity, please (x,y) => (x,y) | x => (x, ()) val res = core_forall (generator, prop, noOfTests, 0, pre, (noOfTests*5)) in - case res.success of - false => write "\nFailure at input: "; - print (res.cEx); - write ("After running: " ^ (toString (noOfTests - res.remTests + 1)) ^ " test(s)\n"); false - | true => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true + case res.failReason of + () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true + |_ => report_fail_reason res noOfTests; false end (* Tests a property function 100 times. *) fun tc generator p = tc_n generator p 100 + fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) + | troupecheck generator p = spawn (fn() => tc generator p) + (* --------------------------User convenience functions -------------------------*) val inf = 1 / 0 fun integer() = int_gen(inf, inf) @@ -297,7 +306,9 @@ Error: Couldn't produce a function of the desired arity, please fun both_ceil_test i = my_ceil_1 i = my_ceil_2 i - fun tup_test x y z w = x+y+z+w = w+z+y+x + fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) + + fun no_args() = true (* ----------------------------For the userguide------------------------------- *) fun filter_less ([], _) = [] | filter_less ((x::xs), p) = @@ -333,8 +344,6 @@ Error: Couldn't produce a function of the desired arity, please fun cons_length_increase xs x = (length (x::xs)) = ((length xs) + 1) - - fun no_args() = true (* ----------------------------For tc^2---------------------------------------- *) fun tc_sort_length_always_fails () = tc [list(integer())] my_sort_keep_length = false @@ -343,11 +352,11 @@ Error: Couldn't produce a function of the desired arity, please tc [list(integer())] my_sort_is_ordered = true in -(* tc^2 tests *) -tc [] tc_sort_ordered_always_true - -(* (* User guide tests *) -tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +tc [integer(), integer(), integer(), integer()] tup_test +(* (* tc^2 tests *) +troupecheck [] tc_sort_ordered_always_true *) +(* User guide tests *) +(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; From a3c8f40aa154f84515c460477178c5a75ac3c224 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 28 Mar 2024 22:17:59 +0100 Subject: [PATCH 031/121] Some basic shrinking ( which doesn't work - will probably be replaced) --- troupecheck/tc.trp | 90 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 85 insertions(+), 5 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index d931112..4ff262a 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -138,12 +138,76 @@ Error: Couldn't produce a function of the desired arity, please (* ----------------------CORE FUNCTIONALITY--------------------------*) - fun boolean_check x = + fun arg_is_minimum_inst = + case getType x of + "list" => x = [] + | "number" => x = 0 + | "boolean" => x = false + | "string" => x = "" + | "record" => false + | "tuple" => false + + fun get_shrinker arg = + case getType arg of + "list" => x = [] + | "number" => x = 0 + | "boolean" => x = false + | "string" => x = "" + | "record" => false + | "tuple" => false + + fun arg_shrink arg = + case getType arg of + "list" => shrink_list arg + | "number" => shrink_number arg + | "boolean" => shrink_bool arg + | "string" => shrink_string arg + | "record" => shrink_rec arg + | "tuple" => shrink_tuple arg + + and boolean_check x = if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () - fun function_not_done_check p = + and function_not_done_check p = if (getType p)<>"function" then report_error ("type_mismatch", 0) else () + + and shrink_number n = + if n-1 <= 0 then 0 else n-1 + + and shrink_bool n = + n + + and shrink_string n = + n + + and shrink_rec n = + n + + and shrink_tuple n = + n + and shrink_list [] = [] + | shrink_list (x::xs) = x + + + and args_shrink args = + let fun shrink_aux [] acc = acc + | shrink_aux (x::xs) acc = + let val x_shrunk = arg_shrink x in + append [x_shrunk] (args_shrink xs) end in + (shrink_aux args []) end + + fun args_is_minumum_insts [] = true + | args_is_minumum_insts (x::xs) = + case getType x of + "list" => if x = [] then args_is_minumum_insts xs else false + | "number" => if x = 0 then args_is_minumum_insts xs else false + | "boolean" => if x = false then args_is_minumum_insts xs else false + | "string" => if x = "" then args_is_minumum_insts xs else false + | "record" => false + | "tuple" => false + + (* applies the list of arguments to the property - one by one - reporting errors along the way *) (* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l = @@ -154,6 +218,15 @@ Error: Couldn't produce a function of the desired arity, please boolean_check res; res end + fun shrink args prop counter = + let val shrunk_args = args_shrink args in + case apply_args prop shrunk_args of + true => {shrunk_ctx = args, count = counter} + | false => + if args_is_minumum_insts shrunk_args then {shrunk_ctx = shrunk_args, count = counter} + else shrink shrunk_args prop (counter+1) end + + (* Runs however many tests specified on a property, while always generating new inputs. Drops further execution if a Failure is found. *) fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} @@ -191,7 +264,14 @@ Error: Couldn't produce a function of the desired arity, please val res = core_forall (generator, prop, noOfTests, 0, pre, (noOfTests*5)) in case res.failReason of () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true - |_ => report_fail_reason res noOfTests; false + |_ => + let val shrink_res = shrink res.cEx prop 0 in + report_fail_reason res noOfTests; + write "\nFailing test case was shrunk to: "; + write (args_toString shrink_res.shrunk_ctx); + write (" After " ^ (toString shrink_res.count) ^ " iterations."); + false + end end (* Tests a property function 100 times. *) fun tc generator p = tc_n generator p 100 @@ -306,7 +386,7 @@ Error: Couldn't produce a function of the desired arity, please fun both_ceil_test i = my_ceil_1 i = my_ceil_2 i - fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) + fun tup_test x y = x+y < 100 (* = w+z+y+x *) fun no_args() = true (* ----------------------------For the userguide------------------------------- *) @@ -352,7 +432,7 @@ Error: Couldn't produce a function of the desired arity, please tc [list(integer())] my_sort_is_ordered = true in -tc [integer(), integer(), integer(), integer()] tup_test +tc [integer(), integer()] tup_test (* (* tc^2 tests *) troupecheck [] tc_sort_ordered_always_true *) (* User guide tests *) From 6985b9a0670ccdc5855789d6eadf3cf8efbb76f1 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 29 Mar 2024 18:25:37 +0100 Subject: [PATCH 032/121] added some maybe useful code as comments for later --- troupecheck/tc.trp | 61 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 4ff262a..c2a2dda 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -469,3 +469,64 @@ tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; tc [float()] both_ceil_test *) end + +(* +----------------------------------------- + Code that may need to beused later. +----------------------------------------- + *) + + (* fun le tup = + case tup of + (inf, _) => true + | (_, inf) => true + | (a,b) => a <= b + + fun find_limit x low high fallback = + case (le(low, x)) andalso (le(x, high)) of + true => x + |false => fallback + + fun sign x = + if x > 0 then 1 + else if x < 0 then -1 + else 0 + + fun find_target x low high = + case (le(low,0), le(0,high)) of + (false, _) => + let val limit = find_limit(x, low, high, high) in + (low, fn y => y + 1, fn y => y > limit) end + | (true,false) => + let val limit = find_limit(x, low, high, low) in + (high, fn y => y - 1, fn y => y < limit) end + | (true,true) => + let val sign = sign x + val overLimit = + case x >= 0 of + true => + let val limit = find_limit(x, low, high, high) in + fn y => y > limit end + | false => + let val limit = find_limit(x, low, high, low) in + fn y => y < Limit end in + (0, fn y => y + sign, overLimit) end + + fun number_shrinker x low high action = + case action.0 of + "init" => + let val (target, inc, overLimit) = find_target x low high in + case x = target of + true => ([], "done") + | false => ([target], ("inc", target, inc, overLimit)) end + | "inc" => + let val (last, inc, overLimit) = (action.1, action.2, action.3) + val newLast = inc last in + case overLimit newLast of + true => ([], "done") + | false => ([newLast], ("inc", newLast, inc, overLimit)) end + | "shrunk" => + ([], "done") + + fun get_shrinker arg = + number_shrinker *) From d9124ac2637873851ca14ecd49b1fead74e627c5 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 3 Apr 2024 13:23:02 +0200 Subject: [PATCH 033/121] Shrinking of lists and integers are working Co-authored-by: Selma --- troupecheck/tc.trp | 270 +++++++++++++++++++++++++++------------------ 1 file changed, 165 insertions(+), 105 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index c2a2dda..b2b09f8 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,19 +1,21 @@ -import lists -let -(* ----------------USED FOR PRINTING TO CONSOLE-------------------- *) - val out = getStdout authority +import lists +(* +-------------------------------- +PRINTING TO CONSOLE +-------------------------------- +*) +let val out = getStdout authority fun write x = fwrite (out, x) (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) fun args_toString args = let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) | aux_toString acc (x::xs) = acc ^ (toString x) in aux_toString "" args end -(* -------------------------------Error Handling-------------------------------- *) (* -arity_limit -> -Error: Couldn't produce a function of the desired arity, please - recompile PropEr with an increased value for ?MAX_ARITY. - *) +-------------------------------- +ERROR HANDLING +-------------------------------- +*) fun report_error error_reason = write "\u001B[31m \nError: "; (* Changing the print color to red *) let val err_string = case error_reason of @@ -28,15 +30,22 @@ Error: Couldn't produce a function of the desired arity, please write (err_string ^ "\u001B[0m"); (* Changing the color back *) exit (authority, 0) end -(* -----------------GENERATORS AND UTILS--------------------------*) -(* Generates a random boolean *) +(* +-------------------------------- +GENERATORS AND UTILS +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + fun bool_gen size = let val rnd = random() val res = if rnd < 1/2 then false else true in res end -(* Generates a random float based on number of tests that has been run so far. *) fun float_gen (low, high) size = let val x = random() val lInf = low = 1/0 (* check for inf *) @@ -49,23 +58,19 @@ Error: Couldn't produce a function of the desired arity, please | (false, false) => low + (x * (high-low)) end -(* Generates a random integer based on number of tests that has been run so far. *) fun int_gen (low, high) size = floor (float_gen(low, high) size) -(* Create a list of some determined size. *) fun make_list (f, i) = case i of 0 => [] | _ => append [f()] (make_list (f, i-1)) -(* Generates a randomly sized list of some specified type of elements. *) and list_gen (generator) size = let val length = (int_gen(0, size) size) in make_list ((fn () => generator size), length) end -(* Generates a random character - no spaces or sepcial characters, - only letters (upper and lower case) and numbers. *) +(* NOTE: Generates only letters (upper and lower case) and numbers. *) fun char_gen size = let val chars = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", @@ -76,16 +81,14 @@ Error: Couldn't produce a function of the desired arity, please val x = int_gen (1, ((length chars)-1)) size in nth chars x end -(* Generates a random string, with length ranging from 0 to size, - only letters (upper and lower case) and numbers. *) +(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) fun string_gen size = let val x = int_gen (0, size) size fun fold f acc 0 = acc | fold f acc i = fold f (acc ^ f()) (i-1) in fold char_gen "" x end -(* Generates a tuple *) -(* Hardcoded for tuple of up to 10 elements *) +(* NOTE: Hardcoded for tuple of up to 10 elements *) fun tuple_gen ts i = case ts of [] => (0) @@ -101,7 +104,10 @@ Error: Couldn't produce a function of the desired arity, please |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) |_ => (2, 3, 4, 5) -(* Generates a record with fields corresponding to first list of strings, and values corresponding to second list *) +(* +ns: list of strings - will be used as fieldnames +ts: list of generators - used to generate values for fields +*) fun rec_gen ns ts = let val noOfElems = length ts in if (length ns) <> noOfElems then @@ -115,7 +121,7 @@ Error: Couldn't produce a function of the desired arity, please in (record_aux ((fn i => recordExtend({}, y, (v i))), ys, vs)) end end -(* Generates a random generator *) + fun generator_gen size = let val rnd = random() val inf = 1/0 @@ -132,81 +138,105 @@ Error: Couldn't produce a function of the desired arity, please let val bool = bool_gen 0 in if bool then x else y end - + + +(* +-------------------------------- +CORE FUNCTIONALITY +-------------------------------- +*) fun abs_value x = if x < 0 then -x else x - -(* ----------------------CORE FUNCTIONALITY--------------------------*) - fun arg_is_minimum_inst = + fun arg_is_minimum_inst x = case getType x of - "list" => x = [] - | "number" => x = 0 - | "boolean" => x = false - | "string" => x = "" - | "record" => false - | "tuple" => false - - fun get_shrinker arg = - case getType arg of - "list" => x = [] - | "number" => x = 0 - | "boolean" => x = false - | "string" => x = "" - | "record" => false - | "tuple" => false - - fun arg_shrink arg = - case getType arg of - "list" => shrink_list arg - | "number" => shrink_number arg - | "boolean" => shrink_bool arg - | "string" => shrink_string arg - | "record" => shrink_rec arg - | "tuple" => shrink_tuple arg - - and boolean_check x = - if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () - - and function_not_done_check p = - if (getType p)<>"function" then report_error ("type_mismatch", 0) else () - - and shrink_number n = - if n-1 <= 0 then 0 else n-1 + "list" => x = [] + | "number" => x = 0 + | "boolean" => x = false + | "string" => x = "" + | "record" => false + | "tuple" => false + + fun get_shrinker x = + case getType x of + "list" => shrink_list + | "number" => shrink_number + | "boolean" => shrink_bool + | "string" => shrink_string + | "record" => shrink_rec + | "tuple" => shrink_tuple + + and arg_shrink arg = + case getType arg.curr of + "list" => shrink_list arg + | "number" => shrink_number arg + | "boolean" => shrink_bool arg + | "string" => shrink_string arg + | "record" => shrink_rec arg + | "tuple" => shrink_tuple arg + + and shrink_number rec = + case rec.state of + "rollback" => + {state = "done", curr = rec.prev} + | _ => + let val newVal = if (abs_value rec.curr)-1 <= 0 then 0 else rec.curr/2 + val nextState = if newVal = 0 then "done" else "cont" in + {state = nextState, curr = newVal, prev = rec.curr} end and shrink_bool n = - n + 3 and shrink_string n = - n + 3 and shrink_rec n = - n + 3 and shrink_tuple n = - n - - and shrink_list [] = [] - | shrink_list (x::xs) = x + 3 + + and shrink_list rec = + if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done"} + else + case rec.state of + "init" => + let val removeIdx = length rec.curr - 1 + val newList = remove_nth removeIdx rec.curr 0 in + {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx} end + | "cont_size" => + let val removeIdx = (rec.idx - 1) + val nextState = if removeIdx <= 0 then "cont_elem" else "cont_size" + val newList = remove_nth removeIdx rec.curr 0 in + {state = nextState, curr = newList, prev = rec.curr, idx = removeIdx} end + | "cont_elem" => + let val shrinker = get_shrinker (nth rec.curr 1) + val interimList = (map (fn x => shrinker {state = "init", curr = x}) rec.curr) + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interimList) then "done" else "cont_elem" + val newList = map (fn x => x.curr) interimList in + {state = nextState, curr = newList, prev = rec.curr, idx = rec.idx} end + | "rollback" => + if (length rec.curr) = (length rec.prev) then {state = "done", curr = rec.prev} + else {state = "cont_size", curr = rec.prev, idx = rec.idx} and args_shrink args = - let fun shrink_aux [] acc = acc - | shrink_aux (x::xs) acc = - let val x_shrunk = arg_shrink x in - append [x_shrunk] (args_shrink xs) end in - (shrink_aux args []) end - - fun args_is_minumum_insts [] = true - | args_is_minumum_insts (x::xs) = - case getType x of - "list" => if x = [] then args_is_minumum_insts xs else false - | "number" => if x = 0 then args_is_minumum_insts xs else false - | "boolean" => if x = false then args_is_minumum_insts xs else false - | "string" => if x = "" then args_is_minumum_insts xs else false - | "record" => false - | "tuple" => false + case args.state of + "rollback" => + let val rollbackReadyArgs = map (fn x => {x with state = "rollback"}) args.args + val argsRolledBack = map (fn x => arg_shrink x) rollbackReadyArgs in + {state = "cont", args = argsRolledBack} end + |_ => + let val newArgs = map (fn x => arg_shrink x) args.args + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in + {state = nextState, args = newArgs} end + + fun boolean_check x = + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () + + fun function_not_done_check p = + if (getType p)<>"function" then report_error ("type_mismatch", 0) else () (* applies the list of arguments to the property - one by one - reporting errors along the way *) (* TODO: handle when arguments are passed to a property that does not take arguments *) @@ -218,17 +248,23 @@ Error: Couldn't produce a function of the desired arity, please boolean_check res; res end + fun shrink_aux args prop counter = + let val shrunk_args = args_shrink args + val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args in + print "shrunk args raw-----------------"; + print shrunk_args_raw; + case apply_args prop shrunk_args_raw of + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop (counter+1) + | false => + if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop (counter+1) end + fun shrink args prop counter = - let val shrunk_args = args_shrink args in - case apply_args prop shrunk_args of - true => {shrunk_ctx = args, count = counter} - | false => - if args_is_minumum_insts shrunk_args then {shrunk_ctx = shrunk_args, count = counter} - else shrink shrunk_args prop (counter+1) end + let val newArgs = map (fn x => {state = "init", curr = x}) args + val res = shrink_aux ({state = "init", args = newArgs}) prop counter in + print "testing"; + res end + - -(* Runs however many tests specified on a property, while always generating new inputs. - Drops further execution if a Failure is found. *) fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} |core_forall (generator, prop, i, size, pre, cap) = let val args = map (fn x => x size) generator in @@ -253,9 +289,6 @@ Error: Couldn't produce a function of the desired arity, please write (args_toString rec.cEx); write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") - - (* Tests a property function a given number of times. *) - (* test tc itself - maybe by returning result *) fun tc_n generator p noOfTests = let val (prop, pre) = case p of @@ -269,17 +302,21 @@ Error: Couldn't produce a function of the desired arity, please report_fail_reason res noOfTests; write "\nFailing test case was shrunk to: "; write (args_toString shrink_res.shrunk_ctx); - write (" After " ^ (toString shrink_res.count) ^ " iterations."); + write (" After " ^ (toString shrink_res.count) ^ " iterations.\n"); false end end -(* Tests a property function 100 times. *) + fun tc generator p = tc_n generator p 100 fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) | troupecheck generator p = spawn (fn() => tc generator p) -(* --------------------------User convenience functions -------------------------*) +(* +-------------------------------- +CONVENIENCE FUNCTIONS +-------------------------------- +*) val inf = 1 / 0 fun integer() = int_gen(inf, inf) | integer (h, l) = int_gen(h, l) @@ -305,12 +342,15 @@ Error: Couldn't produce a function of the desired arity, please fun char() = char_gen fun tuple ts = tuple_gen ts - fun record ns ts = rec_gen ns ts -(* --------------------------functions to test on-------------------------------- *) +(* +-------------------------------- +FUNCTIONS FOR TESTING +-------------------------------- +*) fun my_reverse xs = xs @@ -340,7 +380,15 @@ Error: Couldn't produce a function of the desired arity, please if i > 0 then (my_floor i) + 1 else if i = 0 then 0 else (my_floor i) + 1 -(* --------------------------Propterties to run-------------------------*) + + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs +(* +-------------------------------- +PROPERTIES FOR TESTING +-------------------------------- +*) fun bool_commutative x y = (x andalso y) = (y andalso x) @@ -389,7 +437,15 @@ Error: Couldn't produce a function of the desired arity, please fun tup_test x y = x+y < 100 (* = w+z+y+x *) fun no_args() = true -(* ----------------------------For the userguide------------------------------- *) + + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + +(* +-------------------------------- +USED FOR USERGUIDE +-------------------------------- +*) fun filter_less ([], _) = [] | filter_less ((x::xs), p) = if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) @@ -424,7 +480,11 @@ Error: Couldn't produce a function of the desired arity, please fun cons_length_increase xs x = (length (x::xs)) = ((length xs) + 1) -(* ----------------------------For tc^2---------------------------------------- *) +(* +-------------------------------- +TC^2 +-------------------------------- +*) fun tc_sort_length_always_fails () = tc [list(integer())] my_sort_keep_length = false @@ -432,16 +492,16 @@ Error: Couldn't produce a function of the desired arity, please tc [list(integer())] my_sort_is_ordered = true in -tc [integer(), integer()] tup_test +tc [list(integer()), integer()] test_bad_insert (* (* tc^2 tests *) troupecheck [] tc_sort_ordered_always_true *) (* User guide tests *) -(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; -tc [list(integer()), integer()] cons_length_increase; +(* tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; tc [list(integer())] (my_sort_keep_length, no_duplicates); (* General functionality tests *) +tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [] no_args; tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; From dbfaf3f2befb933c1dfc03b8cd8a3412ab0a2f25 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 3 Apr 2024 22:56:25 +0200 Subject: [PATCH 034/121] Fixed number shrinking to avoid endless looping + added bool shrinking + cleaned up the code --- troupecheck/tc.trp | 218 ++++++++++++++++----------------------------- 1 file changed, 79 insertions(+), 139 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index b2b09f8..130d7fb 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -26,20 +26,49 @@ ERROR HANDLING | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + | ("shrinking_looped", _) => "Shrinking looped\n" in write (err_string ^ "\u001B[0m"); (* Changing the color back *) exit (authority, 0) end + fun boolean_check x = + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () + + fun function_not_done_check p = + if (getType p)<>"function" then report_error ("type_mismatch", 0) else () (* -------------------------------- -GENERATORS AND UTILS +UTILS -------------------------------- -*) +*) + fun remove_nth n [] i = [] | remove_nth n (x::xs) i = if n = i then xs else x :: (remove_nth n xs (i + 1)) + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + + fun abs_value x = + if x < 0 then -x else x + +(* applies the list of arguments to the property - one by one - reporting errors along the way *) +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l = + case l of + [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in + boolean_check res; + res end +(* +-------------------------------- +GENERATORS +-------------------------------- +*) fun bool_gen size = let val rnd = random() val res = if rnd < 1/2 then false @@ -60,13 +89,8 @@ GENERATORS AND UTILS fun int_gen (low, high) size = floor (float_gen(low, high) size) - - fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) - and list_gen (generator) size = + fun list_gen (generator) size = let val length = (int_gen(0, size) size) in make_list ((fn () => generator size), length) end @@ -133,30 +157,12 @@ ts: list of generators - used to generate values for fields if rnd <= 6/7 then ((fn i => tuple_gen (list_gen (fn _ => int_gen(inf, inf)) i) i)) else ((fn i => list_gen (int_gen(inf, inf)) i)) in res end - - fun one_of_two (x, y) = - let val bool = bool_gen 0 in - if bool then x - else y end - - (* -------------------------------- -CORE FUNCTIONALITY +SHRINKING -------------------------------- -*) - fun abs_value x = - if x < 0 then -x else x +*) - fun arg_is_minimum_inst x = - case getType x of - "list" => x = [] - | "number" => x = 0 - | "boolean" => x = false - | "string" => x = "" - | "record" => false - | "tuple" => false - fun get_shrinker x = case getType x of "list" => shrink_list @@ -167,25 +173,30 @@ CORE FUNCTIONALITY | "tuple" => shrink_tuple and arg_shrink arg = - case getType arg.curr of - "list" => shrink_list arg - | "number" => shrink_number arg - | "boolean" => shrink_bool arg - | "string" => shrink_string arg - | "record" => shrink_rec arg - | "tuple" => shrink_tuple arg - + let val shrinker = get_shrinker arg.curr in + shrinker arg end + and shrink_number rec = - case rec.state of + let val rec_checked = if rec.curr = 0 then {rec with state = "done"} else rec in + case rec_checked.state of "rollback" => - {state = "done", curr = rec.prev} + {state = "done", curr = rec_checked.prev} + |"done" => + rec_checked | _ => - let val newVal = if (abs_value rec.curr)-1 <= 0 then 0 else rec.curr/2 - val nextState = if newVal = 0 then "done" else "cont" in - {state = nextState, curr = newVal, prev = rec.curr} end + let val newVal = if (abs_value rec_checked.curr)-1 <= 0 then 0 else rec_checked.curr/2 in + {state = "cont", curr = newVal, prev = rec_checked.curr} end end - and shrink_bool n = - 3 + and shrink_bool rec = + let val rec_checked = if rec.curr = false then {rec with state = "done"} else rec in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec_checked.prev} + |"done" => + rec_checked + | _ => + let val newVal = false in + {state = "cont", curr = newVal, prev = rec_checked.curr} end end and shrink_string n = 3 @@ -219,52 +230,36 @@ CORE FUNCTIONALITY if (length rec.curr) = (length rec.prev) then {state = "done", curr = rec.prev} else {state = "cont_size", curr = rec.prev, idx = rec.idx} - and args_shrink args = case args.state of "rollback" => - let val rollbackReadyArgs = map (fn x => {x with state = "rollback"}) args.args + let val rollbackReadyArgs = map (fn x => if x.state = "done" then x else {x with state = "rollback"}) args.args val argsRolledBack = map (fn x => arg_shrink x) rollbackReadyArgs in {state = "cont", args = argsRolledBack} end |_ => let val newArgs = map (fn x => arg_shrink x) args.args val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in {state = nextState, args = newArgs} end - - - fun boolean_check x = - if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () - - fun function_not_done_check p = - if (getType p)<>"function" then report_error ("type_mismatch", 0) else () - -(* applies the list of arguments to the property - one by one - reporting errors along the way *) -(* TODO: handle when arguments are passed to a property that does not take arguments *) - fun apply_args p l = - case l of - [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) - | (x::xs) => - let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in - boolean_check res; - res end fun shrink_aux args prop counter = + if counter = 100 then report_error ("shrinking_looped", 0) else let val shrunk_args = args_shrink args val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args in - print "shrunk args raw-----------------"; - print shrunk_args_raw; + case apply_args prop shrunk_args_raw of true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop (counter+1) | false => if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop (counter+1) end - fun shrink args prop counter = + fun shrink args prop = let val newArgs = map (fn x => {state = "init", curr = x}) args - val res = shrink_aux ({state = "init", args = newArgs}) prop counter in - print "testing"; - res end - - + val res = shrink_aux ({state = "init", args = newArgs}) prop 0 in + res end +(* +-------------------------------- +CORE FUNCTIONALITY +-------------------------------- +*) fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} |core_forall (generator, prop, i, size, pre, cap) = let val args = map (fn x => x size) generator in @@ -298,7 +293,7 @@ CORE FUNCTIONALITY case res.failReason of () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true |_ => - let val shrink_res = shrink res.cEx prop 0 in + let val shrink_res = shrink res.cEx prop in report_fail_reason res noOfTests; write "\nFailing test case was shrunk to: "; write (args_toString shrink_res.shrunk_ctx); @@ -384,6 +379,11 @@ FUNCTIONS FOR TESTING fun bad_insert xs x = if length xs < 10 then append [x] xs else xs + + fun one_of_two (x, y) = + let val bool = bool_gen 0 in + if bool then x + else y end (* -------------------------------- PROPERTIES FOR TESTING @@ -434,7 +434,7 @@ PROPERTIES FOR TESTING fun both_ceil_test i = my_ceil_1 i = my_ceil_2 i - fun tup_test x y = x+y < 100 (* = w+z+y+x *) + fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) fun no_args() = true @@ -492,17 +492,18 @@ TC^2 tc [list(integer())] my_sort_is_ordered = true in -tc [list(integer()), integer()] test_bad_insert -(* (* tc^2 tests *) -troupecheck [] tc_sort_ordered_always_true *) + +(* tc^2 tests *) +(* tc [] tc_sort_ordered_always_true; *) (* User guide tests *) -(* tc [list(integer()), integer()] cons_length_increase; +tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; tc [list(integer())] (my_sort_keep_length, no_duplicates); (* General functionality tests *) tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [] no_args; +tc [list(integer()), integer()] test_bad_insert; tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; tc [boolean(), boolean()] bool_commutative; @@ -527,66 +528,5 @@ tc [float()] my_ceil_1_test; write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; -tc [float()] both_ceil_test *) -end - -(* ------------------------------------------ - Code that may need to beused later. ------------------------------------------ - *) - - (* fun le tup = - case tup of - (inf, _) => true - | (_, inf) => true - | (a,b) => a <= b - - fun find_limit x low high fallback = - case (le(low, x)) andalso (le(x, high)) of - true => x - |false => fallback - - fun sign x = - if x > 0 then 1 - else if x < 0 then -1 - else 0 - - fun find_target x low high = - case (le(low,0), le(0,high)) of - (false, _) => - let val limit = find_limit(x, low, high, high) in - (low, fn y => y + 1, fn y => y > limit) end - | (true,false) => - let val limit = find_limit(x, low, high, low) in - (high, fn y => y - 1, fn y => y < limit) end - | (true,true) => - let val sign = sign x - val overLimit = - case x >= 0 of - true => - let val limit = find_limit(x, low, high, high) in - fn y => y > limit end - | false => - let val limit = find_limit(x, low, high, low) in - fn y => y < Limit end in - (0, fn y => y + sign, overLimit) end - - fun number_shrinker x low high action = - case action.0 of - "init" => - let val (target, inc, overLimit) = find_target x low high in - case x = target of - true => ([], "done") - | false => ([target], ("inc", target, inc, overLimit)) end - | "inc" => - let val (last, inc, overLimit) = (action.1, action.2, action.3) - val newLast = inc last in - case overLimit newLast of - true => ([], "done") - | false => ([newLast], ("inc", newLast, inc, overLimit)) end - | "shrunk" => - ([], "done") - - fun get_shrinker arg = - number_shrinker *) +tc [float()] both_ceil_test +end \ No newline at end of file From a4daa2f3322f8e79bb436fb16f7aa7cf80a21d4b Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 3 Apr 2024 23:03:56 +0200 Subject: [PATCH 035/121] Updated the printing to console for shrinking + changed when the counter increases for shrinking --- troupecheck/tc.trp | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 130d7fb..8040d3a 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -247,7 +247,7 @@ SHRINKING val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args in case apply_args prop shrunk_args_raw of - true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop (counter+1) + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop (counter) | false => if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop (counter+1) end @@ -293,11 +293,12 @@ CORE FUNCTIONALITY case res.failReason of () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true |_ => - let val shrink_res = shrink res.cEx prop in report_fail_reason res noOfTests; - write "\nFailing test case was shrunk to: "; + write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); + let val shrink_res = shrink res.cEx prop in + write "\nFailing test case was shrunk to:\n"; write (args_toString shrink_res.shrunk_ctx); - write (" After " ^ (toString shrink_res.count) ^ " iterations.\n"); + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); false end end From f83ee60487a41c42605ed96dbdf2615ecb052edb Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 4 Apr 2024 11:01:04 +0200 Subject: [PATCH 036/121] Shrinking now ensures that preconditions are met --- troupecheck/tc.trp | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 8040d3a..917861a 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -241,19 +241,20 @@ SHRINKING val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in {state = nextState, args = newArgs} end - fun shrink_aux args prop counter = + fun shrink_aux args prop pre counter = if counter = 100 then report_error ("shrinking_looped", 0) else let val shrunk_args = args_shrink args - val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args in - - case apply_args prop shrunk_args_raw of - true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop (counter) + val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in + case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop pre (counter) | false => - if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop (counter+1) end + if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end - fun shrink args prop = + fun shrink args prop pre = let val newArgs = map (fn x => {state = "init", curr = x}) args - val res = shrink_aux ({state = "init", args = newArgs}) prop 0 in + val res = shrink_aux ({state = "init", args = newArgs}) prop pre 0 in + print res; res end (* -------------------------------- @@ -295,7 +296,7 @@ CORE FUNCTIONALITY |_ => report_fail_reason res noOfTests; write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); - let val shrink_res = shrink res.cEx prop in + let val shrink_res = shrink res.cEx prop pre in write "\nFailing test case was shrunk to:\n"; write (args_toString shrink_res.shrunk_ctx); write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); @@ -385,6 +386,9 @@ FUNCTIONS FOR TESTING let val bool = bool_gen 0 in if bool then x else y end + + fun bad_half n = + if n > 10 then n else n/2 (* -------------------------------- PROPERTIES FOR TESTING @@ -441,6 +445,9 @@ PROPERTIES FOR TESTING fun test_bad_insert xs x = length (bad_insert xs x) = (length xs) + 1 + + fun test_bad_half n = + n > (bad_half n) (* -------------------------------- @@ -493,18 +500,19 @@ TC^2 tc [list(integer())] my_sort_is_ordered = true in - +(* shrinking tests *) +tc [list(integer()), integer()] test_bad_insert; +tc [integer()] (test_bad_half, (fn x => x >= 15)) (* tc^2 tests *) (* tc [] tc_sort_ordered_always_true; *) (* User guide tests *) -tc [list(integer()), integer()] cons_length_increase; +(* tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); +tc [list(integer())] (my_sort_keep_length, no_duplicates); *) (* General functionality tests *) -tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [] no_args; -tc [list(integer()), integer()] test_bad_insert; tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; tc [boolean(), boolean()] bool_commutative; @@ -529,5 +537,5 @@ tc [float()] my_ceil_1_test; write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; -tc [float()] both_ceil_test +tc [float()] both_ceil_test *) end \ No newline at end of file From d6f130afbfc2eff3c532c515b0240622d7dfbba6 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 4 Apr 2024 12:33:48 +0200 Subject: [PATCH 037/121] String shrinking implemented Co-authored-by: Selma --- troupecheck/tc.trp | 44 ++++++++++++++++++++++++++++++++++++++------ 1 file changed, 38 insertions(+), 6 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 917861a..3b77f85 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -26,7 +26,8 @@ ERROR HANDLING | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" - | ("shrinking_looped", _) => "Shrinking looped\n" + | ("shrinking_looped", _) => "Shrinking looped.\n" + | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" in write (err_string ^ "\u001B[0m"); (* Changing the color back *) exit (authority, 0) end @@ -64,6 +65,20 @@ UTILS let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in boolean_check res; res end + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + fun list_to_string ls = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) (* -------------------------------- GENERATORS @@ -198,8 +213,15 @@ SHRINKING let val newVal = false in {state = "cont", curr = newVal, prev = rec_checked.curr} end end - and shrink_string n = - 3 + and shrink_string rec = + case rec.state of + "cont_elem" => + {rec with state = "done"} + | _ => + let val ls_of_string = string_to_list rec.curr + val interimRes = shrink_list {rec with curr = ls_of_string} + val res = {interimRes with curr = (list_to_string interimRes.curr)} in + res end and shrink_rec n = 3 @@ -229,6 +251,8 @@ SHRINKING | "rollback" => if (length rec.curr) = (length rec.prev) then {state = "done", curr = rec.prev} else {state = "cont_size", curr = rec.prev, idx = rec.idx} + | "done" => + rec and args_shrink args = case args.state of @@ -254,7 +278,6 @@ SHRINKING fun shrink args prop pre = let val newArgs = map (fn x => {state = "init", curr = x}) args val res = shrink_aux ({state = "init", args = newArgs}) prop pre 0 in - print res; res end (* -------------------------------- @@ -271,7 +294,7 @@ CORE FUNCTIONALITY | _ => if (apply_args pre args) then if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else {failReason = "false_prop", cEx = args, remTests = i} + else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) else (write "x"; if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) @@ -389,6 +412,10 @@ FUNCTIONS FOR TESTING fun bad_half n = if n > 10 then n else n/2 + + fun lengths_not_same s1 s2 = + (string_length s1) <> (string_length s2) + (* -------------------------------- PROPERTIES FOR TESTING @@ -448,6 +475,9 @@ PROPERTIES FOR TESTING fun test_bad_half n = n > (bad_half n) + + fun append_always_longer s1 s2 = + string_length s1 < string_length (s1 ^ s2) (* -------------------------------- @@ -502,7 +532,9 @@ in (* shrinking tests *) tc [list(integer()), integer()] test_bad_insert; -tc [integer()] (test_bad_half, (fn x => x >= 15)) +tc [integer()] (test_bad_half, (fn x => x >= 15)); +tc [string(), string()] (append_always_longer, lengths_not_same) + (* tc^2 tests *) (* tc [] tc_sort_ordered_always_true; *) (* User guide tests *) From e3efd4fca69ff61dfb2e5ffd0063576ed429be01 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 5 Apr 2024 14:10:50 +0200 Subject: [PATCH 038/121] updated all generators to return records with raw results and meta data - not sure it works yet --- troupecheck/tc.trp | 138 +++++++++++++++++++++++++-------------------- 1 file changed, 77 insertions(+), 61 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 3b77f85..daa4a2f 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -42,7 +42,6 @@ ERROR HANDLING UTILS -------------------------------- *) - fun remove_nth n [] i = [] | remove_nth n (x::xs) i = if n = i then xs @@ -51,7 +50,7 @@ UTILS fun make_list (f, i) = case i of 0 => [] - | _ => append [f()] (make_list (f, i-1)) + | _ => append [(f()).raw_inst] (make_list (f, i-1)) fun abs_value x = if x < 0 then -x else x @@ -62,7 +61,7 @@ UTILS case l of [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) | (x::xs) => - let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in (* x -> x.raw_inst - is that it? *) boolean_check res; res end @@ -79,6 +78,20 @@ UTILS fun string_length s = length (string_to_list s) + + fun report_fail_reason rec noOfTests= + case rec.failReason of + "false_prop" => + write "\nFailure at input: "; + write (args_toString rec.cEx); + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux recordExtend(r, n, v) ns vs in + aux {} names vals + end (* -------------------------------- GENERATORS @@ -94,20 +107,22 @@ GENERATORS let val x = random() val lInf = low = 1/0 (* check for inf *) val hInf = high = 1/0 - in - case (lInf, hInf) of - (true, true) => if (bool_gen size) then x*size else -x*size - | (true, false) => high - (x*size) - | (false, true) => low + (x*size) - | (false, false) => low + (x * (high-low)) - end + val raw_res = + case (lInf, hInf) of + (true, true) => if (bool_gen size) then x*size else -x*size + | (true, false) => high - (x*size) + | (false, true) => low + (x*size) + | (false, false) => low + (x * (high-low)) in + {raw_inst = raw_res, meta_data = (low, high)} + end fun int_gen (low, high) size = - floor (float_gen(low, high) size) + let val raw_res = floor ((float_gen(low, high) size).raw_inst) fun list_gen (generator) size = - let val length = (int_gen(0, size) size) in - make_list ((fn () => generator size), length) end + let val length = (int_gen(0, size) size).raw_inst + val raw_res = make_list ((fn () => generator size), length) in + {raw_inst = raw_res} end (* NOTE: Generates only letters (upper and lower case) and numbers. *) fun char_gen size = @@ -117,48 +132,53 @@ GENERATORS "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = int_gen (1, ((length chars)-1)) size in - nth chars x end + val x = (int_gen (1, ((length chars)-1)) size).raw_inst in + {raw_inst = (nth chars x)} end (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) fun string_gen size = - let val x = int_gen (0, size) size + let val x = (int_gen (0, size) size).raw_inst fun fold f acc 0 = acc | fold f acc i = fold f (acc ^ f()) (i-1) in - fold char_gen "" x end + {raw_inst = (fold char_gen "" x)} end (* NOTE: Hardcoded for tuple of up to 10 elements *) - fun tuple_gen ts i = - case ts of - [] => (0) - |[x] => (x) - |[x1,x2] => (x1,x2) - |[x1,x2,x3] => (x1,x2,x3) - |[x1,x2,x3,x4] => (x1,x2,x3,x4) - |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) - |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) - |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) - |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) - |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) - |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) - |_ => (2, 3, 4, 5) +(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list + of all generated values in raw_inst along with their respective meta_data. *) + fun tuple_gen ts size = + let fun tup_aux ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) + val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw_inst) ts_vals in + {raw_inst = (tup_aux ts_raw_vals), meta_data = ts_vals} end (* ns: list of strings - will be used as fieldnames ts: list of generators - used to generate values for fields + +Returns record: {raw_inst = <>, meta_data = (ns, <>)} *) - fun rec_gen ns ts = - let val noOfElems = length ts - in if (length ns) <> noOfElems then + fun rec_gen ns ts size = + if (length ns) <> (length ts) then report_error ("record_mismatch", 0) - else - case (ns, ts) of - ([],[]) => (fn i => {}) - | ((y::ys), (v::vs)) => - let fun record_aux (f, [], []) = f - | record_aux (f, (x::xs), (z::zs)) = record_aux ((fn i => recordExtend((f i), x, (z i))), xs, zs) - in - (record_aux ((fn i => recordExtend({}, y, (v i))), ys, vs)) end end + else + let val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw_inst) ts_vals + val raw_res = build_record ns ts_raw_vals in + {raw_inst = raw_res, meta_data = ts_vals} + end fun generator_gen size = @@ -301,19 +321,13 @@ CORE FUNCTIONALITY else if size = cap then {failReason = (), cEx = (), remTests = i} else core_forall (generator, prop, i, size+1, pre, cap)) end - - fun report_fail_reason rec noOfTests= - case rec.failReason of - "false_prop" => write "\nFailure at input: "; - write (args_toString rec.cEx); - write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") - fun tc_n generator p noOfTests = + fun tc_n generators p noOfTests = let val (prop, pre) = case p of (x,y) => (x,y) | x => (x, ()) - val res = core_forall (generator, prop, noOfTests, 0, pre, (noOfTests*5)) in + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in case res.failReason of () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true |_ => @@ -341,20 +355,20 @@ CONVENIENCE FUNCTIONS fun integer() = int_gen(inf, inf) | integer (h, l) = int_gen(h, l) - fun pos_integer() = int_gen(0, inf) + fun pos_integer() = integer(0, inf) - fun neg_integer() = int_gen(inf, -1) + fun neg_integer() = integer(inf, -1) fun float() = float_gen(inf, inf) | float(h, l) = float_gen(h, l) - fun pos_float() = float_gen(0, inf) + fun pos_float() = float(0, inf) - fun neg_float() = float_gen(inf, 0) + fun neg_float() = float(inf, 0) fun boolean() = bool_gen - fun list() = list_gen(generator_gen()) + fun list() = list_gen(generator_gen()) (* TODO: generator_gen() should return both raw_gen and meta_data *) |list(type) = list_gen(type) fun string() = string_gen @@ -533,17 +547,19 @@ in (* shrinking tests *) tc [list(integer()), integer()] test_bad_insert; tc [integer()] (test_bad_half, (fn x => x >= 15)); -tc [string(), string()] (append_always_longer, lengths_not_same) +tc [string(), string()] (append_always_longer, lengths_not_same); (* tc^2 tests *) (* tc [] tc_sort_ordered_always_true; *) + (* User guide tests *) -(* tc [list(integer()), integer()] cons_length_increase; +tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); *) +tc [list(integer())] (my_sort_keep_length, no_duplicates); + (* General functionality tests *) -(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [] no_args; tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; @@ -561,7 +577,7 @@ tc [float()] my_floor_test; write "\nTesting that my_count always return non-negative result:"; tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; write "\nTesting my_length:"; -tc [list()] my_length_test; +tc [list(integer())] my_length_test; write "\nTesting make_list:"; tc [pos_integer()] make_list_test; write "Testing on my_ceil_1:"; @@ -569,5 +585,5 @@ tc [float()] my_ceil_1_test; write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; -tc [float()] both_ceil_test *) +tc [float()] both_ceil_test end \ No newline at end of file From e63da5a913d1cb332cc9e9163593fe435b8b9a11 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 7 Apr 2024 17:14:30 +0200 Subject: [PATCH 039/121] shrinking of recs - implemented, but not working correctly (problems with rollback) --- troupecheck/tc.trp | 203 ++++++++++++++++++++++++++++++--------------- 1 file changed, 135 insertions(+), 68 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index daa4a2f..c342bd9 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -1,19 +1,19 @@ import lists (* -------------------------------- -PRINTING TO CONSOLE +PRINTING TO CONSOLE - q -------------------------------- *) let val out = getStdout authority fun write x = fwrite (out, x) (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) fun args_toString args = - let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) - | aux_toString acc (x::xs) = acc ^ (toString x) in + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0.raw_inst) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x.raw_inst) in aux_toString "" args end (* -------------------------------- -ERROR HANDLING +ERROR HANDLING - w -------------------------------- *) fun report_error error_reason = @@ -39,7 +39,7 @@ ERROR HANDLING if (getType p)<>"function" then report_error ("type_mismatch", 0) else () (* -------------------------------- -UTILS +UTILS - e -------------------------------- *) fun remove_nth n [] i = [] @@ -50,7 +50,7 @@ UTILS fun make_list (f, i) = case i of 0 => [] - | _ => append [(f()).raw_inst] (make_list (f, i-1)) + | _ => append [f()] (make_list (f, i-1)) fun abs_value x = if x < 0 then -x else x @@ -61,9 +61,10 @@ UTILS case l of [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) | (x::xs) => - let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in (* x -> x.raw_inst - is that it? *) + let val res = foldl (fn (x,y) => function_not_done_check y; y x.raw_inst) p l in boolean_check res; - res end + res + end fun string_to_list s = let fun aux "" acc = acc @@ -80,28 +81,29 @@ UTILS length (string_to_list s) fun report_fail_reason rec noOfTests= - case rec.failReason of - "false_prop" => - write "\nFailure at input: "; - write (args_toString rec.cEx); - write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") + case rec.failReason of + "false_prop" => + write "\nFailure at input: "; + write (args_toString rec.cEx); + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") fun build_record names vals = let fun aux r [] [] = r | aux r (n::ns) (v::vs) = - aux recordExtend(r, n, v) ns vs in + aux (recordExtend(r, n, v)) ns vs in aux {} names vals end (* -------------------------------- -GENERATORS +GENERATORS - r -------------------------------- *) fun bool_gen size = let val rnd = random() val res = if rnd < 1/2 then false else true in - res end + {raw_inst = res} + end fun float_gen (low, high) size = let val x = random() @@ -109,20 +111,24 @@ GENERATORS val hInf = high = 1/0 val raw_res = case (lInf, hInf) of - (true, true) => if (bool_gen size) then x*size else -x*size + (true, true) => if (bool_gen size).raw_inst then x*size else -x*size | (true, false) => high - (x*size) | (false, true) => low + (x*size) | (false, false) => low + (x * (high-low)) in - {raw_inst = raw_res, meta_data = (low, high)} + {raw_inst = raw_res, meta_data = (low, high)} end fun int_gen (low, high) size = - let val raw_res = floor ((float_gen(low, high) size).raw_inst) + let val raw_res = floor ((float_gen(low, high) size).raw_inst) in + {raw_inst = raw_res, meta_data = (low, high)} + end fun list_gen (generator) size = let val length = (int_gen(0, size) size).raw_inst - val raw_res = make_list ((fn () => generator size), length) in - {raw_inst = raw_res} end + val res = make_list ((fn () => generator size), length) + val raw_res = map (fn x => x.raw_inst) res in + {raw_inst = raw_res, meta_data = res} + end (* NOTE: Generates only letters (upper and lower case) and numbers. *) fun char_gen size = @@ -133,14 +139,16 @@ GENERATORS "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] val x = (int_gen (1, ((length chars)-1)) size).raw_inst in - {raw_inst = (nth chars x)} end + {raw_inst = (nth chars x)} + end (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) fun string_gen size = let val x = (int_gen (0, size) size).raw_inst fun fold f acc 0 = acc - | fold f acc i = fold f (acc ^ f()) (i-1) in - {raw_inst = (fold char_gen "" x)} end + | fold f acc i = fold f (acc ^ (f()).raw_inst) (i-1) in + {raw_inst = (fold char_gen "" x)} + end (* NOTE: Hardcoded for tuple of up to 10 elements *) (* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list @@ -162,7 +170,8 @@ GENERATORS |_ => (2, 3, 4, 5) val ts_vals = map (fn x => x size) ts val ts_raw_vals = map (fn x => x.raw_inst) ts_vals in - {raw_inst = (tup_aux ts_raw_vals), meta_data = ts_vals} end + {raw_inst = (tup_aux ts_raw_vals), meta_data = ts_vals} + end (* ns: list of strings - will be used as fieldnames @@ -177,7 +186,7 @@ Returns record: {raw_inst = <>, meta_data = (ns, < x size) ts val ts_raw_vals = map (fn x => x.raw_inst) ts_vals val raw_res = build_record ns ts_raw_vals in - {raw_inst = raw_res, meta_data = ts_vals} + {raw_inst = raw_res, meta_data = (ns, ts_vals)} end @@ -189,12 +198,12 @@ Returns record: {raw_inst = <>, meta_data = (ns, < float_gen(inf, inf) i)) else if rnd <= 4/7 then ((fn i => string_gen i)) else if rnd <= 5/7 then ((fn i => char_gen i)) else - if rnd <= 6/7 then ((fn i => tuple_gen (list_gen (fn _ => int_gen(inf, inf)) i) i)) else + if rnd <= 6/7 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf)), i)) i)) else ((fn i => list_gen (int_gen(inf, inf)) i)) in res end (* -------------------------------- -SHRINKING +SHRINKING - t -------------------------------- *) @@ -208,22 +217,27 @@ SHRINKING | "tuple" => shrink_tuple and arg_shrink arg = - let val shrinker = get_shrinker arg.curr in - shrinker arg end + let val shrinker = get_shrinker arg.curr.raw_inst in + shrinker arg + end and shrink_number rec = - let val rec_checked = if rec.curr = 0 then {rec with state = "done"} else rec in + let val rec_checked = if rec.curr.raw_inst = 0 then {rec with state = "done"} else rec + val curr_val = rec_checked.curr.raw_inst in case rec_checked.state of "rollback" => {state = "done", curr = rec_checked.prev} |"done" => rec_checked | _ => - let val newVal = if (abs_value rec_checked.curr)-1 <= 0 then 0 else rec_checked.curr/2 in - {state = "cont", curr = newVal, prev = rec_checked.curr} end end + let val new_raw_val = if (abs_value curr_val)-1 <= 0 then 0 else curr_val/2 + val new_val = {rec_checked.curr with raw_inst = new_raw_val} in + {state = "cont", curr = new_val, prev = rec_checked.curr} + end + end and shrink_bool rec = - let val rec_checked = if rec.curr = false then {rec with state = "done"} else rec in + let val rec_checked = if rec.curr.raw_inst = false then {rec with state = "done"} else rec in case rec_checked.state of "rollback" => {state = "done", curr = rec_checked.prev} @@ -231,46 +245,86 @@ SHRINKING rec_checked | _ => let val newVal = false in - {state = "cont", curr = newVal, prev = rec_checked.curr} end end + {state = "cont", curr = newVal, prev = rec_checked.curr} + end + end and shrink_string rec = case rec.state of "cont_elem" => {rec with state = "done"} | _ => - let val ls_of_string = string_to_list rec.curr - val interimRes = shrink_list {rec with curr = ls_of_string} - val res = {interimRes with curr = (list_to_string interimRes.curr)} in + let val curr_val = rec.curr.raw_inst + val ls_of_string = string_to_list curr_val + val curr_as_list = {rec.curr with raw_inst = ls_of_string} + val interimRes = shrink_list {rec with curr = curr_as_list} + val new_curr_string = {interimRes.curr with raw_inst = (list_to_string interimRes.curr.raw_inst)} + val res = {interimRes with curr = new_curr_string} in res end - and shrink_rec n = - 3 - + + and shrink_rec rec = + case rec.state of + "rollback" => + {state = "done", curr = rec.prev} + (* print "testing"; + let val curr_vals_ls = rec.curr.meta_data.1 + val curr_names = rec.curr.meta_data.0 + + val vals_rolled_back_rec = args_shrink {state = "rollback", args = map (fn x => {state = "init", curr = x}) curr_vals_ls} in + print vals_rolled_back_rec; + let val nextState = "done" + val vals_rolled_back = vals_rolled_back_rec.args + val raw_vals_rolled_back = map (fn x => x.raw_inst) vals_rolled_back + + val rolled_back_meta = (curr_names, vals_rolled_back) + val rolled_back_rec = build_record curr_names raw_vals_rolled_back + val rolled_back_res = {raw_inst = rolled_back_rec, meta_data = rolled_back_meta} in + {state = nextState, curr = rolled_back_res} end end *) + |"done" => + rec + | _ => + let val curr_vals_ls = rec.curr.meta_data.1 + val curr_names = rec.curr.meta_data.0 + + val shrunk_vals_rec = map (fn x => (arg_shrink {state = "init", curr = x})) curr_vals_ls + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true shrunk_vals_rec) then "done" else "cont" + val shrunk_vals = map (fn x => x.curr) shrunk_vals_rec + val raw_shrunk_vals = map (fn x => x.raw_inst) shrunk_vals + + val shrunk_meta = (curr_names, shrunk_vals) + val shrunk_rec = build_record curr_names raw_shrunk_vals + val shrunk_res = {raw_inst = shrunk_rec, meta_data = shrunk_meta} in + {state = nextState, curr = shrunk_res, prev = rec.curr} end + + and shrink_tuple n = 3 and shrink_list rec = - if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done"} + if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr} else case rec.state of "init" => - let val removeIdx = length rec.curr - 1 - val newList = remove_nth removeIdx rec.curr 0 in - {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx} end + let val removeIdx = (length (rec.curr.raw_inst)) - 1 + val newList = remove_nth removeIdx rec.curr.raw_inst 0 in + {state = "cont_size", curr = {rec.curr with raw_inst = newList}, prev = rec.curr, idx = removeIdx} end | "cont_size" => let val removeIdx = (rec.idx - 1) val nextState = if removeIdx <= 0 then "cont_elem" else "cont_size" - val newList = remove_nth removeIdx rec.curr 0 in - {state = nextState, curr = newList, prev = rec.curr, idx = removeIdx} end + val newList = remove_nth removeIdx rec.curr.raw_inst 0 in + {state = nextState, curr = {rec.curr with raw_inst = newList}, prev = rec.curr, idx = removeIdx} end | "cont_elem" => - let val shrinker = get_shrinker (nth rec.curr 1) - val interimList = (map (fn x => shrinker {state = "init", curr = x}) rec.curr) + let val shrinker = get_shrinker (nth rec.curr.raw_inst 1) + val interimList = (map (fn x => shrinker {state = "init", curr = x}) rec.curr.meta_data) val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interimList) then "done" else "cont_elem" - val newList = map (fn x => x.curr) interimList in - {state = nextState, curr = newList, prev = rec.curr, idx = rec.idx} end + val newList = map (fn x => x.curr) interimList + val newList_raw = map (fn x => x.raw_inst) newList in + {state = nextState, curr = {raw_inst = newList_raw, meta_data = newList}, prev = rec.curr, idx = rec.idx} end | "rollback" => - if (length rec.curr) = (length rec.prev) then {state = "done", curr = rec.prev} - else {state = "cont_size", curr = rec.prev, idx = rec.idx} + print rec; + if (length rec.curr.raw_inst) = (length rec.prev.raw_inst) then {state = "done", curr = rec.prev, prev = rec.prev} (* TODO: this loops an unecesary amount of times *) + else {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx} | "done" => rec @@ -287,7 +341,7 @@ SHRINKING fun shrink_aux args prop pre counter = if counter = 100 then report_error ("shrinking_looped", 0) else - let val shrunk_args = args_shrink args + let val shrunk_args = args_shrink args val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of @@ -301,7 +355,7 @@ SHRINKING res end (* -------------------------------- -CORE FUNCTIONALITY +CORE FUNCTIONALITY - a -------------------------------- *) fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} @@ -348,7 +402,7 @@ CORE FUNCTIONALITY (* -------------------------------- -CONVENIENCE FUNCTIONS +CONVENIENCE FUNCTIONS - s -------------------------------- *) val inf = 1 / 0 @@ -382,7 +436,7 @@ CONVENIENCE FUNCTIONS (* -------------------------------- -FUNCTIONS FOR TESTING +FUNCTIONS FOR TESTING - d -------------------------------- *) fun my_reverse xs = @@ -420,7 +474,7 @@ FUNCTIONS FOR TESTING xs fun one_of_two (x, y) = - let val bool = bool_gen 0 in + let val bool = (bool_gen 0).raw_inst in if bool then x else y end @@ -432,7 +486,7 @@ FUNCTIONS FOR TESTING (* -------------------------------- -PROPERTIES FOR TESTING +PROPERTIES FOR TESTING - f -------------------------------- *) fun bool_commutative x y = @@ -445,7 +499,7 @@ PROPERTIES FOR TESTING reverse(reverse xs) = xs fun int_gen_stays_in_interval i = - int_gen (0, i) i <= i + (integer(0, i) i).raw_inst <= i fun abs_value_is_always_pos i = abs_value i >= 0 @@ -457,7 +511,10 @@ PROPERTIES FOR TESTING my_length xs = length xs fun make_list_test i = - length (make_list ((fn () => (generator_gen i) (int_gen(0,inf) i)), i)) = i + let val generator = generator_gen i + fun f() = generator ((int_gen(0, inf) i).raw_inst) + val ls = (make_list (f, i)) in + (length ls) = i end fun my_count_returns_non_negative_int x xs = (my_count x xs) >= 0 @@ -492,10 +549,13 @@ PROPERTIES FOR TESTING fun append_always_longer s1 s2 = string_length s1 < string_length (s1 ^ s2) + + fun record_shrink_test r = + r.theInteger < 50 (* -------------------------------- -USED FOR USERGUIDE +USED FOR USERGUIDE - g -------------------------------- *) fun filter_less ([], _) = [] @@ -534,7 +594,7 @@ USED FOR USERGUIDE (length (x::xs)) = ((length xs) + 1) (* -------------------------------- -TC^2 +TC^2 - z -------------------------------- *) fun tc_sort_length_always_fails () = @@ -544,22 +604,29 @@ TC^2 tc [list(integer())] my_sort_is_ordered = true in -(* shrinking tests *) +(* +-------------------------------- +ALL TESTS - x +-------------------------------- +*) + +(* shrinking tests - x *) tc [list(integer()), integer()] test_bad_insert; tc [integer()] (test_bad_half, (fn x => x >= 15)); tc [string(), string()] (append_always_longer, lengths_not_same); +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test (* tc^2 tests *) (* tc [] tc_sort_ordered_always_true; *) (* User guide tests *) -tc [list(integer()), integer()] cons_length_increase; +(* tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); +tc [list(integer())] (my_sort_keep_length, no_duplicates); *) (* General functionality tests *) -tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [] no_args; tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; @@ -585,5 +652,5 @@ tc [float()] my_ceil_1_test; write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; -tc [float()] both_ceil_test +tc [float()] both_ceil_test *) end \ No newline at end of file From 71fc64624e01d5348d46ee3566eb976d8b06f996 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 9 Apr 2024 22:21:31 +0200 Subject: [PATCH 040/121] Started work in integrated shrinking --- troupecheck/integrated_shrinking_tc.trp | 719 ++++++++++++++++++++++++ 1 file changed, 719 insertions(+) create mode 100644 troupecheck/integrated_shrinking_tc.trp diff --git a/troupecheck/integrated_shrinking_tc.trp b/troupecheck/integrated_shrinking_tc.trp new file mode 100644 index 0000000..40481c2 --- /dev/null +++ b/troupecheck/integrated_shrinking_tc.trp @@ -0,0 +1,719 @@ +import lists +(* +-------------------------------- +PRINTING TO CONSOLE - q +-------------------------------- +*) +let val out = getStdout authority + fun write x = fwrite (out, x) + (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) + fun args_toString args = + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x) in + aux_toString "" args end +(* +-------------------------------- +ERROR HANDLING - w +-------------------------------- +*) + fun report_error error_reason = + write "\u001B[31m \nError: "; (* Changing the print color to red *) + let val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + | ("shrinking_looped", _) => "Shrinking looped.\n" + | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" + in + write (err_string ^ "\u001B[0m"); (* Changing the color back *) + exit (authority, 0) end + + fun boolean_check x = + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () + + fun function_not_done_check p = + if (getType p)<>"function" then report_error ("type_mismatch", 0) else () +(* +-------------------------------- +UTILS - e +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + + fun abs_value x = + if x < 0 then -x else x + +(* applies the list of arguments to the property - one by one - reporting errors along the way *) +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l = + case l of + [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in + boolean_check res; + res + end + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + fun list_to_string ls = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) + + fun report_fail_reason rec noOfTests= + case rec.failReason of + "false_prop" => + write "\nFailure at input: "; + write (args_toString (map (fn x => x.raw) rec.cEx)); + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) +(* +-------------------------------- +SHRINKING - t +-------------------------------- +*) + + and shrink_float rec = + let val rec_checked = if rec.curr = 0 then {rec with state = "done"} else rec + val curr_val = rec_checked.curr + in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} + |"done" => + rec_checked + | _ => + let val new_raw_val = if (abs_value curr_val)-1 <= 0 then 0 else curr_val/2 + in + {state = "cont", curr = new_raw_val, prev = rec_checked.curr} + end + end + + and shrink_int rec = + let val interim = shrink_float rec + in + {interim with curr = floor(interim.curr)} + end + + and shrink_bool rec = + let val rec_checked = if rec.curr = false then {rec with state = "done"} else rec + in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} + |"done" => + rec_checked + | _ => + let val newVal = false + in + {state = "cont", curr = newVal, prev = rec_checked.curr} + end + end + + (* input/returns - {state: string, curr: string, prev: string} *) + and shrink_string rec = + case rec.state of + "cont_elem" => + {rec with state = "done"} + | _ => + let val ls_curr = string_to_list rec.curr + val ls_prev = string_to_list rec.prev + + val interim_res = shrink_list {state = rec.state, curr = ls_curr, prev = ls_prev} + val new_curr = list_to_string interim_res.curr + val new_prev = list_to_string interim_res.prev + + val res = {state = interim_res.state, curr = new_curr, prev = new_prev} + in + res + end + + and shrink_char chars rec = + let val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec + val curr_val = rec_checked.curr in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} + | "done" => + rec_checked + | "init" => + let val index_of_new = (lookup chars rec.curr 2) - 1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + | _ => + let val index_of_new = rec.idx-1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + end + + + and shrink_rec names vals rec = + case rec.state of + "rollback" => + let fun rollback_aux (i, x) = + let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} + in + x.shrinker val_to_shrink + end + val args_rolled_back = mapi rollback_aux vals + val new_raw_vals = map (fn x => x.curr) args_rolled_back + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" + in + {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back} + end + | "init" => + let val new_vals = mapi (fn (i, x) => x.shrinker {state = "init", curr = x.raw, prev = x.raw}) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + in + {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + end + + | "done" => + rec + | _ => + let val new_vals = mapi (fn (i, x) => x.shrinker (nth rec.next_shrink_info (i+1))) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + in + {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + end + + (* input - vals: list, rec: {state: string, curr: tuple, prev: tuple} + returns - {state: string, curr: tuple, prev: tuple, next_shrink_info: list} *) + and shrink_tuple shrinkers rec = + case rec.state of + "done" => + rec + | "rollback" => + let val args_rolled_back = mapi (fn (i, x) => x {state = "rollback", curr = rec.curr.i, prev = rec.prev.i}) shrinkers + val new_raw_vals = map (fn x => x.curr) args_rolled_back + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" + in + {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back} + end + | "init" => + let val new_vals = mapi (fn (i, x) => x {state = "init", curr = rec.curr.i, prev = rec.prev.i}) shrinkers + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + in + {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + end + | "cont" => + let val new_vals = mapi (fn (i, x) => x (nth rec.next_shrink_info (i+1))) shrinkers + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + in + {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + end + + and shrink_list shrinkers rec = + if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr} + else + case rec.state of + "init" => + let val removeIdx = (length (rec.curr)) - 1 + val newList = remove_nth removeIdx rec.curr 0 + in + {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx} + end + | "cont_size" => + let val remove_idx = (rec.idx - 1) + val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" + val new_list = remove_nth remove_idx rec.curr 0 + in + {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx} + end + | "cont_elem" => + (* TODO: give list of shrinkers in the list_gen rec.curr should be list of raw elements *) + let val interim_list = mapi (fn (i, x) => (nth shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr + val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" + val new_list = map (fn x => x.curr) interim_list + in + {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx} + end + | "rollback" => + if (length rec.curr) = (length rec.prev) then + {state = "done", curr = rec.prev, prev = rec.curr} (* TODO: this loops an unecesary amount of times *) + else + {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx} + | "done" => + rec + + and args_shrink args = + case args.state of + "rollback" => + let val rollbackReadyArgs = map (fn x => if x.state = "done" then x else {x with state = "rollback"}) args.args + val argsRolledBack = map (fn x => x.shrinker x.raw) rollbackReadyArgs in + {state = "cont", args = argsRolledBack} end + |_ => + let val newArgs = map (fn x => x.shrinker x.raw) args.args + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in + {state = nextState, args = newArgs} end + + fun shrink_aux args prop pre counter = + if counter = 100 then report_error ("shrinking_looped", 0) else + let val shrunk_args = args_shrink args + val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in + case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop pre (counter) + | false => + if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end + + fun shrink args prop pre = + let val res = shrink_aux args prop pre 0 + in res end +(* +-------------------------------- +GENERATORS - r +-------------------------------- +*) + (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) + fun bool_gen size = + let val rnd = random() + val res = if rnd < 1/2 then false + else true + in + {raw = res, shrinker = shrink_bool} + end + + (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) + (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) + fun float_gen (low, high) size = + let val x = random() + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + val raw_res = + case (lInf, hInf) of + (true, true) => if (bool_gen size).raw then x*size else -x*size + | (true, false) => high - (x*size) + | (false, true) => low + (x*size) + | (false, false) => low + (x * (high-low)) + in + {raw = raw_res, shrinker = shrink_float} + end + + (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) + fun int_gen (low, high) size = + let val raw_res = floor ((float_gen(low, high) size).raw) + in + {raw = raw_res, shrinker = shrink_int} + end + + (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) + fun list_gen (generator) size = + let val length = (int_gen(0, size) size).raw + val res = make_list ((fn () => generator size), length) + val raw_res = map (fn x => x.raw) res + val shrinkers = map (fn x => x.shrinker) res in + {raw = raw_res, shrinker = shrink_list shrinkers} + end + + (* NOTE: Generates only letters (upper and lower case) and numbers. *) + (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) + fun char_gen size = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = (int_gen (1, ((length chars)-1)) size).raw + in + {raw = (nth chars x), shrinker = shrink_char chars} + end + +(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) + fun string_gen size = + {raw = (foldl (fn (x,y) => (char_gen x).raw ^ y) "" size), shrinker = shrink_string} + +(* NOTE: Hardcoded for tuple of up to 10 elements *) +(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list + of all generated values in raw_inst along with their respective meta_data. *) + fun tuple_gen ts size = + let val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw) ts_vals + val ts_shrinkers = map (fn x => x.shrinker) ts_vals + in + {raw = (build_tuple ts_raw_vals), shrinker = shrink_tuple ts_shrinkers} + end + +(* +ns: list of strings - will be used as fieldnames +ts: list of generators - used to generate values for fields + +Returns record: {raw_inst = <>, meta_data = (ns, <>)} +*) + fun rec_gen ns ts size = + if (length ns) <> (length ts) then + report_error ("record_mismatch", 0) + else + let val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw) ts_vals + val raw_res = build_record ns ts_raw_vals + in + {raw = raw_res, shrinker = shrink_rec ns ts_vals} + end + + + fun generator_gen size = + let val rnd = random() + val inf = 1/0 + val res = if rnd <= 1/7 then ((fn i => int_gen(inf, inf) i)) else + if rnd <= 2/7 then ((fn i => bool_gen i)) else + if rnd <= 3/7 then ((fn i => float_gen(inf, inf) i)) else + if rnd <= 4/7 then ((fn i => string_gen i)) else + if rnd <= 5/7 then ((fn i => char_gen i)) else + if rnd <= 6/7 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf)), i)) i)) else + ((fn i => list_gen (int_gen(inf, inf)) i)) in + res end + +(* +-------------------------------- +CORE FUNCTIONALITY - a +-------------------------------- +*) + fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} + |core_forall (generator, prop, i, size, pre, cap) = + let val args = map (fn x => x size) generator + val raw_args = map (fn x => x.raw) args in + case pre of + () => + if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) + | _ => + if (apply_args pre raw_args) then + if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) + else + (write "x"; + if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) + else if size = cap then {failReason = (), cEx = (), remTests = i} + else core_forall (generator, prop, i, size+1, pre, cap)) + end + + fun tc_n generators p noOfTests = + let val (prop, pre) = + case p of + (x,y) => (x,y) + | x => (x, ()) + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in + case res.failReason of + () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true + |_ => + report_fail_reason res noOfTests; + write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); + let val shrink_res = shrink res.cEx prop pre in + write "\nFailing test case was shrunk to:\n"; + write (args_toString shrink_res.shrunk_ctx); + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); + false + end + end + + fun tc generator p = tc_n generator p 100 + + fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) + | troupecheck generator p = spawn (fn() => tc generator p) + +(* +-------------------------------- +CONVENIENCE FUNCTIONS - s +-------------------------------- +*) + val inf = 1 / 0 + fun integer() = int_gen(inf, inf) + | integer (h, l) = int_gen(h, l) + + fun pos_integer() = integer(0, inf) + + fun neg_integer() = integer(inf, -1) + + fun float() = float_gen(inf, inf) + | float(h, l) = float_gen(h, l) + + fun pos_float() = float(0, inf) + + fun neg_float() = float(inf, 0) + + fun boolean() = bool_gen + + fun list() = list_gen(generator_gen()) (* TODO: generator_gen() should return both raw_gen and meta_data *) + |list(type) = list_gen(type) + + fun string() = string_gen + + fun char() = char_gen + + fun tuple ts = tuple_gen ts + + fun record ns ts = rec_gen ns ts + + +(* +-------------------------------- +FUNCTIONS FOR TESTING - d +-------------------------------- +*) + fun my_reverse xs = + xs + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_length [] = 0 + | my_length (x::xs) = 1 + (my_length xs) + + fun my_count y [] = 0 + | my_count y (x::xs) = + let val z = + if y = x then 1 else 0 + in + z + my_count y xs end + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_ceil_1 i = + if i > 0 then i + (1 - (i mod 1)) + else i + (1 - (i mod 1)) - 1 + + fun my_ceil_2 i = + if i > 0 then (my_floor i) + 1 + else if i = 0 then 0 + else (my_floor i) + 1 + + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs + + fun one_of_two (x, y) = + let val bool = (bool_gen 0).raw in + if bool then x + else y end + + fun bad_half n = + if n > 10 then n else n/2 + + fun lengths_not_same s1 s2 = + (string_length s1) <> (string_length s2) + +(* +-------------------------------- +PROPERTIES FOR TESTING - f +-------------------------------- +*) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + + fun number_commutative x y = + x * y = y * x + + fun list_reverse xs = + reverse(reverse xs) = xs + + fun int_gen_stays_in_interval i = + (integer(0, i) i).raw <= i + + fun abs_value_is_always_pos i = + abs_value i >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_length_test xs = + my_length xs = length xs + + fun make_list_test i = + let val generator = generator_gen i + fun f() = generator ((int_gen(0, inf) i).raw) + val ls = (make_list (f, i)) in + (length ls) = i end + + fun my_count_returns_non_negative_int x xs = + (my_count x xs) >= 0 + + fun rec_test rec i = + {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} + + fun pre_pos x = + x >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_ceil_1_test i = + my_ceil_1 i = ceil i + + fun my_ceil_2_test i = + my_ceil_2 i = ceil i + + fun both_ceil_test i = + my_ceil_1 i = my_ceil_2 i + + fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) + + fun no_args() = true + + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + + fun test_bad_half n = + n > (bad_half n) + + fun append_always_longer s1 s2 = + string_length s1 < string_length (s1 ^ s2) + + fun record_shrink_test r = + r.theInteger < 50 + +(* +-------------------------------- +USED FOR USERGUIDE - g +-------------------------------- +*) + fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + + fun ordered [] = true + | ordered (x::[]) = true + | ordered (x::y::ys) = + if x <= y then ordered (y::ys) else false + + fun my_sort_is_ordered xs = + ordered (my_quicksort xs) + + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + + fun pre_list_size_greater_than_one xs = + if (length xs) <= 1 then false else true + + fun no_duplicates[] = true + | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs + + fun cons_length_increase xs x = + (length (x::xs)) = ((length xs) + 1) +(* +-------------------------------- +TC^2 - z +-------------------------------- +*) + fun tc_sort_length_always_fails () = + tc [list(integer())] my_sort_keep_length = false + + fun tc_sort_ordered_always_true () = + tc [list(integer())] my_sort_is_ordered = true +in + +(* +-------------------------------- +ALL TESTS - x +-------------------------------- +*) + +(* shrinking tests - x *) +tc [list(integer()), integer()] test_bad_insert; +tc [integer()] (test_bad_half, (fn x => x >= 15)); +tc [string(), string()] (append_always_longer, lengths_not_same); +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test + +(* tc^2 tests *) +(* tc [] tc_sort_ordered_always_true; *) + +(* User guide tests *) +(* tc [list(integer()), integer()] cons_length_increase; +tc [list(integer())] my_sort_is_ordered; +tc [list(integer())] my_sort_keep_length; +tc [list(integer())] (my_sort_keep_length, no_duplicates); *) + +(* General functionality tests *) +(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +tc [] no_args; +tc [integer(), integer(), integer(), integer()] tup_test; +write "\nTesting on bools commutative:"; +tc [boolean(), boolean()] bool_commutative; +write "\nTesting on numbers commutative:"; +tc [integer(), integer()] number_commutative; +write "\nTesting on list reverse:"; +tc [list(integer())] list_reverse; +write "\nTesting on int_gen interval:"; +tc [integer()] (int_gen_stays_in_interval, pre_pos); +write "\nTesting on abs_value:"; +tc [one_of_two (integer(), float())] abs_value_is_always_pos; +write "\nTesting on my_floor:"; +tc [float()] my_floor_test; +write "\nTesting that my_count always return non-negative result:"; +tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; +write "\nTesting my_length:"; +tc [list(integer())] my_length_test; +write "\nTesting make_list:"; +tc [pos_integer()] make_list_test; +write "Testing on my_ceil_1:"; +tc [float()] my_ceil_1_test; +write "Testing on my_ceil_2:"; +tc [float()] my_ceil_2_test; +write "Testing on both ceil functions:"; +tc [float()] both_ceil_test *) +end \ No newline at end of file From 3758ade7e73e56694349cf1c04da59b2fd5a6fe5 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 10 Apr 2024 11:40:03 +0200 Subject: [PATCH 041/121] integrated shrinking updated - needs work on string shrinking in records Co-authored-by: Selma --- troupecheck/integrated_shrinking_tc.trp | 61 ++++++++++++++++--------- 1 file changed, 40 insertions(+), 21 deletions(-) diff --git a/troupecheck/integrated_shrinking_tc.trp b/troupecheck/integrated_shrinking_tc.trp index 40481c2..469c655 100644 --- a/troupecheck/integrated_shrinking_tc.trp +++ b/troupecheck/integrated_shrinking_tc.trp @@ -153,24 +153,34 @@ SHRINKING - t (* input/returns - {state: string, curr: string, prev: string} *) and shrink_string rec = - case rec.state of + let val rec_checked = if rec.state = "init" then {rec with next_shrink_info = 0} else rec in + case rec_checked.state of "cont_elem" => - {rec with state = "done"} + {rec_checked with state = "done"} (* TODO: Should actually shrink characters *) | _ => - let val ls_curr = string_to_list rec.curr - val ls_prev = string_to_list rec.prev + let val ls_curr = string_to_list rec_checked.curr + val ls_prev = string_to_list rec_checked.prev + val shrinkers = map (fn _ => shrink_char) ls_curr - val interim_res = shrink_list {state = rec.state, curr = ls_curr, prev = ls_prev} + val interim_res = shrink_list shrinkers {state = rec_checked.state, curr = ls_curr, prev = ls_prev, idx = rec_checked.next_shrink_info} val new_curr = list_to_string interim_res.curr val new_prev = list_to_string interim_res.prev - val res = {state = interim_res.state, curr = new_curr, prev = new_prev} + val res = {state = interim_res.state, curr = new_curr, prev = new_prev, next_shrink_info = interim_res.idx} in res end + end + - and shrink_char chars rec = - let val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec + and shrink_char rec = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec val curr_val = rec_checked.curr in case rec_checked.state of "rollback" => @@ -253,7 +263,7 @@ SHRINKING - t end and shrink_list shrinkers rec = - if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr} + if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr, idx = 0} else case rec.state of "init" => @@ -279,7 +289,7 @@ SHRINKING - t end | "rollback" => if (length rec.curr) = (length rec.prev) then - {state = "done", curr = rec.prev, prev = rec.curr} (* TODO: this loops an unecesary amount of times *) + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} (* TODO: this loops an unecesary amount of times *) else {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx} | "done" => @@ -289,12 +299,12 @@ SHRINKING - t case args.state of "rollback" => let val rollbackReadyArgs = map (fn x => if x.state = "done" then x else {x with state = "rollback"}) args.args - val argsRolledBack = map (fn x => x.shrinker x.raw) rollbackReadyArgs in - {state = "cont", args = argsRolledBack} end - |_ => - let val newArgs = map (fn x => x.shrinker x.raw) args.args + val argsRolledBack = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) rollbackReadyArgs in + {state = "cont", args = argsRolledBack, shrinkers = args.shrinkers} end + | _ => + let val newArgs = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) args.args val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in - {state = nextState, args = newArgs} end + {state = nextState, args = newArgs, shrinkers = args.shrinkers} end fun shrink_aux args prop pre counter = if counter = 100 then report_error ("shrinking_looped", 0) else @@ -302,12 +312,15 @@ SHRINKING - t val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of - true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop pre (counter) + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers}) prop pre (counter) | false => if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end fun shrink args prop pre = - let val res = shrink_aux args prop pre 0 + let val shrinkers = map (fn x => x.shrinker) args + val args_shrink_ready = map (fn x => {state = "init", curr = x.raw, prev = x.raw}) args + val args_rec = {state = "init", args = args_shrink_ready, shrinkers = shrinkers} + val res = shrink_aux args_rec prop pre 0 in res end (* -------------------------------- @@ -366,13 +379,19 @@ GENERATORS - r "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] val x = (int_gen (1, ((length chars)-1)) size).raw in - {raw = (nth chars x), shrinker = shrink_char chars} + {raw = (nth chars x), shrinker = shrink_char} end (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) fun string_gen size = - {raw = (foldl (fn (x,y) => (char_gen x).raw ^ y) "" size), shrinker = shrink_string} + let val x = (int_gen (0, size) size).raw + fun fold f acc 0 = acc + | fold f acc i = fold f (acc ^ (f())) (i-1) + val raw_string = (fold (fn () => (char_gen x).raw) "" x) + in + {raw = raw_string, shrinker = shrink_string} + end (* NOTE: Hardcoded for tuple of up to 10 elements *) (* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list @@ -674,8 +693,8 @@ ALL TESTS - x *) (* shrinking tests - x *) -tc [list(integer()), integer()] test_bad_insert; -tc [integer()] (test_bad_half, (fn x => x >= 15)); +(* tc [list(integer()), integer()] test_bad_insert; +tc [integer()] (test_bad_half, (fn x => x >= 15)); *) tc [string(), string()] (append_always_longer, lengths_not_same); tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test From 32209ebb677c8c8c42b5a37eec0ffc475f4d1a0c Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 10 Apr 2024 11:58:40 +0200 Subject: [PATCH 042/121] Just before changing record_shrinking to be done one field at a time --- troupecheck/integrated_shrinking_tc.trp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/troupecheck/integrated_shrinking_tc.trp b/troupecheck/integrated_shrinking_tc.trp index 469c655..c6a4028 100644 --- a/troupecheck/integrated_shrinking_tc.trp +++ b/troupecheck/integrated_shrinking_tc.trp @@ -161,7 +161,7 @@ SHRINKING - t let val ls_curr = string_to_list rec_checked.curr val ls_prev = string_to_list rec_checked.prev val shrinkers = map (fn _ => shrink_char) ls_curr - + val _ = print rec_checked val interim_res = shrink_list shrinkers {state = rec_checked.state, curr = ls_curr, prev = ls_prev, idx = rec_checked.next_shrink_info} val new_curr = list_to_string interim_res.curr val new_prev = list_to_string interim_res.prev From e399e8cc4e821106e443c2a5075c609f67da5efa Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 10 Apr 2024 12:21:07 +0200 Subject: [PATCH 043/121] integrated shrinking moved to TC file - records now shrink properly --- troupecheck/integrated_shrinking_tc.trp | 738 ------------------------ troupecheck/tc.trp | 497 +++++++++------- 2 files changed, 295 insertions(+), 940 deletions(-) delete mode 100644 troupecheck/integrated_shrinking_tc.trp diff --git a/troupecheck/integrated_shrinking_tc.trp b/troupecheck/integrated_shrinking_tc.trp deleted file mode 100644 index c6a4028..0000000 --- a/troupecheck/integrated_shrinking_tc.trp +++ /dev/null @@ -1,738 +0,0 @@ -import lists -(* --------------------------------- -PRINTING TO CONSOLE - q --------------------------------- -*) -let val out = getStdout authority - fun write x = fwrite (out, x) - (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) - fun args_toString args = - let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) - | aux_toString acc (x::xs) = acc ^ (toString x) in - aux_toString "" args end -(* --------------------------------- -ERROR HANDLING - w --------------------------------- -*) - fun report_error error_reason = - write "\u001B[31m \nError: "; (* Changing the print color to red *) - let val err_string = case error_reason of - ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " - ^ (toString tries) ^ " tries.\n" - | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" - | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" - | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" - | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" - | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" - | ("shrinking_looped", _) => "Shrinking looped.\n" - | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" - in - write (err_string ^ "\u001B[0m"); (* Changing the color back *) - exit (authority, 0) end - - fun boolean_check x = - if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () - - fun function_not_done_check p = - if (getType p)<>"function" then report_error ("type_mismatch", 0) else () -(* --------------------------------- -UTILS - e --------------------------------- -*) - fun remove_nth n [] i = [] - | remove_nth n (x::xs) i = - if n = i then xs - else x :: (remove_nth n xs (i + 1)) - - fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) - - fun abs_value x = - if x < 0 then -x else x - -(* applies the list of arguments to the property - one by one - reporting errors along the way *) -(* TODO: handle when arguments are passed to a property that does not take arguments *) - fun apply_args p l = - case l of - [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) - | (x::xs) => - let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in - boolean_check res; - res - end - - fun string_to_list s = - let fun aux "" acc = acc - | aux s acc = - let val x = substring (s, 0, 1) - val xs = substring (s, 1, 1/0) in - aux xs (append acc [x]) end in - aux s [] end - - fun list_to_string ls = - foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls - - fun string_length s = - length (string_to_list s) - - fun report_fail_reason rec noOfTests= - case rec.failReason of - "false_prop" => - write "\nFailure at input: "; - write (args_toString (map (fn x => x.raw) rec.cEx)); - write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") - - fun build_record names vals = - let fun aux r [] [] = r - | aux r (n::ns) (v::vs) = - aux (recordExtend(r, n, v)) ns vs in - aux {} names vals - end - - fun build_tuple ls = - case ls of - [] => (0) - |[x] => (x) - |[x1,x2] => (x1,x2) - |[x1,x2,x3] => (x1,x2,x3) - |[x1,x2,x3,x4] => (x1,x2,x3,x4) - |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) - |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) - |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) - |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) - |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) - |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) - |_ => (2, 3, 4, 5) -(* --------------------------------- -SHRINKING - t --------------------------------- -*) - - and shrink_float rec = - let val rec_checked = if rec.curr = 0 then {rec with state = "done"} else rec - val curr_val = rec_checked.curr - in - case rec_checked.state of - "rollback" => - {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} - |"done" => - rec_checked - | _ => - let val new_raw_val = if (abs_value curr_val)-1 <= 0 then 0 else curr_val/2 - in - {state = "cont", curr = new_raw_val, prev = rec_checked.curr} - end - end - - and shrink_int rec = - let val interim = shrink_float rec - in - {interim with curr = floor(interim.curr)} - end - - and shrink_bool rec = - let val rec_checked = if rec.curr = false then {rec with state = "done"} else rec - in - case rec_checked.state of - "rollback" => - {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} - |"done" => - rec_checked - | _ => - let val newVal = false - in - {state = "cont", curr = newVal, prev = rec_checked.curr} - end - end - - (* input/returns - {state: string, curr: string, prev: string} *) - and shrink_string rec = - let val rec_checked = if rec.state = "init" then {rec with next_shrink_info = 0} else rec in - case rec_checked.state of - "cont_elem" => - {rec_checked with state = "done"} (* TODO: Should actually shrink characters *) - | _ => - let val ls_curr = string_to_list rec_checked.curr - val ls_prev = string_to_list rec_checked.prev - val shrinkers = map (fn _ => shrink_char) ls_curr - val _ = print rec_checked - val interim_res = shrink_list shrinkers {state = rec_checked.state, curr = ls_curr, prev = ls_prev, idx = rec_checked.next_shrink_info} - val new_curr = list_to_string interim_res.curr - val new_prev = list_to_string interim_res.prev - - val res = {state = interim_res.state, curr = new_curr, prev = new_prev, next_shrink_info = interim_res.idx} - in - res - end - end - - - and shrink_char rec = - let val chars = - ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", - "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", - "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec - val curr_val = rec_checked.curr in - case rec_checked.state of - "rollback" => - {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} - | "done" => - rec_checked - | "init" => - let val index_of_new = (lookup chars rec.curr 2) - 1 - val new_char = nth chars index_of_new - in - {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} - end - | _ => - let val index_of_new = rec.idx-1 - val new_char = nth chars index_of_new - in - {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} - end - end - - - and shrink_rec names vals rec = - case rec.state of - "rollback" => - let fun rollback_aux (i, x) = - let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} - in - x.shrinker val_to_shrink - end - val args_rolled_back = mapi rollback_aux vals - val new_raw_vals = map (fn x => x.curr) args_rolled_back - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" - in - {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back} - end - | "init" => - let val new_vals = mapi (fn (i, x) => x.shrinker {state = "init", curr = x.raw, prev = x.raw}) vals - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - in - {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} - end - - | "done" => - rec - | _ => - let val new_vals = mapi (fn (i, x) => x.shrinker (nth rec.next_shrink_info (i+1))) vals - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - in - {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} - end - - (* input - vals: list, rec: {state: string, curr: tuple, prev: tuple} - returns - {state: string, curr: tuple, prev: tuple, next_shrink_info: list} *) - and shrink_tuple shrinkers rec = - case rec.state of - "done" => - rec - | "rollback" => - let val args_rolled_back = mapi (fn (i, x) => x {state = "rollback", curr = rec.curr.i, prev = rec.prev.i}) shrinkers - val new_raw_vals = map (fn x => x.curr) args_rolled_back - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" - in - {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back} - end - | "init" => - let val new_vals = mapi (fn (i, x) => x {state = "init", curr = rec.curr.i, prev = rec.prev.i}) shrinkers - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - in - {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} - end - | "cont" => - let val new_vals = mapi (fn (i, x) => x (nth rec.next_shrink_info (i+1))) shrinkers - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - in - {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} - end - - and shrink_list shrinkers rec = - if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr, idx = 0} - else - case rec.state of - "init" => - let val removeIdx = (length (rec.curr)) - 1 - val newList = remove_nth removeIdx rec.curr 0 - in - {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx} - end - | "cont_size" => - let val remove_idx = (rec.idx - 1) - val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" - val new_list = remove_nth remove_idx rec.curr 0 - in - {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx} - end - | "cont_elem" => - (* TODO: give list of shrinkers in the list_gen rec.curr should be list of raw elements *) - let val interim_list = mapi (fn (i, x) => (nth shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr - val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" - val new_list = map (fn x => x.curr) interim_list - in - {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx} - end - | "rollback" => - if (length rec.curr) = (length rec.prev) then - {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} (* TODO: this loops an unecesary amount of times *) - else - {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx} - | "done" => - rec - - and args_shrink args = - case args.state of - "rollback" => - let val rollbackReadyArgs = map (fn x => if x.state = "done" then x else {x with state = "rollback"}) args.args - val argsRolledBack = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) rollbackReadyArgs in - {state = "cont", args = argsRolledBack, shrinkers = args.shrinkers} end - | _ => - let val newArgs = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) args.args - val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in - {state = nextState, args = newArgs, shrinkers = args.shrinkers} end - - fun shrink_aux args prop pre counter = - if counter = 100 then report_error ("shrinking_looped", 0) else - let val shrunk_args = args_shrink args - val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args - val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in - case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of - true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers}) prop pre (counter) - | false => - if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end - - fun shrink args prop pre = - let val shrinkers = map (fn x => x.shrinker) args - val args_shrink_ready = map (fn x => {state = "init", curr = x.raw, prev = x.raw}) args - val args_rec = {state = "init", args = args_shrink_ready, shrinkers = shrinkers} - val res = shrink_aux args_rec prop pre 0 - in res end -(* --------------------------------- -GENERATORS - r --------------------------------- -*) - (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) - fun bool_gen size = - let val rnd = random() - val res = if rnd < 1/2 then false - else true - in - {raw = res, shrinker = shrink_bool} - end - - (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) - (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) - fun float_gen (low, high) size = - let val x = random() - val lInf = low = 1/0 (* check for inf *) - val hInf = high = 1/0 - val raw_res = - case (lInf, hInf) of - (true, true) => if (bool_gen size).raw then x*size else -x*size - | (true, false) => high - (x*size) - | (false, true) => low + (x*size) - | (false, false) => low + (x * (high-low)) - in - {raw = raw_res, shrinker = shrink_float} - end - - (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) - fun int_gen (low, high) size = - let val raw_res = floor ((float_gen(low, high) size).raw) - in - {raw = raw_res, shrinker = shrink_int} - end - - (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) - fun list_gen (generator) size = - let val length = (int_gen(0, size) size).raw - val res = make_list ((fn () => generator size), length) - val raw_res = map (fn x => x.raw) res - val shrinkers = map (fn x => x.shrinker) res in - {raw = raw_res, shrinker = shrink_list shrinkers} - end - - (* NOTE: Generates only letters (upper and lower case) and numbers. *) - (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) - fun char_gen size = - let val chars = - ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", - "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", - "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = (int_gen (1, ((length chars)-1)) size).raw - in - {raw = (nth chars x), shrinker = shrink_char} - end - -(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) - (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) - fun string_gen size = - let val x = (int_gen (0, size) size).raw - fun fold f acc 0 = acc - | fold f acc i = fold f (acc ^ (f())) (i-1) - val raw_string = (fold (fn () => (char_gen x).raw) "" x) - in - {raw = raw_string, shrinker = shrink_string} - end - -(* NOTE: Hardcoded for tuple of up to 10 elements *) -(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list - of all generated values in raw_inst along with their respective meta_data. *) - fun tuple_gen ts size = - let val ts_vals = map (fn x => x size) ts - val ts_raw_vals = map (fn x => x.raw) ts_vals - val ts_shrinkers = map (fn x => x.shrinker) ts_vals - in - {raw = (build_tuple ts_raw_vals), shrinker = shrink_tuple ts_shrinkers} - end - -(* -ns: list of strings - will be used as fieldnames -ts: list of generators - used to generate values for fields - -Returns record: {raw_inst = <>, meta_data = (ns, <>)} -*) - fun rec_gen ns ts size = - if (length ns) <> (length ts) then - report_error ("record_mismatch", 0) - else - let val ts_vals = map (fn x => x size) ts - val ts_raw_vals = map (fn x => x.raw) ts_vals - val raw_res = build_record ns ts_raw_vals - in - {raw = raw_res, shrinker = shrink_rec ns ts_vals} - end - - - fun generator_gen size = - let val rnd = random() - val inf = 1/0 - val res = if rnd <= 1/7 then ((fn i => int_gen(inf, inf) i)) else - if rnd <= 2/7 then ((fn i => bool_gen i)) else - if rnd <= 3/7 then ((fn i => float_gen(inf, inf) i)) else - if rnd <= 4/7 then ((fn i => string_gen i)) else - if rnd <= 5/7 then ((fn i => char_gen i)) else - if rnd <= 6/7 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf)), i)) i)) else - ((fn i => list_gen (int_gen(inf, inf)) i)) in - res end - -(* --------------------------------- -CORE FUNCTIONALITY - a --------------------------------- -*) - fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} - |core_forall (generator, prop, i, size, pre, cap) = - let val args = map (fn x => x size) generator - val raw_args = map (fn x => x.raw) args in - case pre of - () => - if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) - | _ => - if (apply_args pre raw_args) then - if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) - else - (write "x"; - if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) - else if size = cap then {failReason = (), cEx = (), remTests = i} - else core_forall (generator, prop, i, size+1, pre, cap)) - end - - fun tc_n generators p noOfTests = - let val (prop, pre) = - case p of - (x,y) => (x,y) - | x => (x, ()) - val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in - case res.failReason of - () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true - |_ => - report_fail_reason res noOfTests; - write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); - let val shrink_res = shrink res.cEx prop pre in - write "\nFailing test case was shrunk to:\n"; - write (args_toString shrink_res.shrunk_ctx); - write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); - false - end - end - - fun tc generator p = tc_n generator p 100 - - fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) - | troupecheck generator p = spawn (fn() => tc generator p) - -(* --------------------------------- -CONVENIENCE FUNCTIONS - s --------------------------------- -*) - val inf = 1 / 0 - fun integer() = int_gen(inf, inf) - | integer (h, l) = int_gen(h, l) - - fun pos_integer() = integer(0, inf) - - fun neg_integer() = integer(inf, -1) - - fun float() = float_gen(inf, inf) - | float(h, l) = float_gen(h, l) - - fun pos_float() = float(0, inf) - - fun neg_float() = float(inf, 0) - - fun boolean() = bool_gen - - fun list() = list_gen(generator_gen()) (* TODO: generator_gen() should return both raw_gen and meta_data *) - |list(type) = list_gen(type) - - fun string() = string_gen - - fun char() = char_gen - - fun tuple ts = tuple_gen ts - - fun record ns ts = rec_gen ns ts - - -(* --------------------------------- -FUNCTIONS FOR TESTING - d --------------------------------- -*) - fun my_reverse xs = - xs - - fun my_floor i = - if i >=0 then i - (i mod 1) - else i - (i mod 1) - 1 - - fun my_length [] = 0 - | my_length (x::xs) = 1 + (my_length xs) - - fun my_count y [] = 0 - | my_count y (x::xs) = - let val z = - if y = x then 1 else 0 - in - z + my_count y xs end - - fun my_floor i = - if i >=0 then i - (i mod 1) - else i - (i mod 1) - 1 - - fun my_ceil_1 i = - if i > 0 then i + (1 - (i mod 1)) - else i + (1 - (i mod 1)) - 1 - - fun my_ceil_2 i = - if i > 0 then (my_floor i) + 1 - else if i = 0 then 0 - else (my_floor i) + 1 - - fun bad_insert xs x = - if length xs < 10 then append [x] xs else - xs - - fun one_of_two (x, y) = - let val bool = (bool_gen 0).raw in - if bool then x - else y end - - fun bad_half n = - if n > 10 then n else n/2 - - fun lengths_not_same s1 s2 = - (string_length s1) <> (string_length s2) - -(* --------------------------------- -PROPERTIES FOR TESTING - f --------------------------------- -*) - fun bool_commutative x y = - (x andalso y) = (y andalso x) - - fun number_commutative x y = - x * y = y * x - - fun list_reverse xs = - reverse(reverse xs) = xs - - fun int_gen_stays_in_interval i = - (integer(0, i) i).raw <= i - - fun abs_value_is_always_pos i = - abs_value i >= 0 - - fun my_floor_test i = - my_floor i = floor i - - fun my_length_test xs = - my_length xs = length xs - - fun make_list_test i = - let val generator = generator_gen i - fun f() = generator ((int_gen(0, inf) i).raw) - val ls = (make_list (f, i)) in - (length ls) = i end - - fun my_count_returns_non_negative_int x xs = - (my_count x xs) >= 0 - - fun rec_test rec i = - {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} - - fun pre_pos x = - x >= 0 - - fun my_floor_test i = - my_floor i = floor i - - fun my_ceil_1_test i = - my_ceil_1 i = ceil i - - fun my_ceil_2_test i = - my_ceil_2 i = ceil i - - fun both_ceil_test i = - my_ceil_1 i = my_ceil_2 i - - fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) - - fun no_args() = true - - fun test_bad_insert xs x = - length (bad_insert xs x) = (length xs) + 1 - - fun test_bad_half n = - n > (bad_half n) - - fun append_always_longer s1 s2 = - string_length s1 < string_length (s1 ^ s2) - - fun record_shrink_test r = - r.theInteger < 50 - -(* --------------------------------- -USED FOR USERGUIDE - g --------------------------------- -*) - fun filter_less ([], _) = [] - | filter_less ((x::xs), p) = - if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) - - fun filter_greater ([], _) = [] - | filter_greater ((x::xs), p) = - if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) - - - fun my_quicksort [] = [] - | my_quicksort (x::xs) = - let val smaller = my_quicksort(filter_less(xs, x)) - val greater = my_quicksort(filter_greater(xs, x)) in - append (append smaller [x]) (greater) end - - fun ordered [] = true - | ordered (x::[]) = true - | ordered (x::y::ys) = - if x <= y then ordered (y::ys) else false - - fun my_sort_is_ordered xs = - ordered (my_quicksort xs) - - fun my_sort_keep_length xs = - length xs = length (my_quicksort(xs)) - - fun pre_list_size_greater_than_one xs = - if (length xs) <= 1 then false else true - - fun no_duplicates[] = true - | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs - - fun cons_length_increase xs x = - (length (x::xs)) = ((length xs) + 1) -(* --------------------------------- -TC^2 - z --------------------------------- -*) - fun tc_sort_length_always_fails () = - tc [list(integer())] my_sort_keep_length = false - - fun tc_sort_ordered_always_true () = - tc [list(integer())] my_sort_is_ordered = true -in - -(* --------------------------------- -ALL TESTS - x --------------------------------- -*) - -(* shrinking tests - x *) -(* tc [list(integer()), integer()] test_bad_insert; -tc [integer()] (test_bad_half, (fn x => x >= 15)); *) -tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test - -(* tc^2 tests *) -(* tc [] tc_sort_ordered_always_true; *) - -(* User guide tests *) -(* tc [list(integer()), integer()] cons_length_increase; -tc [list(integer())] my_sort_is_ordered; -tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); *) - -(* General functionality tests *) -(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; -tc [] no_args; -tc [integer(), integer(), integer(), integer()] tup_test; -write "\nTesting on bools commutative:"; -tc [boolean(), boolean()] bool_commutative; -write "\nTesting on numbers commutative:"; -tc [integer(), integer()] number_commutative; -write "\nTesting on list reverse:"; -tc [list(integer())] list_reverse; -write "\nTesting on int_gen interval:"; -tc [integer()] (int_gen_stays_in_interval, pre_pos); -write "\nTesting on abs_value:"; -tc [one_of_two (integer(), float())] abs_value_is_always_pos; -write "\nTesting on my_floor:"; -tc [float()] my_floor_test; -write "\nTesting that my_count always return non-negative result:"; -tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; -write "\nTesting my_length:"; -tc [list(integer())] my_length_test; -write "\nTesting make_list:"; -tc [pos_integer()] make_list_test; -write "Testing on my_ceil_1:"; -tc [float()] my_ceil_1_test; -write "Testing on my_ceil_2:"; -tc [float()] my_ceil_2_test; -write "Testing on both ceil functions:"; -tc [float()] both_ceil_test *) -end \ No newline at end of file diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index c342bd9..992715f 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -8,8 +8,8 @@ let val out = getStdout authority fun write x = fwrite (out, x) (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) fun args_toString args = - let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0.raw_inst) ^ ", ") (x1::xs) - | aux_toString acc (x::xs) = acc ^ (toString x.raw_inst) in + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x) in aux_toString "" args end (* -------------------------------- @@ -61,7 +61,7 @@ UTILS - e case l of [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) | (x::xs) => - let val res = foldl (fn (x,y) => function_not_done_check y; y x.raw_inst) p l in + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in boolean_check res; res end @@ -84,7 +84,7 @@ UTILS - e case rec.failReason of "false_prop" => write "\nFailure at input: "; - write (args_toString rec.cEx); + write (args_toString (map (fn x => x.raw) rec.cEx)); write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") fun build_record names vals = @@ -93,68 +93,8 @@ UTILS - e aux (recordExtend(r, n, v)) ns vs in aux {} names vals end -(* --------------------------------- -GENERATORS - r --------------------------------- -*) - fun bool_gen size = - let val rnd = random() - val res = if rnd < 1/2 then false - else true in - {raw_inst = res} - end - - fun float_gen (low, high) size = - let val x = random() - val lInf = low = 1/0 (* check for inf *) - val hInf = high = 1/0 - val raw_res = - case (lInf, hInf) of - (true, true) => if (bool_gen size).raw_inst then x*size else -x*size - | (true, false) => high - (x*size) - | (false, true) => low + (x*size) - | (false, false) => low + (x * (high-low)) in - {raw_inst = raw_res, meta_data = (low, high)} - end - - fun int_gen (low, high) size = - let val raw_res = floor ((float_gen(low, high) size).raw_inst) in - {raw_inst = raw_res, meta_data = (low, high)} - end - - fun list_gen (generator) size = - let val length = (int_gen(0, size) size).raw_inst - val res = make_list ((fn () => generator size), length) - val raw_res = map (fn x => x.raw_inst) res in - {raw_inst = raw_res, meta_data = res} - end - -(* NOTE: Generates only letters (upper and lower case) and numbers. *) - fun char_gen size = - let val chars = - ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", - "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", - "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = (int_gen (1, ((length chars)-1)) size).raw_inst in - {raw_inst = (nth chars x)} - end - -(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) - fun string_gen size = - let val x = (int_gen (0, size) size).raw_inst - fun fold f acc 0 = acc - | fold f acc i = fold f (acc ^ (f()).raw_inst) (i-1) in - {raw_inst = (fold char_gen "" x)} - end - -(* NOTE: Hardcoded for tuple of up to 10 elements *) -(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list - of all generated values in raw_inst along with their respective meta_data. *) - fun tuple_gen ts size = - let fun tup_aux ls = + + fun build_tuple ls = case ls of [] => (0) |[x] => (x) @@ -168,163 +108,201 @@ GENERATORS - r |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) |_ => (2, 3, 4, 5) - val ts_vals = map (fn x => x size) ts - val ts_raw_vals = map (fn x => x.raw_inst) ts_vals in - {raw_inst = (tup_aux ts_raw_vals), meta_data = ts_vals} - end - -(* -ns: list of strings - will be used as fieldnames -ts: list of generators - used to generate values for fields - -Returns record: {raw_inst = <>, meta_data = (ns, <>)} -*) - fun rec_gen ns ts size = - if (length ns) <> (length ts) then - report_error ("record_mismatch", 0) - else - let val ts_vals = map (fn x => x size) ts - val ts_raw_vals = map (fn x => x.raw_inst) ts_vals - val raw_res = build_record ns ts_raw_vals in - {raw_inst = raw_res, meta_data = (ns, ts_vals)} - end - - - fun generator_gen size = - let val rnd = random() - val inf = 1/0 - val res = if rnd <= 1/7 then ((fn i => int_gen(inf, inf) i)) else - if rnd <= 2/7 then ((fn i => bool_gen i)) else - if rnd <= 3/7 then ((fn i => float_gen(inf, inf) i)) else - if rnd <= 4/7 then ((fn i => string_gen i)) else - if rnd <= 5/7 then ((fn i => char_gen i)) else - if rnd <= 6/7 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf)), i)) i)) else - ((fn i => list_gen (int_gen(inf, inf)) i)) in - res end (* -------------------------------- SHRINKING - t -------------------------------- *) - - fun get_shrinker x = - case getType x of - "list" => shrink_list - | "number" => shrink_number - | "boolean" => shrink_bool - | "string" => shrink_string - | "record" => shrink_rec - | "tuple" => shrink_tuple - - and arg_shrink arg = - let val shrinker = get_shrinker arg.curr.raw_inst in - shrinker arg - end - and shrink_number rec = - let val rec_checked = if rec.curr.raw_inst = 0 then {rec with state = "done"} else rec - val curr_val = rec_checked.curr.raw_inst in + and shrink_float rec = + let val rec_checked = if rec.curr = 0 then {rec with state = "done"} else rec + val curr_val = rec_checked.curr + in case rec_checked.state of "rollback" => - {state = "done", curr = rec_checked.prev} + {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} |"done" => rec_checked | _ => let val new_raw_val = if (abs_value curr_val)-1 <= 0 then 0 else curr_val/2 - val new_val = {rec_checked.curr with raw_inst = new_raw_val} in - {state = "cont", curr = new_val, prev = rec_checked.curr} + in + {state = "cont", curr = new_raw_val, prev = rec_checked.curr} end end + and shrink_int rec = + let val interim = shrink_float rec + in + {interim with curr = floor(interim.curr)} + end + and shrink_bool rec = - let val rec_checked = if rec.curr.raw_inst = false then {rec with state = "done"} else rec in + let val rec_checked = if rec.curr = false then {rec with state = "done"} else rec + in case rec_checked.state of "rollback" => - {state = "done", curr = rec_checked.prev} + {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} |"done" => rec_checked | _ => - let val newVal = false in + let val newVal = false + in {state = "cont", curr = newVal, prev = rec_checked.curr} end end + (* input/returns - {state: string, curr: string, prev: string} *) and shrink_string rec = - case rec.state of + let val rec_checked = if rec.state = "init" then {rec with next_shrink_info = 0} else rec in + case rec_checked.state of "cont_elem" => - {rec with state = "done"} + {rec_checked with state = "done"} (* TODO: Should actually shrink characters *) | _ => - let val curr_val = rec.curr.raw_inst - val ls_of_string = string_to_list curr_val - val curr_as_list = {rec.curr with raw_inst = ls_of_string} - val interimRes = shrink_list {rec with curr = curr_as_list} - val new_curr_string = {interimRes.curr with raw_inst = (list_to_string interimRes.curr.raw_inst)} - val res = {interimRes with curr = new_curr_string} in - res end + let val ls_curr = string_to_list rec_checked.curr + val ls_prev = string_to_list rec_checked.prev + val shrinkers = map (fn _ => shrink_char) ls_curr + val interim_res = shrink_list shrinkers {state = rec_checked.state, curr = ls_curr, prev = ls_prev, idx = rec_checked.next_shrink_info} + val new_curr = list_to_string interim_res.curr + val new_prev = list_to_string interim_res.prev + + val res = {state = interim_res.state, curr = new_curr, prev = new_prev, next_shrink_info = interim_res.idx} + in + res + end + end + + + and shrink_char rec = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec + val curr_val = rec_checked.curr in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} + | "done" => + rec_checked + | "init" => + let val index_of_new = (lookup chars rec.curr 2) - 1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + | _ => + let val index_of_new = rec.idx-1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + end - and shrink_rec rec = + and shrink_rec names vals rec = case rec.state of "rollback" => - {state = "done", curr = rec.prev} - (* print "testing"; - let val curr_vals_ls = rec.curr.meta_data.1 - val curr_names = rec.curr.meta_data.0 - - val vals_rolled_back_rec = args_shrink {state = "rollback", args = map (fn x => {state = "init", curr = x}) curr_vals_ls} in - print vals_rolled_back_rec; - let val nextState = "done" - val vals_rolled_back = vals_rolled_back_rec.args - val raw_vals_rolled_back = map (fn x => x.raw_inst) vals_rolled_back - - val rolled_back_meta = (curr_names, vals_rolled_back) - val rolled_back_rec = build_record curr_names raw_vals_rolled_back - val rolled_back_res = {raw_inst = rolled_back_rec, meta_data = rolled_back_meta} in - {state = nextState, curr = rolled_back_res} end end *) - |"done" => + let val init_idx_to_shrink = rec.idx_to_shrink + fun rollback_aux (i, x) = + if i = init_idx_to_shrink then + (let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} + in + x.shrinker val_to_shrink + end ) + else (nth rec.next_shrink_info (i+1)) + val args_rolled_back = mapi rollback_aux vals + val new_raw_vals = map (fn x => x.curr) args_rolled_back + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" + val idx_to_shrink = if (nth args_rolled_back (init_idx_to_shrink+1)).state = "done" then init_idx_to_shrink+1 else init_idx_to_shrink + in + {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back, idx_to_shrink = idx_to_shrink} + end + | "init" => + let val init_idx_to_shrink = 0 + val new_vals = mapi (fn (i, x) => + if i = init_idx_to_shrink then (x.shrinker {state = "init", curr = x.raw, prev = x.raw}) + else {state = "init", curr = x.raw, prev = x.raw}) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val idx_to_shrink = if (nth new_vals (init_idx_to_shrink+1)).state = "done" then init_idx_to_shrink+1 else init_idx_to_shrink + in + {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, idx_to_shrink = idx_to_shrink} + end + + | "done" => rec | _ => - let val curr_vals_ls = rec.curr.meta_data.1 - val curr_names = rec.curr.meta_data.0 - - val shrunk_vals_rec = map (fn x => (arg_shrink {state = "init", curr = x})) curr_vals_ls - val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true shrunk_vals_rec) then "done" else "cont" - val shrunk_vals = map (fn x => x.curr) shrunk_vals_rec - val raw_shrunk_vals = map (fn x => x.raw_inst) shrunk_vals - - val shrunk_meta = (curr_names, shrunk_vals) - val shrunk_rec = build_record curr_names raw_shrunk_vals - val shrunk_res = {raw_inst = shrunk_rec, meta_data = shrunk_meta} in - {state = nextState, curr = shrunk_res, prev = rec.curr} end - + let val init_idx_to_shrink = rec.idx_to_shrink + val new_vals = mapi (fn (i, x) => + if i = init_idx_to_shrink then x.shrinker (nth rec.next_shrink_info (i+1)) + else (nth rec.next_shrink_info (i+1))) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val idx_to_shrink = if (nth new_vals (init_idx_to_shrink+1)).state = "done" then init_idx_to_shrink+1 else init_idx_to_shrink + in + {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, idx_to_shrink = idx_to_shrink} + end - and shrink_tuple n = - 3 + (* input - vals: list, rec: {state: string, curr: tuple, prev: tuple} + returns - {state: string, curr: tuple, prev: tuple, next_shrink_info: list} *) + and shrink_tuple shrinkers rec = + case rec.state of + "done" => + rec + | "rollback" => + let val args_rolled_back = mapi (fn (i, x) => x {state = "rollback", curr = rec.curr.i, prev = rec.prev.i}) shrinkers + val new_raw_vals = map (fn x => x.curr) args_rolled_back + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" + in + {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back} + end + | "init" => + let val new_vals = mapi (fn (i, x) => x {state = "init", curr = rec.curr.i, prev = rec.prev.i}) shrinkers + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + in + {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + end + | "cont" => + let val new_vals = mapi (fn (i, x) => x (nth rec.next_shrink_info (i+1))) shrinkers + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + in + {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + end - and shrink_list rec = - if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr} + and shrink_list shrinkers rec = + if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr, idx = 0} else case rec.state of "init" => - let val removeIdx = (length (rec.curr.raw_inst)) - 1 - val newList = remove_nth removeIdx rec.curr.raw_inst 0 in - {state = "cont_size", curr = {rec.curr with raw_inst = newList}, prev = rec.curr, idx = removeIdx} end + let val removeIdx = (length (rec.curr)) - 1 + val newList = remove_nth removeIdx rec.curr 0 + in + {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx} + end | "cont_size" => - let val removeIdx = (rec.idx - 1) - val nextState = if removeIdx <= 0 then "cont_elem" else "cont_size" - val newList = remove_nth removeIdx rec.curr.raw_inst 0 in - {state = nextState, curr = {rec.curr with raw_inst = newList}, prev = rec.curr, idx = removeIdx} end + let val remove_idx = (rec.idx - 1) + val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" + val new_list = remove_nth remove_idx rec.curr 0 + in + {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx} + end | "cont_elem" => - let val shrinker = get_shrinker (nth rec.curr.raw_inst 1) - val interimList = (map (fn x => shrinker {state = "init", curr = x}) rec.curr.meta_data) - val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interimList) then "done" else "cont_elem" - val newList = map (fn x => x.curr) interimList - val newList_raw = map (fn x => x.raw_inst) newList in - {state = nextState, curr = {raw_inst = newList_raw, meta_data = newList}, prev = rec.curr, idx = rec.idx} end + (* TODO: give list of shrinkers in the list_gen rec.curr should be list of raw elements *) + let val interim_list = mapi (fn (i, x) => (nth shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr + val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" + val new_list = map (fn x => x.curr) interim_list + in + {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx} + end | "rollback" => - print rec; - if (length rec.curr.raw_inst) = (length rec.prev.raw_inst) then {state = "done", curr = rec.prev, prev = rec.prev} (* TODO: this loops an unecesary amount of times *) - else {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx} + if (length rec.curr) = (length rec.prev) then + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} (* TODO: this loops an unecesary amount of times *) + else + {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx} | "done" => rec @@ -332,12 +310,12 @@ SHRINKING - t case args.state of "rollback" => let val rollbackReadyArgs = map (fn x => if x.state = "done" then x else {x with state = "rollback"}) args.args - val argsRolledBack = map (fn x => arg_shrink x) rollbackReadyArgs in - {state = "cont", args = argsRolledBack} end - |_ => - let val newArgs = map (fn x => arg_shrink x) args.args + val argsRolledBack = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) rollbackReadyArgs in + {state = "cont", args = argsRolledBack, shrinkers = args.shrinkers} end + | _ => + let val newArgs = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) args.args val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in - {state = nextState, args = newArgs} end + {state = nextState, args = newArgs, shrinkers = args.shrinkers} end fun shrink_aux args prop pre counter = if counter = 100 then report_error ("shrinking_looped", 0) else @@ -345,14 +323,128 @@ SHRINKING - t val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of - true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args}) prop pre (counter) + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers}) prop pre (counter) | false => if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end fun shrink args prop pre = - let val newArgs = map (fn x => {state = "init", curr = x}) args - val res = shrink_aux ({state = "init", args = newArgs}) prop pre 0 in - res end + let val shrinkers = map (fn x => x.shrinker) args + val args_shrink_ready = map (fn x => {state = "init", curr = x.raw, prev = x.raw}) args + val args_rec = {state = "init", args = args_shrink_ready, shrinkers = shrinkers} + val res = shrink_aux args_rec prop pre 0 + in res end +(* +-------------------------------- +GENERATORS - r +-------------------------------- +*) + (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) + fun bool_gen size = + let val rnd = random() + val res = if rnd < 1/2 then false + else true + in + {raw = res, shrinker = shrink_bool} + end + + (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) + (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) + fun float_gen (low, high) size = + let val x = random() + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + val raw_res = + case (lInf, hInf) of + (true, true) => if (bool_gen size).raw then x*size else -x*size + | (true, false) => high - (x*size) + | (false, true) => low + (x*size) + | (false, false) => low + (x * (high-low)) + in + {raw = raw_res, shrinker = shrink_float} + end + + (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) + fun int_gen (low, high) size = + let val raw_res = floor ((float_gen(low, high) size).raw) + in + {raw = raw_res, shrinker = shrink_int} + end + + (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) + fun list_gen (generator) size = + let val length = (int_gen(0, size) size).raw + val res = make_list ((fn () => generator size), length) + val raw_res = map (fn x => x.raw) res + val shrinkers = map (fn x => x.shrinker) res in + {raw = raw_res, shrinker = shrink_list shrinkers} + end + + (* NOTE: Generates only letters (upper and lower case) and numbers. *) + (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) + fun char_gen size = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = (int_gen (1, ((length chars)-1)) size).raw + in + {raw = (nth chars x), shrinker = shrink_char} + end + +(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) + fun string_gen size = + let val x = (int_gen (0, size) size).raw + fun fold f acc 0 = acc + | fold f acc i = fold f (acc ^ (f())) (i-1) + val raw_string = (fold (fn () => (char_gen x).raw) "" x) + in + {raw = raw_string, shrinker = shrink_string} + end + +(* NOTE: Hardcoded for tuple of up to 10 elements *) +(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list + of all generated values in raw_inst along with their respective meta_data. *) + fun tuple_gen ts size = + let val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw) ts_vals + val ts_shrinkers = map (fn x => x.shrinker) ts_vals + in + {raw = (build_tuple ts_raw_vals), shrinker = shrink_tuple ts_shrinkers} + end + +(* +ns: list of strings - will be used as fieldnames +ts: list of generators - used to generate values for fields + +Returns record: {raw_inst = <>, meta_data = (ns, <>)} +*) + fun rec_gen ns ts size = + if (length ns) <> (length ts) then + report_error ("record_mismatch", 0) + else + let val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw) ts_vals + val raw_res = build_record ns ts_raw_vals + in + {raw = raw_res, shrinker = shrink_rec ns ts_vals} + end + + + fun generator_gen size = + let val rnd = random() + val inf = 1/0 + val res = if rnd <= 1/7 then ((fn i => int_gen(inf, inf) i)) else + if rnd <= 2/7 then ((fn i => bool_gen i)) else + if rnd <= 3/7 then ((fn i => float_gen(inf, inf) i)) else + if rnd <= 4/7 then ((fn i => string_gen i)) else + if rnd <= 5/7 then ((fn i => char_gen i)) else + if rnd <= 6/7 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf)), i)) i)) else + ((fn i => list_gen (int_gen(inf, inf)) i)) in + res end + (* -------------------------------- CORE FUNCTIONALITY - a @@ -360,14 +452,15 @@ CORE FUNCTIONALITY - a *) fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0} |core_forall (generator, prop, i, size, pre, cap) = - let val args = map (fn x => x size) generator in + let val args = map (fn x => x size) generator + val raw_args = map (fn x => x.raw) args in case pre of () => - if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) | _ => - if (apply_args pre args) then - if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + if (apply_args pre raw_args) then + if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) else (write "!"; {failReason = "false_prop", cEx = args, remTests = i}) else (write "x"; @@ -474,7 +567,7 @@ FUNCTIONS FOR TESTING - d xs fun one_of_two (x, y) = - let val bool = (bool_gen 0).raw_inst in + let val bool = (bool_gen 0).raw in if bool then x else y end @@ -499,7 +592,7 @@ PROPERTIES FOR TESTING - f reverse(reverse xs) = xs fun int_gen_stays_in_interval i = - (integer(0, i) i).raw_inst <= i + (integer(0, i) i).raw <= i fun abs_value_is_always_pos i = abs_value i >= 0 @@ -512,7 +605,7 @@ PROPERTIES FOR TESTING - f fun make_list_test i = let val generator = generator_gen i - fun f() = generator ((int_gen(0, inf) i).raw_inst) + fun f() = generator ((int_gen(0, inf) i).raw) val ls = (make_list (f, i)) in (length ls) = i end @@ -614,19 +707,19 @@ ALL TESTS - x tc [list(integer()), integer()] test_bad_insert; tc [integer()] (test_bad_half, (fn x => x >= 15)); tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; (* tc^2 tests *) (* tc [] tc_sort_ordered_always_true; *) (* User guide tests *) -(* tc [list(integer()), integer()] cons_length_increase; +tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); *) +tc [list(integer())] (my_sort_keep_length, no_duplicates); (* General functionality tests *) -(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [] no_args; tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; @@ -652,5 +745,5 @@ tc [float()] my_ceil_1_test; write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; -tc [float()] both_ceil_test *) +tc [float()] both_ceil_test end \ No newline at end of file From 23db886d2a1d5273be33a5d25345eed1c2933630 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 10 Apr 2024 12:54:29 +0200 Subject: [PATCH 044/121] Shrinking working not currently - in progress with updating so that instances are shrunk on by one --- troupecheck/tc.trp | 30 ++++++++++++++++++++---------- 1 file changed, 20 insertions(+), 10 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 992715f..0901dc6 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -309,28 +309,38 @@ SHRINKING - t and args_shrink args = case args.state of "rollback" => - let val rollbackReadyArgs = map (fn x => if x.state = "done" then x else {x with state = "rollback"}) args.args - val argsRolledBack = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) rollbackReadyArgs in - {state = "cont", args = argsRolledBack, shrinkers = args.shrinkers} end + let val init_shrink_idx = args.shrink_idx + val rollbackReadyArgs = mapi (fn (i, x) => if (x.state = "done") orelse (i<>init_shrink_idx) then x else {x with state = "rollback"}) args.args + val argsRolledBack = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) rollbackReadyArgs + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true argsRolledBack) then "done" else "cont" + val shrink_idx = if (nth argsRolledBack (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = nextState, args = argsRolledBack, shrinkers = args.shrinkers, shrink_idx = shrink_idx} + end | _ => - let val newArgs = mapi (fn (i, x) => (nth args.shrinkers (i+1)) x) args.args - val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" in - {state = nextState, args = newArgs, shrinkers = args.shrinkers} end + let val init_shrink_idx = args.shrink_idx + val newArgs = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) args.args + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" + val shrink_idx = if (nth newArgs (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + + in + {state = nextState, args = newArgs, shrinkers = args.shrinkers, shrink_idx = shrink_idx} + end fun shrink_aux args prop pre counter = if counter = 100 then report_error ("shrinking_looped", 0) else - let val shrunk_args = args_shrink args + let val shrunk_args = args_shrink args val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of - true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers}) prop pre (counter) + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers, shrink_idx = args.shrink_idx}) prop pre (counter) | false => if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end fun shrink args prop pre = - let val shrinkers = map (fn x => x.shrinker) args + let val shrinkers = map (fn x => x.shrinker) args val args_shrink_ready = map (fn x => {state = "init", curr = x.raw, prev = x.raw}) args - val args_rec = {state = "init", args = args_shrink_ready, shrinkers = shrinkers} + val args_rec = {state = "init", args = args_shrink_ready, shrinkers = shrinkers, shrink_idx = 0} val res = shrink_aux args_rec prop pre 0 in res end (* From 69419b17d1a3658fefafe3e651aa8b20dfa88ac4 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 10 Apr 2024 16:36:22 +0200 Subject: [PATCH 045/121] Shrinking one argument by one now works --- troupecheck/tc.trp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 0901dc6..7b2e159 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -317,6 +317,8 @@ SHRINKING - t in {state = nextState, args = argsRolledBack, shrinkers = args.shrinkers, shrink_idx = shrink_idx} end + | "done" => + args | _ => let val init_shrink_idx = args.shrink_idx val newArgs = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) args.args From bf15e66962bef5a932c7a807d24fbab40817d546 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 10 Apr 2024 17:01:18 +0200 Subject: [PATCH 046/121] Added shrink_sized_aggregate to replace shrink_tuple and shrink_rec --- troupecheck/tc.trp | 105 ++++++++++++++++----------------------------- 1 file changed, 37 insertions(+), 68 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 7b2e159..162cc05 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -110,7 +110,7 @@ UTILS - e |_ => (2, 3, 4, 5) (* -------------------------------- -SHRINKING - t +SHRINKING - r -------------------------------- *) @@ -170,7 +170,6 @@ SHRINKING - t res end end - and shrink_char rec = let val chars = @@ -200,79 +199,49 @@ SHRINKING - t end end - - and shrink_rec names vals rec = - case rec.state of - "rollback" => - let val init_idx_to_shrink = rec.idx_to_shrink - fun rollback_aux (i, x) = - if i = init_idx_to_shrink then - (let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} - in - x.shrinker val_to_shrink - end ) - else (nth rec.next_shrink_info (i+1)) - val args_rolled_back = mapi rollback_aux vals - val new_raw_vals = map (fn x => x.curr) args_rolled_back - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" - val idx_to_shrink = if (nth args_rolled_back (init_idx_to_shrink+1)).state = "done" then init_idx_to_shrink+1 else init_idx_to_shrink - in - {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back, idx_to_shrink = idx_to_shrink} - end - | "init" => - let val init_idx_to_shrink = 0 - val new_vals = mapi (fn (i, x) => - if i = init_idx_to_shrink then (x.shrinker {state = "init", curr = x.raw, prev = x.raw}) - else {state = "init", curr = x.raw, prev = x.raw}) vals - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - val idx_to_shrink = if (nth new_vals (init_idx_to_shrink+1)).state = "done" then init_idx_to_shrink+1 else init_idx_to_shrink - in - {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, idx_to_shrink = idx_to_shrink} - end - - | "done" => - rec - | _ => - let val init_idx_to_shrink = rec.idx_to_shrink - val new_vals = mapi (fn (i, x) => - if i = init_idx_to_shrink then x.shrinker (nth rec.next_shrink_info (i+1)) - else (nth rec.next_shrink_info (i+1))) vals - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - val idx_to_shrink = if (nth new_vals (init_idx_to_shrink+1)).state = "done" then init_idx_to_shrink+1 else init_idx_to_shrink - in - {state = new_state, curr = (build_record names new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, idx_to_shrink = idx_to_shrink} - end - - (* input - vals: list, rec: {state: string, curr: tuple, prev: tuple} - returns - {state: string, curr: tuple, prev: tuple, next_shrink_info: list} *) - and shrink_tuple shrinkers rec = + and shrink_sized_aggregate vals builder rec = case rec.state of - "done" => - rec - | "rollback" => - let val args_rolled_back = mapi (fn (i, x) => x {state = "rollback", curr = rec.curr.i, prev = rec.prev.i}) shrinkers - val new_raw_vals = map (fn x => x.curr) args_rolled_back - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true args_rolled_back) then "done" else "cont" - in - {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = args_rolled_back} - end - | "init" => - let val new_vals = mapi (fn (i, x) => x {state = "init", curr = rec.curr.i, prev = rec.prev.i}) shrinkers + "init" => + let val init_shrink_idx = 0 + val new_vals = mapi (fn (i, x) => + if i = init_shrink_idx then (x.shrinker {state = "init", curr = x.raw, prev = x.raw}) + else {state = "init", curr = x.raw, prev = x.raw}) vals val new_raw_vals = map (fn x => x.curr) new_vals val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx in - {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} end | "cont" => - let val new_vals = mapi (fn (i, x) => x (nth rec.next_shrink_info (i+1))) shrinkers + let val init_shrink_idx = rec.shrink_idx + val new_vals = mapi (fn (i, x) => + if i = init_shrink_idx then x.shrinker (nth rec.next_shrink_info (i+1)) + else (nth rec.next_shrink_info (i+1))) vals val new_raw_vals = map (fn x => x.curr) new_vals val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx in - {state = new_state, curr = (build_tuple new_raw_vals), prev = rec.curr, next_shrink_info = new_vals} + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} end - + | "done" => + rec + | "rollback" => + let val init_shrink_idx = rec.shrink_idx + fun rollback_aux (i, x) = + if i = init_shrink_idx then + (let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} + in + x.shrinker val_to_shrink + end ) + else (nth rec.next_shrink_info (i+1)) + val rollback_args = mapi rollback_aux vals + val new_raw_vals = map (fn x => x.curr) rollback_args + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true rollback_args) then "done" else "cont" + val shrink_idx = if (nth rollback_args (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = rollback_args, shrink_idx = shrink_idx} + end + and shrink_list shrinkers rec = if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr, idx = 0} else @@ -347,7 +316,7 @@ SHRINKING - t in res end (* -------------------------------- -GENERATORS - r +GENERATORS - t -------------------------------- *) (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) @@ -424,7 +393,7 @@ GENERATORS - r val ts_raw_vals = map (fn x => x.raw) ts_vals val ts_shrinkers = map (fn x => x.shrinker) ts_vals in - {raw = (build_tuple ts_raw_vals), shrinker = shrink_tuple ts_shrinkers} + {raw = (build_tuple ts_raw_vals), shrinker = shrink_sized_aggregate ts_vals build_tuple} end (* @@ -441,7 +410,7 @@ Returns record: {raw_inst = <>, meta_data = (ns, < x.raw) ts_vals val raw_res = build_record ns ts_raw_vals in - {raw = raw_res, shrinker = shrink_rec ns ts_vals} + {raw = raw_res, shrinker = shrink_sized_aggregate ts_vals (build_record ns)} end From ad20fab236d61c63fe2285bfec64be6f3c420da6 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 12 Apr 2024 08:06:13 +0200 Subject: [PATCH 047/121] deleted a comment --- troupecheck/tc.trp | 1 - 1 file changed, 1 deletion(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 162cc05..7091361 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -260,7 +260,6 @@ SHRINKING - r {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx} end | "cont_elem" => - (* TODO: give list of shrinkers in the list_gen rec.curr should be list of raw elements *) let val interim_list = mapi (fn (i, x) => (nth shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" val new_list = map (fn x => x.curr) interim_list From 176c994dfbbeb44e7ae0a9f654425b686a139000 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 12 Apr 2024 10:06:32 +0200 Subject: [PATCH 048/121] generaters for mini langauge has been written - needs shrinker for prog_gen --- troupecheck/language_interpreter.trp | 174 +++++++++++++++++++++++++++ 1 file changed, 174 insertions(+) create mode 100644 troupecheck/language_interpreter.trp diff --git a/troupecheck/language_interpreter.trp b/troupecheck/language_interpreter.trp new file mode 100644 index 0000000..b82ac6f --- /dev/null +++ b/troupecheck/language_interpreter.trp @@ -0,0 +1,174 @@ +import lists +(* Program: statement list + Statement: ("assign", var, exp) | ("print", exp) *) + +let fun eval exp env = + case exp of + ("num", n) => n + | ("var", n) => lookup env n ("unknown variable " ^ n) + | ("add", e1, e2) => (eval e1 env) + (eval e2 env) + | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) + | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) + | ("div", e1, e2) => (eval e1 env) / (eval e2 env) + | _ => print ("Error: ill defined expression: "); exit (authority, 1) + + fun execute stmt env = + case stmt of + ("assign", var, exp) => + let val value = eval exp env + in + append [(var, value)] env + end + | ("print", exp) => (print (toString (eval exp env)); env) + + fun interpret stmts = + let fun interpretHelper [] env = env + | interpretHelper (stmt :: rest) env = + let val newEnv = execute stmt env + in + interpretHelper rest newEnv + end + in + (interpretHelper stmts []) + end + + val statements = [ + ("assign", "x", ("num", 5)), + ("assign", "y", ("num", 7)), + ("print", ("var", "x")), + ("print", ("var", "y")), + ("print", ("add", ("var", "x"), ("var", "y"))) + ] + + fun one_of ls = + let val idx = (int_gen (1, (length ls)) ((length ls))).raw + in + nth ls idx + end + + fun exp_gen ls size = + let val exp_ts = ["num", "var", "add", "sub", "mul", "div"] + val exp_type_interim = one_of exp_ts + val exp_type = if (exp_type_interim = "var") andalso (length ls = 0) then "num" else "var" + in + case exp_type of + "num" => + let val value = int_gen(inf, inf) size + fun shrinker inst = + let shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in + {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in + {raw = ("num", value.raw), shrinker = shrinker} end + | "var" => + let val value = one_of ls size + fun shrinker inst = + {inst with state = "done"} in + {raw = ("var", value), shrinker = shrinker} end + |"add" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("add", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} + end + |"sub" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("sub", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} + end + |"mul" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("mul", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} + end + |"div" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("div", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} + end + end + + fun assign_stmt_gen ls size = + let val n = string_gen size + val exp = exp_gen ls size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val shrunk_assign = ("assign", n, shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} + end + in + {raw = ("assign", n, exp.raw), shrinker = shrinker} + end + + fun print_stmt_gen ls size = + let val exp = exp_gen ls size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val shrunk_print = ("print", shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} + end + in + {raw = ("print", exp.raw), shrinker = shrinker} + end + + fun stmt_gen ls size = + let val stmt = one_of ["assign", "print"] + in + case stmt of + "assign" => + let val res = assign_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + |"print" => + let val res = print_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + end + + fun program_gen size = + let val num_of_insts = int_gen(0, size) size + fun prog_gen_aux env p 0 = p + | prog_gen_aux env p s i = (p,s) + let val stmt = stmt_gen env size + val newEnv = if stmt.raw.0 = "assign" then append [stmt.raw.1] env else env + in + prog_gen_aux newEnv (append [stmt.raw] p) (append [stmt.shrinker] s) (i-1) + end + val (prog, shrinkers) = prog_gen_aux [] [] [] num_of_insts + fun shrinker inst = inst (* DUMMY function - needs to be fixed *) + in + {raw = prog, shrinker = shrinker} + end + + + in +interpret statements end \ No newline at end of file From 9fc580c3f97da005cab7cfc0b1681dc77e18be10 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 12 Apr 2024 10:34:08 +0200 Subject: [PATCH 049/121] updated list shrinking to remove shrinkers related to removed elements --- troupecheck/tc.trp | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 7091361..0ac1dec 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -250,27 +250,28 @@ SHRINKING - r let val removeIdx = (length (rec.curr)) - 1 val newList = remove_nth removeIdx rec.curr 0 in - {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx} + {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = shrinkers} end | "cont_size" => - let val remove_idx = (rec.idx - 1) + let val new_shrinkers = remove_nth rec.idx rec.shrinkers + val remove_idx = (rec.idx - 1) val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" val new_list = remove_nth remove_idx rec.curr 0 in - {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx} + {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx, shrinkers = new_shrinkers} end | "cont_elem" => - let val interim_list = mapi (fn (i, x) => (nth shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr + let val interim_list = mapi (fn (i, x) => (nth rec.shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" val new_list = map (fn x => x.curr) interim_list in - {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx} + {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx, shrinkers = shrinkers} end | "rollback" => if (length rec.curr) = (length rec.prev) then - {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} (* TODO: this loops an unecesary amount of times *) + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers} (* TODO: this loops an unecesary amount of times *) else - {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx} + {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers} | "done" => rec @@ -505,6 +506,12 @@ CONVENIENCE FUNCTIONS - s fun tuple ts = tuple_gen ts fun record ns ts = rec_gen ns ts + + fun one_of ls = + let val idx = (int_gen (1, (length ls)) ((length ls))).raw + in + nth ls idx + end (* From 360336a647d66963ba8daf5b821034edc5bec563 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 12 Apr 2024 11:12:46 +0200 Subject: [PATCH 050/121] shrink prog maybe working - NOT TESTED --- troupecheck/language_interpreter.trp | 44 +++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/troupecheck/language_interpreter.trp b/troupecheck/language_interpreter.trp index b82ac6f..f027ae3 100644 --- a/troupecheck/language_interpreter.trp +++ b/troupecheck/language_interpreter.trp @@ -154,6 +154,28 @@ let fun eval exp env = {raw = res.raw, shrinker = res.shrinker} end end + fun assign_in_use_aux stm_or_exp assign idx = + case stmt_or_exp.0 of + "print" => + assign_in_use_aux stmt_or_exp.1 assign idx + | "assign" => + assign_in_use_aux stmt_or_exp.2 assign idx + | "var" => if stm_or_exp.1 = assign then true else false + | "num" => false + | _ => + if assign_in_use stmt_or_exp.1 assign idx then + true + else assign_in_use_aux stm_or_exp.2 assign idx + + fun assign_in_use [] idxs assign idx bool = bool + | assign_in_use (x::xs) idxs assign idx bool = + let val res = assign_in_use_aux x assign (length (x::xs)) idx in + if res then assign_in_use xs (append [idx] idxs) assign idx+1 true + else assign_in_use xs idxs assign idx+1 bool + + + + fun program_gen size = let val num_of_insts = int_gen(0, size) size fun prog_gen_aux env p 0 = p @@ -164,7 +186,27 @@ let fun eval exp env = prog_gen_aux newEnv (append [stmt.raw] p) (append [stmt.shrinker] s) (i-1) end val (prog, shrinkers) = prog_gen_aux [] [] [] num_of_insts - fun shrinker inst = inst (* DUMMY function - needs to be fixed *) + fun shrinker inst = + case inst.state of + "init" => + let val shrunk = shrink_list shrinkers inst + in shrunk end + | "cont_size" => + let val next_elem = inst.curr[inst.idx-1] + in + if next_elem.0 = "assign" then + if (assign_in_use(next_elem.1)).0 then + {inst with idx = inst.idx-1} + else + shrink_list shrinkers inst + else + shrink_list shrinkers inst + end + | _ => + shrink_list shrinkers inst + + + in {raw = prog, shrinker = shrinker} end From 24ca5f291d6a46f4cc5b2fb526c741198b7a2b11 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 12 Apr 2024 11:39:31 +0200 Subject: [PATCH 051/121] fixed bug in list_shrinking --- troupecheck/language_interpreter.trp | 20 +-- troupecheck/tc.trp | 238 ++++++++++++++++++++++++++- 2 files changed, 239 insertions(+), 19 deletions(-) diff --git a/troupecheck/language_interpreter.trp b/troupecheck/language_interpreter.trp index f027ae3..f6bf2e4 100644 --- a/troupecheck/language_interpreter.trp +++ b/troupecheck/language_interpreter.trp @@ -165,13 +165,16 @@ let fun eval exp env = | _ => if assign_in_use stmt_or_exp.1 assign idx then true - else assign_in_use_aux stm_or_exp.2 assign idx + else + assign_in_use_aux stm_or_exp.2 assign idx fun assign_in_use [] idxs assign idx bool = bool | assign_in_use (x::xs) idxs assign idx bool = - let val res = assign_in_use_aux x assign (length (x::xs)) idx in - if res then assign_in_use xs (append [idx] idxs) assign idx+1 true - else assign_in_use xs idxs assign idx+1 bool + let val res = assign_in_use_aux x assign (length (x::xs)) idx + in + if res then assign_in_use xs (append [idx] idxs) assign idx+1 true + else assign_in_use xs idxs assign idx+1 bool + end @@ -203,14 +206,9 @@ let fun eval exp env = shrink_list shrinkers inst end | _ => - shrink_list shrinkers inst - - - + shrink_list shrinkers inst in {raw = prog, shrinker = shrinker} end - - - in +in interpret statements end \ No newline at end of file diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 0ac1dec..cd49af8 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -161,7 +161,13 @@ SHRINKING - r let val ls_curr = string_to_list rec_checked.curr val ls_prev = string_to_list rec_checked.prev val shrinkers = map (fn _ => shrink_char) ls_curr - val interim_res = shrink_list shrinkers {state = rec_checked.state, curr = ls_curr, prev = ls_prev, idx = rec_checked.next_shrink_info} + val interim_res = + shrink_list shrinkers {state = rec_checked.state, + curr = ls_curr, + prev = ls_prev, + idx = rec_checked.next_shrink_info, + shrinkers = shrinkers, + prev_shrinkers = shrinkers} val new_curr = list_to_string interim_res.curr val new_prev = list_to_string interim_res.prev @@ -249,29 +255,30 @@ SHRINKING - r "init" => let val removeIdx = (length (rec.curr)) - 1 val newList = remove_nth removeIdx rec.curr 0 + val new_shrinkers = remove_nth removeIdx shrinkers 0 in - {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = shrinkers} + {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = new_shrinkers, prev_shrinkers = shrinkers} end | "cont_size" => - let val new_shrinkers = remove_nth rec.idx rec.shrinkers - val remove_idx = (rec.idx - 1) + let val remove_idx = (rec.idx - 1) val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" val new_list = remove_nth remove_idx rec.curr 0 + val new_shrinkers = remove_nth remove_idx rec.shrinkers 0 in - {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx, shrinkers = new_shrinkers} + {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx, shrinkers = new_shrinkers, prev_shrinkers = rec.shrinkers} end | "cont_elem" => let val interim_list = mapi (fn (i, x) => (nth rec.shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" val new_list = map (fn x => x.curr) interim_list in - {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx, shrinkers = shrinkers} + {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers, prev_shrinkers = rec.prev_shrinkers} end | "rollback" => if (length rec.curr) = (length rec.prev) then - {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers} (* TODO: this loops an unecesary amount of times *) + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} (* TODO: this loops an unecesary amount of times *) else - {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers} + {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} | "done" => rec @@ -682,6 +689,221 @@ TC^2 - z fun tc_sort_ordered_always_true () = tc [list(integer())] my_sort_is_ordered = true + +(* +-------------------------------- +CUSTOM TYPE PROGRAM +-------------------------------- +*) +fun eval exp env = + case exp of + ("num", n) => n + | ("var", n) => lookup env n ("unknown variable " ^ n) + | ("add", e1, e2) => (eval e1 env) + (eval e2 env) + | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) + | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) + | ("div", e1, e2) => (eval e1 env) / (eval e2 env) + | _ => print ("Error: ill defined expression: "); exit (authority, 1) + + fun execute stmt env = + case stmt of + ("assign", var, exp) => + let val value = eval exp env + in + append [(var, value)] env + end + | ("print", exp) => (print (toString (eval exp env)); env) + + fun interpret stmts = + let fun interpretHelper [] env = env + | interpretHelper (stmt :: rest) env = + let val newEnv = execute stmt env + in + interpretHelper rest newEnv + end + in + (interpretHelper stmts []) + end + + val statements = [ + ("assign", "x", ("num", 5)), + ("assign", "y", ("num", 7)), + ("print", ("var", "x")), + ("print", ("var", "y")), + ("print", ("add", ("var", "x"), ("var", "y"))) + ] + + fun one_of ls = + let val idx = (int_gen (1, (length ls)) ((length ls))).raw + in + nth ls idx + end + + fun exp_gen ls size = + let val exp_ts = ["num", "var", "add", "sub", "mul", "div"] + val exp_type_interim = one_of exp_ts + val exp_type = if (exp_type_interim = "var") andalso (length ls = 0) then "num" else "var" + in + case exp_type of + "num" => + let val value = int_gen(inf, inf) size + fun shrinker inst = + let val shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in + {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in + {raw = ("num", value.raw), shrinker = shrinker} end + | "var" => + let val value = one_of ls size + fun shrinker inst = + {inst with state = "done"} in + {raw = ("var", value), shrinker = shrinker} end + |"add" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("add", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} + end + |"sub" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("sub", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} + end + |"mul" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("mul", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} + end + |"div" => + let val e1 = exp_gen ls size + val e2 = exp_gen ls size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} + val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + in + {state = next_state, curr = ("div", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + end + in + {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} + end + end + + fun assign_stmt_gen ls size = + let val n = string_gen size + val exp = exp_gen ls size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val shrunk_assign = ("assign", n, shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} + end + in + {raw = ("assign", n, exp.raw), shrinker = shrinker} + end + + fun print_stmt_gen ls size = + let val exp = exp_gen ls size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val shrunk_print = ("print", shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} + end + in + {raw = ("print", exp.raw), shrinker = shrinker} + end + + fun stmt_gen ls size = + let val stmt = one_of ["assign", "print"] + in + case stmt of + "assign" => + let val res = assign_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + |"print" => + let val res = print_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + end + + fun assign_in_use_aux stmt_or_exp assign idx = + case stmt_or_exp.0 of + "print" => + assign_in_use_aux stmt_or_exp.1 assign idx + | "assign" => + assign_in_use_aux stmt_or_exp.2 assign idx + | "var" => if stmt_or_exp.1 = assign then true else false + | "num" => false + | _ => + if assign_in_use_aux stmt_or_exp.1 assign idx then + true + else + assign_in_use_aux stmt_or_exp.2 assign idx + + fun assign_in_use [] idxs assign idx bool = bool + | assign_in_use (x::xs) idxs assign idx bool = + let val res = assign_in_use_aux x assign (length (x::xs)) idx + in + if res then assign_in_use xs (append [idx] idxs) assign idx+1 true + else assign_in_use xs idxs assign idx+1 bool + end + + + + + fun program_gen size = + let val num_of_insts = int_gen(0, size) size + fun prog_gen_aux env p s 0 = (p, s) + | prog_gen_aux env p s i = + let val stmt = stmt_gen env size + val newEnv = if stmt.raw.0 = "assign" then append [stmt.raw.1] env else env + in + prog_gen_aux newEnv (append [stmt.raw] p) (append [stmt.shrinker] s) (i-1) + end + val (prog, shrinkers) = prog_gen_aux [] [] [] num_of_insts + fun shrinker inst = + case inst.state of + "init" => + let val shrunk = shrink_list shrinkers inst + in shrunk end + | "cont_size" => + let val next_elem = inst.curr[inst.idx-1] + in + if next_elem.0 = "assign" then + if (assign_in_use(next_elem.1)).0 then + {inst with idx = inst.idx-1} + else + shrink_list shrinkers inst + else + shrink_list shrinkers inst + end + | _ => + shrink_list shrinkers inst + in + {raw = prog, shrinker = shrinker} + end + in (* From 75c07257939e03a698df6f824ebe9812febd57ec Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 14 Apr 2024 20:48:52 +0200 Subject: [PATCH 052/121] program generation and shrinking implemented --- troupecheck/language_interpreter.trp | 8 +- troupecheck/tc.trp | 166 ++++++++++++++------------- 2 files changed, 93 insertions(+), 81 deletions(-) diff --git a/troupecheck/language_interpreter.trp b/troupecheck/language_interpreter.trp index f6bf2e4..5a4c518 100644 --- a/troupecheck/language_interpreter.trp +++ b/troupecheck/language_interpreter.trp @@ -55,7 +55,7 @@ let fun eval exp env = "num" => let val value = int_gen(inf, inf) size fun shrinker inst = - let shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in + let val shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in {raw = ("num", value.raw), shrinker = shrinker} end | "var" => @@ -181,8 +181,8 @@ let fun eval exp env = fun program_gen size = let val num_of_insts = int_gen(0, size) size - fun prog_gen_aux env p 0 = p - | prog_gen_aux env p s i = (p,s) + fun prog_gen_aux env p 0 = (p,s) + | prog_gen_aux env p s i = let val stmt = stmt_gen env size val newEnv = if stmt.raw.0 = "assign" then append [stmt.raw.1] env else env in @@ -211,4 +211,4 @@ let fun eval exp env = {raw = prog, shrinker = shrinker} end in -interpret statements end \ No newline at end of file +print (program_gen 50) end \ No newline at end of file diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index cd49af8..a17551e 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -353,7 +353,7 @@ GENERATORS - t (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) fun int_gen (low, high) size = - let val raw_res = floor ((float_gen(low, high) size).raw) + let val raw_res = floor ((float_gen(low, high+1) size).raw) in {raw = raw_res, shrinker = shrink_int} end @@ -515,12 +515,10 @@ CONVENIENCE FUNCTIONS - s fun record ns ts = rec_gen ns ts fun one_of ls = - let val idx = (int_gen (1, (length ls)) ((length ls))).raw - in - nth ls idx - end - - + let val idx = (int_gen (1, (length ls)) ((length ls))).raw + in + nth ls idx + end (* -------------------------------- FUNCTIONS FOR TESTING - d @@ -695,7 +693,7 @@ TC^2 - z CUSTOM TYPE PROGRAM -------------------------------- *) -fun eval exp env = + fun eval exp env = case exp of ("num", n) => n | ("var", n) => lookup env n ("unknown variable " ^ n) @@ -703,7 +701,7 @@ fun eval exp env = | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) | ("div", e1, e2) => (eval e1 env) / (eval e2 env) - | _ => print ("Error: ill defined expression: "); exit (authority, 1) + | _ => print ("Error: ill defined expression"); exit (authority, 1) fun execute stmt env = case stmt of @@ -724,25 +722,32 @@ fun eval exp env = in (interpretHelper stmts []) end - - val statements = [ - ("assign", "x", ("num", 5)), - ("assign", "y", ("num", 7)), - ("print", ("var", "x")), - ("print", ("var", "y")), - ("print", ("add", ("var", "x"), ("var", "y"))) - ] - fun one_of ls = - let val idx = (int_gen (1, (length ls)) ((length ls))).raw - in - nth ls idx - end + (* fun optimize_prog prog = + let fun optimize_exp exp = + case exp of + ("num", n) => ("num", n) + | ("var", x) => ("var", x) + | ("add", ("num", n1), ("num", n2)) => ("num", (n1 + n2)) + | ("sub", ("num", n1), ("num", n2)) => ("num", (n1 - n2)) + | ("mul", ("num", n1), ("num", n2)) => ("num", (n1 * n2)) + | ("div", ("num", n1), ("num", n2)) => ("num", (n1 / n2)) + | ("add", e1, e2) => ("add", (optimize_exp e1), (optimize_exp e2)) + | ("sub", e1, e2) => ("sub", (optimize_exp e1), (optimize_exp e2)) + | ("mul", e1, e2) => ("mul", (optimize_exp e1), (optimize_exp e2)) + | ("div", e1, e2) => ("div", (optimize_exp e1), (optimize_exp e2)) + + fun optimize_stmt stmt = + case stmt of + ("assign", var, exp) => ("assign", var, (optimize_exp exp)) + | ("print", exp) => ("print", (optimize_exp exp)) + in + map optimize_stmt prog + end *) - fun exp_gen ls size = - let val exp_ts = ["num", "var", "add", "sub", "mul", "div"] - val exp_type_interim = one_of exp_ts - val exp_type = if (exp_type_interim = "var") andalso (length ls = 0) then "num" else "var" + fun exp_gen ls nesting_level size = + let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] + val exp_type = if nesting_level = 2 then "num" else one_of exp_ts in case exp_type of "num" => @@ -752,58 +757,58 @@ fun eval exp env = {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in {raw = ("num", value.raw), shrinker = shrinker} end | "var" => - let val value = one_of ls size + let val value = one_of ls fun shrinker inst = {inst with state = "done"} in {raw = ("var", value), shrinker = shrinker} end |"add" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state in - {state = next_state, curr = ("add", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + {state = next_state, curr = ("add", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} end in {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} end |"sub" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state in - {state = next_state, curr = ("sub", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + {state = next_state, curr = ("sub", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} end in {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} end |"mul" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state in - {state = next_state, curr = ("mul", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + {state = next_state, curr = ("mul", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} end in {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} end |"div" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state in - {state = next_state, curr = ("div", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} + {state = next_state, curr = ("div", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} end in {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} @@ -812,21 +817,21 @@ fun eval exp env = fun assign_stmt_gen ls size = let val n = string_gen size - val exp = exp_gen ls size + val exp = exp_gen ls 0 size fun shrinker inst = let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val shrunk_assign = ("assign", n, shrunk_exp.curr) + val shrunk_assign = ("assign", n.raw, shrunk_exp.curr) in {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} end in - {raw = ("assign", n, exp.raw), shrinker = shrinker} + {raw = ("assign", n.raw, exp.raw), shrinker = shrinker} end fun print_stmt_gen ls size = - let val exp = exp_gen ls size + let val exp = exp_gen ls 0 size fun shrinker inst = - let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} val shrunk_print = ("print", shrunk_exp.curr) in {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} @@ -861,37 +866,37 @@ fun eval exp env = else assign_in_use_aux stmt_or_exp.2 assign idx - fun assign_in_use [] idxs assign idx bool = bool + fun assign_in_use [] idxs assign idx bool = (bool, idxs) | assign_in_use (x::xs) idxs assign idx bool = - let val res = assign_in_use_aux x assign (length (x::xs)) idx + let val res = assign_in_use_aux x assign idx in - if res then assign_in_use xs (append [idx] idxs) assign idx+1 true - else assign_in_use xs idxs assign idx+1 bool + if res then assign_in_use xs (append [idx] idxs) assign (idx+1) true + else assign_in_use xs idxs assign (idx+1) bool end - - - fun program_gen size = - let val num_of_insts = int_gen(0, size) size + let val num_of_insts = (int_gen(0, size) size ).raw fun prog_gen_aux env p s 0 = (p, s) | prog_gen_aux env p s i = let val stmt = stmt_gen env size - val newEnv = if stmt.raw.0 = "assign" then append [stmt.raw.1] env else env + val newEnv = if stmt.raw.0 = "assign" then (append [stmt.raw.1] env) else env in - prog_gen_aux newEnv (append [stmt.raw] p) (append [stmt.shrinker] s) (i-1) + prog_gen_aux newEnv (append p [stmt.raw]) (append s [stmt.shrinker]) (i-1) end val (prog, shrinkers) = prog_gen_aux [] [] [] num_of_insts fun shrinker inst = case inst.state of "init" => let val shrunk = shrink_list shrinkers inst - in shrunk end + in + shrunk + end | "cont_size" => - let val next_elem = inst.curr[inst.idx-1] - in + let val next_elem = nth inst.curr (length inst.curr) (* TODO: goes wrong *) + in if next_elem.0 = "assign" then - if (assign_in_use(next_elem.1)).0 then + if (assign_in_use inst.curr [] (next_elem.1) 0 false).0 then + print "testing"; {inst with idx = inst.idx-1} else shrink_list shrinkers inst @@ -903,7 +908,12 @@ fun eval exp env = in {raw = prog, shrinker = shrinker} end - + + fun test_prog_shrink prog = + (interpret prog) = [] + val exp = exp_gen [] 0 3 + val stmt = stmt_gen [] 3 + val prog = program_gen 10 in (* @@ -912,23 +922,25 @@ ALL TESTS - x -------------------------------- *) +tc [program_gen] test_prog_shrink + (* shrinking tests - x *) -tc [list(integer()), integer()] test_bad_insert; +(* tc [list(integer()), integer()] test_bad_insert; tc [integer()] (test_bad_half, (fn x => x >= 15)); tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; *) (* tc^2 tests *) (* tc [] tc_sort_ordered_always_true; *) (* User guide tests *) -tc [list(integer()), integer()] cons_length_increase; +(* tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); +tc [list(integer())] (my_sort_keep_length, no_duplicates); *) (* General functionality tests *) -tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; tc [] no_args; tc [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; @@ -954,5 +966,5 @@ tc [float()] my_ceil_1_test; write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; -tc [float()] both_ceil_test +tc [float()] both_ceil_test *) end \ No newline at end of file From c41075458808600831313522e711a4b9f2937330 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 15 Apr 2024 11:55:00 +0200 Subject: [PATCH 053/121] changed so that custom programs end in with and expression, which is returned --- troupecheck/tc.trp | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index a17551e..83cd636 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -712,19 +712,23 @@ CUSTOM TYPE PROGRAM end | ("print", exp) => (print (toString (eval exp env)); env) - fun interpret stmts = + fun interpret prog = let fun interpretHelper [] env = env | interpretHelper (stmt :: rest) env = let val newEnv = execute stmt env in interpretHelper rest newEnv end + val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + val last_env = (interpretHelper stmts []) in - (interpretHelper stmts []) + eval exp last_env end (* fun optimize_prog prog = let fun optimize_exp exp = + print "testing"; case exp of ("num", n) => ("num", n) | ("var", x) => ("var", x) @@ -743,7 +747,7 @@ CUSTOM TYPE PROGRAM | ("print", exp) => ("print", (optimize_exp exp)) in map optimize_stmt prog - end *) + end *) fun exp_gen ls nesting_level size = let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] @@ -811,7 +815,7 @@ CUSTOM TYPE PROGRAM {state = next_state, curr = ("div", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} end in - {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} + {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} (* maybe just shrinker? *) end end @@ -876,14 +880,17 @@ CUSTOM TYPE PROGRAM fun program_gen size = let val num_of_insts = (int_gen(0, size) size ).raw - fun prog_gen_aux env p s 0 = (p, s) + fun prog_gen_aux env p s 0 = (p, s, env) | prog_gen_aux env p s i = let val stmt = stmt_gen env size val newEnv = if stmt.raw.0 = "assign" then (append [stmt.raw.1] env) else env in prog_gen_aux newEnv (append p [stmt.raw]) (append s [stmt.shrinker]) (i-1) end - val (prog, shrinkers) = prog_gen_aux [] [] [] num_of_insts + val (prog_stmts, shrinkers_interim, last_env) = prog_gen_aux [] [] [] num_of_insts + val last_exp = exp_gen last_env 0 size + val prog = append prog_stmts [last_exp.raw] + val shrinkers = append shrinkers_interim [last_exp.shrinker] fun shrinker inst = case inst.state of "init" => @@ -892,13 +899,17 @@ CUSTOM TYPE PROGRAM shrunk end | "cont_size" => - let val next_elem = nth inst.curr (length inst.curr) (* TODO: goes wrong *) + let val next_elem = nth inst.curr (length inst.curr) in if next_elem.0 = "assign" then if (assign_in_use inst.curr [] (next_elem.1) 0 false).0 then print "testing"; {inst with idx = inst.idx-1} - else + else if (next_elem.0 = "var") orelse (next_elem.0 = "num") orelse (next_elem.0 = "add") orelse (next_elem.0 = "sub") orelse + (next_elem.0 = "mul") orelse (next_elem.0 = "div") then + {inst with idx = inst.idx-1} + + else shrink_list shrinkers inst else shrink_list shrinkers inst @@ -922,7 +933,8 @@ ALL TESTS - x -------------------------------- *) -tc [program_gen] test_prog_shrink +interpret (prog.raw) +(* tc [program_gen] test_prog_shrink *) (* shrinking tests - x *) (* tc [list(integer()), integer()] test_bad_insert; From a0732499613ef6416878076cf7c09926c29b84b3 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 17 Apr 2024 14:05:55 +0200 Subject: [PATCH 054/121] trying to fix shrinking of programs --- troupecheck/tc.trp | 56 +++++++++++++++++++++++++++++----------------- 1 file changed, 36 insertions(+), 20 deletions(-) diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index 83cd636..d18f90d 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -256,8 +256,9 @@ SHRINKING - r let val removeIdx = (length (rec.curr)) - 1 val newList = remove_nth removeIdx rec.curr 0 val new_shrinkers = remove_nth removeIdx shrinkers 0 + val next_state = if length newList = 0 then "cont_elem" else "cont_size" in - {state = "cont_size", curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = new_shrinkers, prev_shrinkers = shrinkers} + {state = next_state, curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = new_shrinkers, prev_shrinkers = shrinkers} end | "cont_size" => let val remove_idx = (rec.idx - 1) @@ -726,28 +727,45 @@ CUSTOM TYPE PROGRAM eval exp last_env end - (* fun optimize_prog prog = - let fun optimize_exp exp = - print "testing"; + fun optimize_prog prog = + let val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + fun optimize_exp exp = case exp of ("num", n) => ("num", n) | ("var", x) => ("var", x) - | ("add", ("num", n1), ("num", n2)) => ("num", (n1 + n2)) - | ("sub", ("num", n1), ("num", n2)) => ("num", (n1 - n2)) - | ("mul", ("num", n1), ("num", n2)) => ("num", (n1 * n2)) - | ("div", ("num", n1), ("num", n2)) => ("num", (n1 / n2)) - | ("add", e1, e2) => ("add", (optimize_exp e1), (optimize_exp e2)) - | ("sub", e1, e2) => ("sub", (optimize_exp e1), (optimize_exp e2)) - | ("mul", e1, e2) => ("mul", (optimize_exp e1), (optimize_exp e2)) - | ("div", e1, e2) => ("div", (optimize_exp e1), (optimize_exp e2)) + | ("add", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1+n2)) + |_ => ("add", (optimize_exp e1), (optimize_exp e2))) + | _ => ("add", (optimize_exp e1), (optimize_exp e2))) + | ("sub", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1-n2)) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2))) + | ("mul", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1*n2)) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2))) + | ("div", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => if ((n1 = 0) andalso (n2 = 0)) then ("div", e1, e2) else ("num", (n1/n2)) + |_ => ("div", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("div", (optimize_exp e1), (optimize_exp e2))) fun optimize_stmt stmt = case stmt of ("assign", var, exp) => ("assign", var, (optimize_exp exp)) | ("print", exp) => ("print", (optimize_exp exp)) in - map optimize_stmt prog - end *) + append (map optimize_stmt stmts) [optimize_exp exp] + end fun exp_gen ls nesting_level size = let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] @@ -920,11 +938,11 @@ CUSTOM TYPE PROGRAM {raw = prog, shrinker = shrinker} end - fun test_prog_shrink prog = - (interpret prog) = [] + fun test_prog_opt prog = + (interpret prog) = (interpret (optimize_prog prog)) val exp = exp_gen [] 0 3 val stmt = stmt_gen [] 3 - val prog = program_gen 10 + val prog = program_gen 2 in (* @@ -932,9 +950,7 @@ in ALL TESTS - x -------------------------------- *) - -interpret (prog.raw) -(* tc [program_gen] test_prog_shrink *) +tc [program_gen] test_prog_opt (* shrinking tests - x *) (* tc [list(integer()), integer()] test_bad_insert; From 89e3a8251fe69a32fc77f8ae0e1d185400cf0bbd Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 18 Apr 2024 16:49:29 +0200 Subject: [PATCH 055/121] working on integrated shrinking --- troupecheck/integrated_shrinking.trp | 1024 ++++++++++++++++++++++++++ 1 file changed, 1024 insertions(+) create mode 100644 troupecheck/integrated_shrinking.trp diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp new file mode 100644 index 0000000..01f8344 --- /dev/null +++ b/troupecheck/integrated_shrinking.trp @@ -0,0 +1,1024 @@ +import lists +(* +-------------------------------- +PRINTING TO CONSOLE - q +-------------------------------- +*) +let val out = getStdout authority + fun write x = fwrite (out, x) + (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) + fun args_toString args = + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x) in + aux_toString "" args end +(* +-------------------------------- +ERROR HANDLING - w +-------------------------------- +*) + fun report_error error_reason = + write "\u001B[31m \nError: "; (* Changing the print color to red *) + let val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + | ("shrinking_looped", _) => "Shrinking looped.\n" + | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" + in + write (err_string ^ "\u001B[0m"); (* Changing the color back *) + exit (authority, 0) end + + fun boolean_check x = + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () + + fun function_not_done_check p = + if (getType p)<>"function" then report_error ("type_mismatch", 0) else () +(* +-------------------------------- +UTILS - e +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + + fun abs_value x = + if x < 0 then -x else x + +(* applies the list of arguments to the property - one by one - reporting errors along the way *) +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l = + case l of + [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in + boolean_check res; + res + end + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + fun list_to_string ls = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) + + fun report_fail_reason rec noOfTests= + case rec.failReason of + "false_prop" => + write "\nFailure at input: "; + write (args_toString rec.ctx); + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) +(* +-------------------------------- +SHRINKING - r +-------------------------------- +*) + + and shrink_float 0 = [0] + | shrink_float n = + let val current = floor ((abs_value n) / 2) + fun ret_fun () = [n-current, fn () => shrink_float (floor(current/2))] in + [0, ret_fun] end + + and shrink_int rec = + let val interim = shrink_float rec + in + {interim with curr = floor(interim.curr)} + end + + and shrink_bool rec = + let val rec_checked = if rec.curr = false then {rec with state = "done"} else rec + in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} + |"done" => + rec_checked + | _ => + let val newVal = false + in + {state = "cont", curr = newVal, prev = rec_checked.curr} + end + end + + (* input/returns - {state: string, curr: string, prev: string} *) + and shrink_string rec = + let val rec_checked = if rec.state = "init" then {rec with next_shrink_info = 0} else rec in + case rec_checked.state of + "cont_elem" => + {rec_checked with state = "done"} (* TODO: Should actually shrink characters *) + | _ => + let val ls_curr = string_to_list rec_checked.curr + val ls_prev = string_to_list rec_checked.prev + val shrinkers = map (fn _ => shrink_char) ls_curr + val interim_res = + shrink_list shrinkers {state = rec_checked.state, + curr = ls_curr, + prev = ls_prev, + idx = rec_checked.next_shrink_info, + shrinkers = shrinkers, + prev_shrinkers = shrinkers} + val new_curr = list_to_string interim_res.curr + val new_prev = list_to_string interim_res.prev + + val res = {state = interim_res.state, curr = new_curr, prev = new_prev, next_shrink_info = interim_res.idx} + in + res + end + end + + and shrink_char rec = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec + val curr_val = rec_checked.curr in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} + | "done" => + rec_checked + | "init" => + let val index_of_new = (lookup chars rec.curr 2) - 1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + | _ => + let val index_of_new = rec.idx-1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + end + + and shrink_sized_aggregate vals builder rec = + case rec.state of + "init" => + let val init_shrink_idx = 0 + val new_vals = mapi (fn (i, x) => + if i = init_shrink_idx then (x.shrinker {state = "init", curr = x.raw, prev = x.raw}) + else {state = "init", curr = x.raw, prev = x.raw}) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} + end + | "cont" => + let val init_shrink_idx = rec.shrink_idx + val new_vals = mapi (fn (i, x) => + if i = init_shrink_idx then x.shrinker (nth rec.next_shrink_info (i+1)) + else (nth rec.next_shrink_info (i+1))) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} + end + | "done" => + rec + | "rollback" => + let val init_shrink_idx = rec.shrink_idx + fun rollback_aux (i, x) = + if i = init_shrink_idx then + (let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} + in + x.shrinker val_to_shrink + end ) + else (nth rec.next_shrink_info (i+1)) + val rollback_args = mapi rollback_aux vals + val new_raw_vals = map (fn x => x.curr) rollback_args + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true rollback_args) then "done" else "cont" + val shrink_idx = if (nth rollback_args (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = rollback_args, shrink_idx = shrink_idx} + end + + and shrink_list shrinkers rec = + if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr, idx = 0} + else + case rec.state of + "init" => + let val removeIdx = (length (rec.curr)) - 1 + val newList = remove_nth removeIdx rec.curr 0 + val new_shrinkers = remove_nth removeIdx shrinkers 0 + val next_state = if length newList = 0 then "cont_elem" else "cont_size" + in + {state = next_state, curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = new_shrinkers, prev_shrinkers = shrinkers} + end + | "cont_size" => + let val remove_idx = (rec.idx - 1) + val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" + val new_list = remove_nth remove_idx rec.curr 0 + val new_shrinkers = remove_nth remove_idx rec.shrinkers 0 + in + {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx, shrinkers = new_shrinkers, prev_shrinkers = rec.shrinkers} + end + | "cont_elem" => + let val interim_list = mapi (fn (i, x) => (nth rec.shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr + val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" + val new_list = map (fn x => x.curr) interim_list + in + {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers, prev_shrinkers = rec.prev_shrinkers} + end + | "rollback" => + if (length rec.curr) = (length rec.prev) then + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} (* TODO: this loops an unecesary amount of times *) + else + {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} + | "done" => + rec + + and args_shrink args = + case args.state of + "rollback" => + let val init_shrink_idx = args.shrink_idx + val rollbackReadyArgs = mapi (fn (i, x) => if (x.state = "done") orelse (i<>init_shrink_idx) then x else {x with state = "rollback"}) args.args + val argsRolledBack = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) rollbackReadyArgs + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true argsRolledBack) then "done" else "cont" + val shrink_idx = if (nth argsRolledBack (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = nextState, args = argsRolledBack, shrinkers = args.shrinkers, shrink_idx = shrink_idx} + end + | "done" => + args + | _ => + let val init_shrink_idx = args.shrink_idx + val newArgs = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) args.args + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" + val shrink_idx = if (nth newArgs (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + + in + {state = nextState, args = newArgs, shrinkers = args.shrinkers, shrink_idx = shrink_idx} + end + + fun shrink_aux args prop pre counter = + if counter = 100 then report_error ("shrinking_looped", 0) else + let val shrunk_args = args_shrink args + val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in + case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers, shrink_idx = args.shrink_idx}) prop pre (counter) + | false => + if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end + fun rep_rng [] = () + | rep_rng (x::xs) = + {rnd = x, seq = xs} + + fun rec_rng ls = + let val rnd = random() in + {rnd = rnd, seq = append ls [rnd]} end + + fun dec_nth list idx = + let fun dec_nth_aux [] acc i = acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => dec_nth_aux xs (append acc [(x/2)/2]) (i+1) + | false => dec_nth_aux xs (append acc [x]) (i+1) + in + dec_nth_aux list [] 0 end + + fun shrink_aux seqs gens prop pre size = + print seqs; + case seqs of + (x1::x2::xs) => + let val (test_args, _) = + foldl (fn (x,y) => + let val rnd = x y.1 rep_rng size in + (append y.0 [rnd.raw], rnd.sequence) end)([], x2) gens + val _ = print test_args + val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true + in + case (apply_args prop test_args) orelse (precond_is_met = false) of + true => print "test"; shrink_aux (x1::xs) gens prop pre size + |false => shrink x2 gens prop pre size + end + | (x::xs) => (foldl (fn (z,y) => + let val rnd = z y.1 rep_rng in + (append y.0 rnd.raw, rnd.sequence) end) ([], x) gens).0 + + and shrink sequence gens prop pre size = + if foldl (fn (x,y) => (x < 1/100) andalso y) true sequence then + shrink_aux [sequence] gens prop pre size + else + let val decreased_seqs = mapi (fn (i, x) => dec_nth sequence i) sequence + val dec_seqs_w_root = append [sequence] decreased_seqs + val res = shrink_aux dec_seqs_w_root gens prop pre size + in res end +(* +-------------------------------- +GENERATORS - t +-------------------------------- +*) + (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) + (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) + fun float_gen (low, high) ls rng size = + let val x = rng ls + val bool_int = rng x.seq + val bool = bool_int.rnd < 1/2 + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + val raw_res = + case (lInf, hInf) of + (true, true) => if bool then x.rnd*size else -x.rnd*size + | (true, false) => high - (x.rnd*size) + | (false, true) => low + (x.rnd*size) + | (false, false) => low + (x.rnd * (high-low)) + in + {raw = raw_res, sequence = bool_int.seq} + end + + fun int_gen (low, high) ls rng size = + let val res = (float_gen (low, high+1) ls rng size) + val raw_res = floor (res.raw) + in + {raw = raw_res, sequence = res.sequence} + end + (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) + fun bool_gen ls rng size = + let val rnd = int_gen (0,1) ls rng size + val res = if rnd.raw = 0 then false + else true + in + {raw = res, sequence = rnd.sequence} + end + + (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) + fun list_gen (generator) ls rng size = + let val length = (int_gen (0, size) ls rng size) + val res = make_list ((fn () => generator ls rng size), length.raw) + val raw_res = map (fn x => x.raw) res + val sequence = foldl (fn (x,y) => append y x.sequence) [length.sequence] res in + {raw = raw_res, sequence = sequence} + end + + (* NOTE: Generates only letters (upper and lower case) and numbers. *) + (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) + fun char_gen ls rng size = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = (int_gen (1, ((length chars)-1)) ls rng size) + in + {raw = (nth chars x.raw), sequence = x.sequence} + end + +(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) + fun string_gen ls rng size = + let val x = (int_gen (0, size) ls rng size).raw + fun fold f acc 0 = acc + | fold f acc i = fold f (acc ^ (f())) (i-1) + val raw_string = (fold (fn () => (char_gen ls rng x).raw) "" x) + in + {raw = raw_string, shrinker = shrink_string} + end + +(* NOTE: Hardcoded for tuple of up to 10 elements *) +(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list + of all generated values in raw_inst along with their respective meta_data. *) + fun tuple_gen rng ts size = + let val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw) ts_vals + val ts_shrinkers = map (fn x => x.shrinker) ts_vals + in + {raw = (build_tuple ts_raw_vals), shrinker = shrink_sized_aggregate ts_vals build_tuple} + end + +(* +ns: list of strings - will be used as fieldnames +ts: list of generators - used to generate values for fields + +Returns record: {raw_inst = <>, meta_data = (ns, <>)} +*) + fun rec_gen rng ns ts size = + if (length ns) <> (length ts) then + report_error ("record_mismatch", 0) + else + let val ts_vals = map (fn x => x size) ts + val ts_raw_vals = map (fn x => x.raw) ts_vals + val raw_res = build_record ns ts_raw_vals + in + {raw = raw_res, shrinker = shrink_sized_aggregate ts_vals (build_record ns)} + end + + + fun generator_gen rng size = + let val rnd = int_gen rng (1,7) size + val inf = 1/0 + val res = if rnd = 1 then ((fn i => int_gen rng (inf, inf) i)) else + if rnd = 2 then ((fn i => bool_gen rng i)) else + if rnd = 3 then ((fn i => float_gen rng (inf, inf) i)) else + if rnd = 4 then ((fn i => string_gen rng i)) else + if rnd = 5 then ((fn i => char_gen rng i)) else + if rnd = 6 then ((fn i => tuple_gen rng (make_list ((fn () => int_gen(inf, inf)), i)) i)) else + ((fn i => list_gen rng (int_gen(inf, inf)) i)) in + res end + +(* +-------------------------------- +CORE FUNCTIONALITY - a +-------------------------------- +*) + fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} + |core_forall (generator, prop, i, size, pre, cap) = + let val (sequence, raw_args) = foldl (fn (x,y) => + let val arg = x y.0 rec_rng size in + (append y.0 arg.sequence, append y.1 [arg.raw]) end)([],[]) generator + in + case pre of + () => + if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequence, remTests = i, size = size}) + | _ => + if (apply_args pre raw_args) then + if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequence, remTests = i, size = size}) + else + (write "x"; + if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) + else if size = cap then {failReason = (), ctx = (), ctx_seq = (), remTests = i, size = size} + else core_forall (generator, prop, i, size+1, pre, cap)) + end + + fun tc_n generators p noOfTests = + let val (prop, pre) = + case p of + (x,y) => (x,y) + | x => (x, ()) + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in + case res.failReason of + () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true + |_ => + report_fail_reason res noOfTests; + write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); + let val shrink_res = shrink res.ctx_seq generators prop pre res.size in + write "\nFailing test case was shrunk to:\n"; + write (args_toString shrink_res.shrunk_ctx); + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); + false + end + end + + fun tc generator p = tc_n generator p 100 + + fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) + | troupecheck generator p = spawn (fn() => tc generator p) + +(* +-------------------------------- +CONVENIENCE FUNCTIONS - s +-------------------------------- +*) + val inf = 1 / 0 + fun integer() = int_gen(inf, inf) + | integer (h, l) = int_gen(h, l) + + fun pos_integer() = integer(0, inf) + + fun neg_integer() = integer(inf, -1) + + fun float() = float_gen(inf, inf) + | float(h, l) = float_gen(h, l) + + fun pos_float() = float(0, inf) + + fun neg_float() = float(inf, 0) + + fun boolean() = bool_gen + + fun list() = list_gen(generator_gen()) (* TODO: generator_gen() should return both raw_gen and meta_data *) + |list(type) = list_gen(type) + + fun string() = string_gen + + fun char() = char_gen + + fun tuple ts = tuple_gen ts + + fun record ns ts = rec_gen ns ts + + fun one_of ls = + let val idx = (int_gen (1, (length ls)) ((length ls))).raw + in + nth ls idx + end +(* +-------------------------------- +FUNCTIONS FOR TESTING - d +-------------------------------- +*) + fun my_reverse xs = + xs + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_length [] = 0 + | my_length (x::xs) = 1 + (my_length xs) + + fun my_count y [] = 0 + | my_count y (x::xs) = + let val z = + if y = x then 1 else 0 + in + z + my_count y xs end + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_ceil_1 i = + if i > 0 then i + (1 - (i mod 1)) + else i + (1 - (i mod 1)) - 1 + + fun my_ceil_2 i = + if i > 0 then (my_floor i) + 1 + else if i = 0 then 0 + else (my_floor i) + 1 + + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs + + fun one_of_two (x, y) = + let val bool = (bool_gen 0).raw in + if bool then x + else y end + + fun bad_half n = + if n > 10 then n else n/2 + + fun lengths_not_same s1 s2 = + (string_length s1) <> (string_length s2) + +(* +-------------------------------- +PROPERTIES FOR TESTING - f +-------------------------------- +*) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + + fun number_commutative x y = + x * y <= 50 + + fun list_reverse xs = + reverse(reverse xs) = xs + + fun int_gen_stays_in_interval i = + (integer(0, i) i).raw <= i + + fun abs_value_is_always_pos i = + abs_value i >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_length_test xs = + my_length xs = length xs + + fun make_list_test i = + let val generator = generator_gen i + fun f() = generator ((int_gen(0, inf) i).raw) + val ls = (make_list (f, i)) in + (length ls) = i end + + fun my_count_returns_non_negative_int x xs = + (my_count x xs) >= 0 + + fun rec_test rec i = + {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} + + fun pre_pos x = + x >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_ceil_1_test i = + my_ceil_1 i = ceil i + + fun my_ceil_2_test i = + my_ceil_2 i = ceil i + + fun both_ceil_test i = + my_ceil_1 i = my_ceil_2 i + + fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) + + fun no_args() = true + + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + + fun test_bad_half n = + n > (bad_half n) + + fun append_always_longer s1 s2 = + string_length s1 < string_length (s1 ^ s2) + + fun record_shrink_test r = + r.theInteger < 50 + +(* +-------------------------------- +USED FOR USERGUIDE - g +-------------------------------- +*) + fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + + fun ordered [] = true + | ordered (x::[]) = true + | ordered (x::y::ys) = + if x <= y then ordered (y::ys) else false + + fun my_sort_is_ordered xs = + ordered (my_quicksort xs) + + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + + fun pre_list_size_greater_than_one xs = + if (length xs) <= 1 then false else true + + fun no_duplicates[] = true + | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs + + fun cons_length_increase xs x = + (length (x::xs)) = ((length xs) + 1) +(* +-------------------------------- +TC^2 - z +-------------------------------- +*) + fun tc_sort_length_always_fails () = + tc [list(integer())] my_sort_keep_length = false + + fun tc_sort_ordered_always_true () = + tc [list(integer())] my_sort_is_ordered = true + +(* +-------------------------------- +CUSTOM TYPE PROGRAM +-------------------------------- +*) + fun eval exp env = + case exp of + ("num", n) => n + | ("var", n) => lookup env n ("unknown variable " ^ n) + | ("add", e1, e2) => (eval e1 env) + (eval e2 env) + | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) + | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) + | ("div", e1, e2) => (eval e1 env) / (eval e2 env) + | _ => print ("Error: ill defined expression"); exit (authority, 1) + + fun execute stmt env = + case stmt of + ("assign", var, exp) => + let val value = eval exp env + in + append [(var, value)] env + end + | ("print", exp) => (print (toString (eval exp env)); env) + + fun interpret prog = + let fun interpretHelper [] env = env + | interpretHelper (stmt :: rest) env = + let val newEnv = execute stmt env + in + interpretHelper rest newEnv + end + val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + val last_env = (interpretHelper stmts []) + in + eval exp last_env + end + + fun optimize_prog prog = + let val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + fun optimize_exp exp = + case exp of + ("num", n) => ("num", n) + | ("var", x) => ("var", x) + | ("add", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1+n2)) + |_ => ("add", (optimize_exp e1), (optimize_exp e2))) + | _ => ("add", (optimize_exp e1), (optimize_exp e2))) + | ("sub", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1-n2)) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2))) + | ("mul", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1*n2)) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2))) + | ("div", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => if ((n1 = 0) andalso (n2 = 0)) then ("div", e1, e2) else ("num", (n1/n2)) + |_ => ("div", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("div", (optimize_exp e1), (optimize_exp e2))) + + fun optimize_stmt stmt = + case stmt of + ("assign", var, exp) => ("assign", var, (optimize_exp exp)) + | ("print", exp) => ("print", (optimize_exp exp)) + in + append (map optimize_stmt stmts) [optimize_exp exp] + end + + fun exp_gen ls nesting_level size = + let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] + val exp_type = if nesting_level = 2 then "num" else one_of exp_ts + in + case exp_type of + "num" => + let val value = int_gen(inf, inf) size + fun shrinker inst = + let val shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in + {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in + {raw = ("num", value.raw), shrinker = shrinker} end + | "var" => + let val value = one_of ls + fun shrinker inst = + {inst with state = "done"} in + {raw = ("var", value), shrinker = shrinker} end + |"add" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("add", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} + end + |"sub" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("sub", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} + end + |"mul" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("mul", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} + end + |"div" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("div", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} (* maybe just shrinker? *) + end + end + + fun assign_stmt_gen ls size = + let val n = string_gen size + val exp = exp_gen ls 0 size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val shrunk_assign = ("assign", n.raw, shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} + end + in + {raw = ("assign", n.raw, exp.raw), shrinker = shrinker} + end + + fun print_stmt_gen ls size = + let val exp = exp_gen ls 0 size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_print = ("print", shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} + end + in + {raw = ("print", exp.raw), shrinker = shrinker} + end + + fun stmt_gen ls size = + let val stmt = one_of ["assign", "print"] + in + case stmt of + "assign" => + let val res = assign_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + |"print" => + let val res = print_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + end + + fun assign_in_use_aux stmt_or_exp assign idx = + case stmt_or_exp.0 of + "print" => + assign_in_use_aux stmt_or_exp.1 assign idx + | "assign" => + assign_in_use_aux stmt_or_exp.2 assign idx + | "var" => if stmt_or_exp.1 = assign then true else false + | "num" => false + | _ => + if assign_in_use_aux stmt_or_exp.1 assign idx then + true + else + assign_in_use_aux stmt_or_exp.2 assign idx + + fun assign_in_use [] idxs assign idx bool = (bool, idxs) + | assign_in_use (x::xs) idxs assign idx bool = + let val res = assign_in_use_aux x assign idx + in + if res then assign_in_use xs (append [idx] idxs) assign (idx+1) true + else assign_in_use xs idxs assign (idx+1) bool + end + + fun program_gen size = + let val num_of_insts = (int_gen(0, size) size ).raw + fun prog_gen_aux env p s 0 = (p, s, env) + | prog_gen_aux env p s i = + let val stmt = stmt_gen env size + val newEnv = if stmt.raw.0 = "assign" then (append [stmt.raw.1] env) else env + in + prog_gen_aux newEnv (append p [stmt.raw]) (append s [stmt.shrinker]) (i-1) + end + val (prog_stmts, shrinkers_interim, last_env) = prog_gen_aux [] [] [] num_of_insts + val last_exp = exp_gen last_env 0 size + val prog = append prog_stmts [last_exp.raw] + val shrinkers = append shrinkers_interim [last_exp.shrinker] + fun shrinker inst = + case inst.state of + "init" => + let val shrunk = shrink_list shrinkers inst + in + shrunk + end + | "cont_size" => + let val next_elem = nth inst.curr (length inst.curr) + in + if next_elem.0 = "assign" then + if (assign_in_use inst.curr [] (next_elem.1) 0 false).0 then + print "testing"; + {inst with idx = inst.idx-1} + else if (next_elem.0 = "var") orelse (next_elem.0 = "num") orelse (next_elem.0 = "add") orelse (next_elem.0 = "sub") orelse + (next_elem.0 = "mul") orelse (next_elem.0 = "div") then + {inst with idx = inst.idx-1} + + else + shrink_list shrinkers inst + else + shrink_list shrinkers inst + end + | _ => + shrink_list shrinkers inst + in + {raw = prog, shrinker = shrinker} + end + + fun test_prog_opt prog = + (interpret prog) = (interpret (optimize_prog prog)) +in + +(* +-------------------------------- +ALL TESTS - x +-------------------------------- +*) +tc [integer(), integer()] number_commutative +(* shrinking tests - x *) +(* tc [list(integer()), integer()] test_bad_insert; +tc [integer()] (test_bad_half, (fn x => x >= 15)); +tc [string(), string()] (append_always_longer, lengths_not_same); +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; *) + +(* tc^2 tests *) +(* tc [] tc_sort_ordered_always_true; *) + +(* User guide tests *) +(* tc [list(integer()), integer()] cons_length_increase; +tc [list(integer())] my_sort_is_ordered; +tc [list(integer())] my_sort_keep_length; +tc [list(integer())] (my_sort_keep_length, no_duplicates); *) + +(* General functionality tests *) +(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +tc [] no_args; +tc [integer(), integer(), integer(), integer()] tup_test; +write "\nTesting on bools commutative:"; +tc [boolean(), boolean()] bool_commutative; +write "\nTesting on numbers commutative:"; +tc [integer(), integer()] number_commutative; +write "\nTesting on list reverse:"; +tc [list(integer())] list_reverse; +write "\nTesting on int_gen interval:"; +tc [integer()] (int_gen_stays_in_interval, pre_pos); +write "\nTesting on abs_value:"; +tc [one_of_two (integer(), float())] abs_value_is_always_pos; +write "\nTesting on my_floor:"; +tc [float()] my_floor_test; +write "\nTesting that my_count always return non-negative result:"; +tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; +write "\nTesting my_length:"; +tc [list(integer())] my_length_test; +write "\nTesting make_list:"; +tc [pos_integer()] make_list_test; +write "Testing on my_ceil_1:"; +tc [float()] my_ceil_1_test; +write "Testing on my_ceil_2:"; +tc [float()] my_ceil_2_test; +write "Testing on both ceil functions:"; +tc [float()] both_ceil_test *) +end \ No newline at end of file From f8b2ac9e98da5f5eb5817a2ba51cdbb46c8c0a2d Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sat, 20 Apr 2024 18:30:55 +0200 Subject: [PATCH 056/121] a little testing with random shrinking, improvements on integrated shrinking --- troupecheck/integrated_shrinking.trp | 275 ++------- troupecheck/random_shrinking.trp | 817 +++++++++++++++++++++++++++ 2 files changed, 868 insertions(+), 224 deletions(-) create mode 100644 troupecheck/random_shrinking.trp diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 01f8344..eea49da 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -113,239 +113,59 @@ UTILS - e SHRINKING - r -------------------------------- *) - - and shrink_float 0 = [0] - | shrink_float n = - let val current = floor ((abs_value n) / 2) - fun ret_fun () = [n-current, fn () => shrink_float (floor(current/2))] in - [0, ret_fun] end - - and shrink_int rec = - let val interim = shrink_float rec - in - {interim with curr = floor(interim.curr)} - end - - and shrink_bool rec = - let val rec_checked = if rec.curr = false then {rec with state = "done"} else rec - in - case rec_checked.state of - "rollback" => - {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} - |"done" => - rec_checked - | _ => - let val newVal = false - in - {state = "cont", curr = newVal, prev = rec_checked.curr} - end - end - - (* input/returns - {state: string, curr: string, prev: string} *) - and shrink_string rec = - let val rec_checked = if rec.state = "init" then {rec with next_shrink_info = 0} else rec in - case rec_checked.state of - "cont_elem" => - {rec_checked with state = "done"} (* TODO: Should actually shrink characters *) - | _ => - let val ls_curr = string_to_list rec_checked.curr - val ls_prev = string_to_list rec_checked.prev - val shrinkers = map (fn _ => shrink_char) ls_curr - val interim_res = - shrink_list shrinkers {state = rec_checked.state, - curr = ls_curr, - prev = ls_prev, - idx = rec_checked.next_shrink_info, - shrinkers = shrinkers, - prev_shrinkers = shrinkers} - val new_curr = list_to_string interim_res.curr - val new_prev = list_to_string interim_res.prev - - val res = {state = interim_res.state, curr = new_curr, prev = new_prev, next_shrink_info = interim_res.idx} - in - res - end - end - - and shrink_char rec = - let val chars = - ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", - "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", - "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec - val curr_val = rec_checked.curr in - case rec_checked.state of - "rollback" => - {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} - | "done" => - rec_checked - | "init" => - let val index_of_new = (lookup chars rec.curr 2) - 1 - val new_char = nth chars index_of_new - in - {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} - end - | _ => - let val index_of_new = rec.idx-1 - val new_char = nth chars index_of_new - in - {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} - end - end - - and shrink_sized_aggregate vals builder rec = - case rec.state of - "init" => - let val init_shrink_idx = 0 - val new_vals = mapi (fn (i, x) => - if i = init_shrink_idx then (x.shrinker {state = "init", curr = x.raw, prev = x.raw}) - else {state = "init", curr = x.raw, prev = x.raw}) vals - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx - in - {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} - end - | "cont" => - let val init_shrink_idx = rec.shrink_idx - val new_vals = mapi (fn (i, x) => - if i = init_shrink_idx then x.shrinker (nth rec.next_shrink_info (i+1)) - else (nth rec.next_shrink_info (i+1))) vals - val new_raw_vals = map (fn x => x.curr) new_vals - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" - val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx - in - {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} - end - | "done" => - rec - | "rollback" => - let val init_shrink_idx = rec.shrink_idx - fun rollback_aux (i, x) = - if i = init_shrink_idx then - (let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} - in - x.shrinker val_to_shrink - end ) - else (nth rec.next_shrink_info (i+1)) - val rollback_args = mapi rollback_aux vals - val new_raw_vals = map (fn x => x.curr) rollback_args - val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true rollback_args) then "done" else "cont" - val shrink_idx = if (nth rollback_args (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx - in - {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = rollback_args, shrink_idx = shrink_idx} - end - - and shrink_list shrinkers rec = - if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr, idx = 0} - else - case rec.state of - "init" => - let val removeIdx = (length (rec.curr)) - 1 - val newList = remove_nth removeIdx rec.curr 0 - val new_shrinkers = remove_nth removeIdx shrinkers 0 - val next_state = if length newList = 0 then "cont_elem" else "cont_size" - in - {state = next_state, curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = new_shrinkers, prev_shrinkers = shrinkers} - end - | "cont_size" => - let val remove_idx = (rec.idx - 1) - val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" - val new_list = remove_nth remove_idx rec.curr 0 - val new_shrinkers = remove_nth remove_idx rec.shrinkers 0 - in - {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx, shrinkers = new_shrinkers, prev_shrinkers = rec.shrinkers} - end - | "cont_elem" => - let val interim_list = mapi (fn (i, x) => (nth rec.shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr - val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" - val new_list = map (fn x => x.curr) interim_list - in - {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers, prev_shrinkers = rec.prev_shrinkers} - end - | "rollback" => - if (length rec.curr) = (length rec.prev) then - {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} (* TODO: this loops an unecesary amount of times *) - else - {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} - | "done" => - rec - - and args_shrink args = - case args.state of - "rollback" => - let val init_shrink_idx = args.shrink_idx - val rollbackReadyArgs = mapi (fn (i, x) => if (x.state = "done") orelse (i<>init_shrink_idx) then x else {x with state = "rollback"}) args.args - val argsRolledBack = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) rollbackReadyArgs - val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true argsRolledBack) then "done" else "cont" - val shrink_idx = if (nth argsRolledBack (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx - in - {state = nextState, args = argsRolledBack, shrinkers = args.shrinkers, shrink_idx = shrink_idx} - end - | "done" => - args - | _ => - let val init_shrink_idx = args.shrink_idx - val newArgs = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) args.args - val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" - val shrink_idx = if (nth newArgs (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx - - in - {state = nextState, args = newArgs, shrinkers = args.shrinkers, shrink_idx = shrink_idx} - end - - fun shrink_aux args prop pre counter = - if counter = 100 then report_error ("shrinking_looped", 0) else - let val shrunk_args = args_shrink args - val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args - val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in - case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of - true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers, shrink_idx = args.shrink_idx}) prop pre (counter) - | false => - if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end fun rep_rng [] = () | rep_rng (x::xs) = {rnd = x, seq = xs} fun rec_rng ls = - let val rnd = random() in + let val rnd = floor (random()*1000000) in {rnd = rnd, seq = append ls [rnd]} end fun dec_nth list idx = let fun dec_nth_aux [] acc i = acc | dec_nth_aux (x::xs) acc i = case i = idx of - true => dec_nth_aux xs (append acc [(x/2)/2]) (i+1) + true => + let val dec_val = if x-1 <= 0 then 0 else x/2 in + dec_nth_aux xs (append acc [dec_val]) (i+1) end | false => dec_nth_aux xs (append acc [x]) (i+1) in dec_nth_aux list [] 0 end + + fun dec_all seq = + let fun dec_all_aux acc [] i = acc + | dec_all_aux acc (x::xs) i = + if x = 0 then + dec_all_aux acc xs (i+1) + else + dec_all_aux (append acc [(dec_nth seq i)]) xs (i+1) in + dec_all_aux [] seq 0 end fun shrink_aux seqs gens prop pre size = - print seqs; case seqs of (x1::x2::xs) => let val (test_args, _) = foldl (fn (x,y) => let val rnd = x y.1 rep_rng size in (append y.0 [rnd.raw], rnd.sequence) end)([], x2) gens - val _ = print test_args val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of - true => print "test"; shrink_aux (x1::xs) gens prop pre size + true => shrink_aux (x1::xs) gens prop pre size |false => shrink x2 gens prop pre size end - | (x::xs) => (foldl (fn (z,y) => - let val rnd = z y.1 rep_rng in - (append y.0 rnd.raw, rnd.sequence) end) ([], x) gens).0 + | (x::xs) => + let val res = (foldl (fn (z,y) => + let val rnd = z y.1 rep_rng size in + (append y.0 [rnd.raw], rnd.sequence) end) ([], x) gens).0 + in + {shrunk_ctx = res, count = size} end and shrink sequence gens prop pre size = - if foldl (fn (x,y) => (x < 1/100) andalso y) true sequence then + if foldl (fn (x,y) => (x = 0) andalso y) true sequence then shrink_aux [sequence] gens prop pre size else - let val decreased_seqs = mapi (fn (i, x) => dec_nth sequence i) sequence + let val decreased_seqs = dec_all sequence val dec_seqs_w_root = append [sequence] decreased_seqs val res = shrink_aux dec_seqs_w_root gens prop pre size in res end @@ -359,15 +179,16 @@ GENERATORS - t fun float_gen (low, high) ls rng size = let val x = rng ls val bool_int = rng x.seq - val bool = bool_int.rnd < 1/2 + val bool = bool_int.rnd < 1000000/2 + val float_of_x = x.rnd/1000000 val lInf = low = 1/0 (* check for inf *) val hInf = high = 1/0 val raw_res = case (lInf, hInf) of - (true, true) => if bool then x.rnd*size else -x.rnd*size - | (true, false) => high - (x.rnd*size) - | (false, true) => low + (x.rnd*size) - | (false, false) => low + (x.rnd * (high-low)) + (true, true) => if bool then float_of_x * size else -float_of_x * size + | (true, false) => high - (float_of_x * size) + | (false, true) => low + (float_of_x * size) + | (false, false) => low + (float_of_x * (high-low)) in {raw = raw_res, sequence = bool_int.seq} end @@ -413,23 +234,25 @@ GENERATORS - t (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) fun string_gen ls rng size = - let val x = (int_gen (0, size) ls rng size).raw + let val y = (int_gen (0, size) ls rng size) + val x = (int_gen (0, size) y.sequence rng size) fun fold f acc 0 = acc - | fold f acc i = fold f (acc ^ (f())) (i-1) - val raw_string = (fold (fn () => (char_gen ls rng x).raw) "" x) + | fold f acc i = + let val inst = f() in + fold f (acc.0 ^ inst.raw, (append acc.1 inst.sequence)) (i-1) end + val (string, seq) = (fold (fn () => (char_gen ls rng y.raw)) ("", x.sequence) x.raw) in - {raw = raw_string, shrinker = shrink_string} + {raw = string, sequence = seq} (* Not working as it should... *) end (* NOTE: Hardcoded for tuple of up to 10 elements *) (* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list of all generated values in raw_inst along with their respective meta_data. *) - fun tuple_gen rng ts size = - let val ts_vals = map (fn x => x size) ts - val ts_raw_vals = map (fn x => x.raw) ts_vals - val ts_shrinkers = map (fn x => x.shrinker) ts_vals + fun tuple_gen ts ls rng size = + let val (ts_vals, seq) = foldl (fn (x,y) => let val res = x y.1 rng size + in ((append y.0 [res.raw]), (append y.1 res.sequence)) end )([],ls) ts in - {raw = (build_tuple ts_raw_vals), shrinker = shrink_sized_aggregate ts_vals build_tuple} + {raw = (build_tuple ts_vals), sequence = seq} end (* @@ -438,15 +261,15 @@ ts: list of generators - used to generate values for fields Returns record: {raw_inst = <>, meta_data = (ns, <>)} *) - fun rec_gen rng ns ts size = + fun rec_gen ns ts ls rng size = if (length ns) <> (length ts) then report_error ("record_mismatch", 0) else - let val ts_vals = map (fn x => x size) ts - val ts_raw_vals = map (fn x => x.raw) ts_vals - val raw_res = build_record ns ts_raw_vals + let val (ts_vals, seq) = foldl (fn (x,y) => let val res = x y.1 rng size + in ((append y.0 [res.raw]), (append y.1 res.sequence)) end )([],ls) ts + val raw_res = build_record ns ts_vals in - {raw = raw_res, shrinker = shrink_sized_aggregate ts_vals (build_record ns)} + {raw = raw_res, sequence = seq} end @@ -724,7 +547,7 @@ TC^2 - z CUSTOM TYPE PROGRAM -------------------------------- *) - fun eval exp env = +(* fun eval exp env = case exp of ("num", n) => n | ("var", n) => lookup env n ("unknown variable " ^ n) @@ -969,15 +792,19 @@ CUSTOM TYPE PROGRAM end fun test_prog_opt prog = - (interpret prog) = (interpret (optimize_prog prog)) + (interpret prog) = (interpret (optimize_prog prog)) *) + val test_seq = [1/6, 1/13] + val test_res = 16 in +tc [string(), string()] (append_always_longer, lengths_not_same) +(* print (shrink test_seq [int_gen(0,100)] (fn x => x < 5) () 10) *) (* -------------------------------- ALL TESTS - x -------------------------------- *) -tc [integer(), integer()] number_commutative +(* tc [integer(), integer()] number_commutative *) (* shrinking tests - x *) (* tc [list(integer()), integer()] test_bad_insert; tc [integer()] (test_bad_half, (fn x => x >= 15)); diff --git a/troupecheck/random_shrinking.trp b/troupecheck/random_shrinking.trp new file mode 100644 index 0000000..082e2a2 --- /dev/null +++ b/troupecheck/random_shrinking.trp @@ -0,0 +1,817 @@ +import lists +(* +-------------------------------- +PRINTING TO CONSOLE - q +-------------------------------- +*) +let val out = getStdout authority + fun write x = fwrite (out, x) + (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) + fun args_toString args = + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x) in + aux_toString "" args end +(* +-------------------------------- +ERROR HANDLING - w +-------------------------------- +*) + fun report_error error_reason = + write "\u001B[31m \nError: "; (* Changing the print color to red *) + let val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + | ("shrinking_looped", _) => "Shrinking looped.\n" + | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" + in + write (err_string ^ "\u001B[0m"); (* Changing the color back *) + exit (authority, 0) end + + fun boolean_check x = + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () + + fun function_not_done_check p = + if (getType p)<>"function" then report_error ("type_mismatch", 0) else () +(* +-------------------------------- +UTILS - e +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + + fun abs_value x = + if x < 0 then -x else x + +(* applies the list of arguments to the property - one by one - reporting errors along the way *) +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l = + case l of + [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in + boolean_check res; + res + end + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + fun list_to_string ls = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) + + fun report_fail_reason rec noOfTests= + case rec.failReason of + "false_prop" => + write "\nFailure at input: "; + write (args_toString rec.cEx); + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) +(* +-------------------------------- +GENERATORS - t +-------------------------------- +*) + (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) + fun bool_gen size = + let val rnd = random() + val res = if rnd < 1/2 then false + else true + in + res + end + + (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) + (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) + fun float_gen (low, high) size = + let val x = random() + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + val raw_res = + case (lInf, hInf) of + (true, true) => if (bool_gen size) then x*size else -x*size + | (true, false) => high - (x*size) + | (false, true) => low + (x*size) + | (false, false) => low + (x * (high-low)) + in + raw_res + end + + (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) + fun int_gen (low, high) size = + let val raw_res = floor ((float_gen(low, high+1) size)) + in + raw_res + end + + (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) + fun list_gen (generator) size = + let val length = (int_gen(0, size) size) + val res = make_list ((fn () => generator size), length) in + res + end + + (* NOTE: Generates only letters (upper and lower case) and numbers. *) + (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) + fun char_gen size = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = (int_gen (1, ((length chars)-1)) size) + in + (nth chars x) + end + +(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) + fun string_gen size = + let val x = (int_gen (0, size) size) + fun fold f acc 0 = acc + | fold f acc i = fold f (acc ^ (f())) (i-1) + val raw_string = (fold (fn () => (char_gen x)) "" x) + in + raw_string + end + +(* NOTE: Hardcoded for tuple of up to 10 elements *) +(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list + of all generated values in raw_inst along with their respective meta_data. *) + fun tuple_gen ts size = + let val ts_vals = map (fn x => x size) ts + in + (build_tuple ts_vals) + end + +(* +ns: list of strings - will be used as fieldnames +ts: list of generators - used to generate values for fields + +Returns record: {raw_inst = <>, meta_data = (ns, <>)} +*) + fun rec_gen ns ts size = + if (length ns) <> (length ts) then + report_error ("record_mismatch", 0) + else + let val ts_vals = map (fn x => x size) ts + val raw_res = build_record ns ts_vals + in + raw_res + end + + + fun generator_gen size = + let val rnd = random() + val inf = 1/0 + val res = if rnd <= 1/7 then ((fn i => int_gen(inf, inf) i)) else + if rnd <= 2/7 then ((fn i => bool_gen i)) else + if rnd <= 3/7 then ((fn i => float_gen(inf, inf) i)) else + if rnd <= 4/7 then ((fn i => string_gen i)) else + if rnd <= 5/7 then ((fn i => char_gen i)) else + if rnd <= 6/7 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf)), i)) i)) else + ((fn i => list_gen (int_gen(inf, inf)) i)) in + res end + +(* +-------------------------------- +SHRINKING - r +-------------------------------- +*) + fun max(x, y) = + if x >= y then x else y + + + fun dec_nth list idx = + let fun dec_nth_aux [] acc i = acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => dec_nth_aux xs (append acc [max(x-1, 0)]) (i+1) + | false => dec_nth_aux xs (append acc [x]) (i+1) + in + dec_nth_aux list [] 0 end + + fun is_all ls n = + foldl (fn (x,y) => x = n andalso y) true ls + + + fun shrink_aux generators curr sizes prop pre success counter = + if (counter = 10000) orelse (is_all sizes 0) then {shrunk_ctx = curr, count = success} else + let val n = int_gen(0, ((length sizes)-1)) (length sizes) + val new_sizes = dec_nth sizes n + val shrunk_args = mapi (fn (i, x) => x (nth new_sizes (i+1))) generators + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args) else true in + case (apply_args prop shrunk_args) orelse (precond_is_met = false) of + true => shrink_aux generators curr sizes prop pre success (counter+1) + | false => + shrink_aux generators shrunk_args new_sizes prop pre (success+1) (counter+1) end + + fun shrink generators curr size prop pre = + let val size_ls = map (fn _ => size) generators + val res = shrink_aux generators curr size_ls prop pre 0 0 + in res end + +(* +-------------------------------- +CORE FUNCTIONALITY - a +-------------------------------- +*) + fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0, size = size} + |core_forall (generator, prop, i, size, pre, cap) = + let val args = map (fn x => x size) generator in + case pre of + () => + if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + else (write "!"; {failReason = "false_prop", cEx = args, remTests = i, size = size}) + | _ => + if (apply_args pre args) then + if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) + else (write "!"; {failReason = "false_prop", cEx = args, remTests = i, size = size}) + else + (write "x"; + if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) + else if size = cap then {failReason = (), cEx = (), remTests = i, size = size} + else core_forall (generator, prop, i, size+1, pre, cap)) + end + + fun tc_n generators p noOfTests = + let val (prop, pre) = + case p of + (x,y) => (x,y) + | x => (x, ()) + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in + case res.failReason of + () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true + |_ => + report_fail_reason res noOfTests; + write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); + let val shrink_res = shrink generators res.cEx res.size prop pre in + write "\nFailing test case was shrunk to:\n"; + write (args_toString shrink_res.shrunk_ctx); + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); + false + end + end + + fun tc generator p = tc_n generator p 100 + + fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) + | troupecheck generator p = spawn (fn() => tc generator p) + +(* +-------------------------------- +CONVENIENCE FUNCTIONS - s +-------------------------------- +*) + val inf = 1 / 0 + fun integer() = int_gen(inf, inf) + | integer (h, l) = int_gen(h, l) + + fun pos_integer() = integer(0, inf) + + fun neg_integer() = integer(inf, -1) + + fun float() = float_gen(inf, inf) + | float(h, l) = float_gen(h, l) + + fun pos_float() = float(0, inf) + + fun neg_float() = float(inf, 0) + + fun boolean() = bool_gen + + fun list() = list_gen(generator_gen()) (* TODO: generator_gen() should return both raw_gen and meta_data *) + |list(type) = list_gen(type) + + fun string() = string_gen + + fun char() = char_gen + + fun tuple ts = tuple_gen ts + + fun record ns ts = rec_gen ns ts + + fun one_of ls = + let val idx = (int_gen (1, (length ls)) ((length ls))).raw + in + nth ls idx + end +(* +-------------------------------- +FUNCTIONS FOR TESTING - d +-------------------------------- +*) + fun my_reverse xs = + xs + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_length [] = 0 + | my_length (x::xs) = 1 + (my_length xs) + + fun my_count y [] = 0 + | my_count y (x::xs) = + let val z = + if y = x then 1 else 0 + in + z + my_count y xs end + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_ceil_1 i = + if i > 0 then i + (1 - (i mod 1)) + else i + (1 - (i mod 1)) - 1 + + fun my_ceil_2 i = + if i > 0 then (my_floor i) + 1 + else if i = 0 then 0 + else (my_floor i) + 1 + + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs + + fun one_of_two (x, y) = + let val bool = (bool_gen 0).raw in + if bool then x + else y end + + fun bad_half n = + if n > 10 then n else n/2 + + fun lengths_not_same s1 s2 = + (string_length s1) <> (string_length s2) + +(* +-------------------------------- +PROPERTIES FOR TESTING - f +-------------------------------- +*) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + + fun number_commutative x y = + x * y = y * x + + fun list_reverse xs = + reverse(reverse xs) = xs + + fun int_gen_stays_in_interval i = + (integer(0, i) i).raw <= i + + fun abs_value_is_always_pos i = + abs_value i >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_length_test xs = + my_length xs = length xs + + fun make_list_test i = + let val generator = generator_gen i + fun f() = generator ((int_gen(0, inf) i).raw) + val ls = (make_list (f, i)) in + (length ls) = i end + + fun my_count_returns_non_negative_int x xs = + (my_count x xs) >= 0 + + fun rec_test rec i = + {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} + + fun pre_pos x = + x >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_ceil_1_test i = + my_ceil_1 i = ceil i + + fun my_ceil_2_test i = + my_ceil_2 i = ceil i + + fun both_ceil_test i = + my_ceil_1 i = my_ceil_2 i + + fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) + + fun no_args() = true + + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + + fun test_bad_half n = + n > (bad_half n) + + fun append_always_longer s1 s2 = + string_length s1 < string_length (s1 ^ s2) + + fun record_shrink_test r = + r.theInteger < 50 + +(* +-------------------------------- +USED FOR USERGUIDE - g +-------------------------------- +*) + fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + + fun ordered [] = true + | ordered (x::[]) = true + | ordered (x::y::ys) = + if x <= y then ordered (y::ys) else false + + fun my_sort_is_ordered xs = + ordered (my_quicksort xs) + + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + + fun pre_list_size_greater_than_one xs = + if (length xs) <= 1 then false else true + + fun no_duplicates[] = true + | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs + + fun cons_length_increase xs x = + (length (x::xs)) = ((length xs) + 1) +(* +-------------------------------- +TC^2 - z +-------------------------------- +*) + fun tc_sort_length_always_fails () = + tc [list(integer())] my_sort_keep_length = false + + fun tc_sort_ordered_always_true () = + tc [list(integer())] my_sort_is_ordered = true + +(* +-------------------------------- +CUSTOM TYPE PROGRAM +-------------------------------- +*) +(* fun eval exp env = + case exp of + ("num", n) => n + | ("var", n) => lookup env n ("unknown variable " ^ n) + | ("add", e1, e2) => (eval e1 env) + (eval e2 env) + | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) + | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) + | ("div", e1, e2) => (eval e1 env) / (eval e2 env) + | _ => print ("Error: ill defined expression"); exit (authority, 1) + + fun execute stmt env = + case stmt of + ("assign", var, exp) => + let val value = eval exp env + in + append [(var, value)] env + end + | ("print", exp) => (print (toString (eval exp env)); env) + + fun interpret prog = + let fun interpretHelper [] env = env + | interpretHelper (stmt :: rest) env = + let val newEnv = execute stmt env + in + interpretHelper rest newEnv + end + val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + val last_env = (interpretHelper stmts []) + in + eval exp last_env + end + + fun optimize_prog prog = + let val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + fun optimize_exp exp = + case exp of + ("num", n) => ("num", n) + | ("var", x) => ("var", x) + | ("add", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1+n2)) + |_ => ("add", (optimize_exp e1), (optimize_exp e2))) + | _ => ("add", (optimize_exp e1), (optimize_exp e2))) + | ("sub", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1-n2)) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2))) + | ("mul", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1*n2)) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2))) + | ("div", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => if ((n1 = 0) andalso (n2 = 0)) then ("div", e1, e2) else ("num", (n1/n2)) + |_ => ("div", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("div", (optimize_exp e1), (optimize_exp e2))) + + fun optimize_stmt stmt = + case stmt of + ("assign", var, exp) => ("assign", var, (optimize_exp exp)) + | ("print", exp) => ("print", (optimize_exp exp)) + in + append (map optimize_stmt stmts) [optimize_exp exp] + end + + fun exp_gen ls nesting_level size = + let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] + val exp_type = if nesting_level = 2 then "num" else one_of exp_ts + in + case exp_type of + "num" => + let val value = int_gen(inf, inf) size + fun shrinker inst = + let val shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in + {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in + {raw = ("num", value.raw), shrinker = shrinker} end + | "var" => + let val value = one_of ls + fun shrinker inst = + {inst with state = "done"} in + {raw = ("var", value), shrinker = shrinker} end + |"add" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("add", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} + end + |"sub" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("sub", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} + end + |"mul" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("mul", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} + end + |"div" => + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size + fun shrinker inst = + let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state + in + {state = next_state, curr = ("div", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} + end + in + {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} (* maybe just shrinker? *) + end + end + + fun assign_stmt_gen ls size = + let val n = string_gen size + val exp = exp_gen ls 0 size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} + val shrunk_assign = ("assign", n.raw, shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} + end + in + {raw = ("assign", n.raw, exp.raw), shrinker = shrinker} + end + + fun print_stmt_gen ls size = + let val exp = exp_gen ls 0 size + fun shrinker inst = + let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} + val shrunk_print = ("print", shrunk_exp.curr) + in + {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} + end + in + {raw = ("print", exp.raw), shrinker = shrinker} + end + + fun stmt_gen ls size = + let val stmt = one_of ["assign", "print"] + in + case stmt of + "assign" => + let val res = assign_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + |"print" => + let val res = print_stmt_gen ls size in + {raw = res.raw, shrinker = res.shrinker} end + end + + fun assign_in_use_aux stmt_or_exp assign idx = + case stmt_or_exp.0 of + "print" => + assign_in_use_aux stmt_or_exp.1 assign idx + | "assign" => + assign_in_use_aux stmt_or_exp.2 assign idx + | "var" => if stmt_or_exp.1 = assign then true else false + | "num" => false + | _ => + if assign_in_use_aux stmt_or_exp.1 assign idx then + true + else + assign_in_use_aux stmt_or_exp.2 assign idx + + fun assign_in_use [] idxs assign idx bool = (bool, idxs) + | assign_in_use (x::xs) idxs assign idx bool = + let val res = assign_in_use_aux x assign idx + in + if res then assign_in_use xs (append [idx] idxs) assign (idx+1) true + else assign_in_use xs idxs assign (idx+1) bool + end + + fun program_gen size = + let val num_of_insts = (int_gen(0, size) size ).raw + fun prog_gen_aux env p s 0 = (p, s, env) + | prog_gen_aux env p s i = + let val stmt = stmt_gen env size + val newEnv = if stmt.raw.0 = "assign" then (append [stmt.raw.1] env) else env + in + prog_gen_aux newEnv (append p [stmt.raw]) (append s [stmt.shrinker]) (i-1) + end + val (prog_stmts, shrinkers_interim, last_env) = prog_gen_aux [] [] [] num_of_insts + val last_exp = exp_gen last_env 0 size + val prog = append prog_stmts [last_exp.raw] + val shrinkers = append shrinkers_interim [last_exp.shrinker] + fun shrinker inst = + case inst.state of + "init" => + let val shrunk = shrink_list shrinkers inst + in + shrunk + end + | "cont_size" => + let val next_elem = nth inst.curr (length inst.curr) + in + if next_elem.0 = "assign" then + if (assign_in_use inst.curr [] (next_elem.1) 0 false).0 then + print "testing"; + {inst with idx = inst.idx-1} + else if (next_elem.0 = "var") orelse (next_elem.0 = "num") orelse (next_elem.0 = "add") orelse (next_elem.0 = "sub") orelse + (next_elem.0 = "mul") orelse (next_elem.0 = "div") then + {inst with idx = inst.idx-1} + + else + shrink_list shrinkers inst + else + shrink_list shrinkers inst + end + | _ => + shrink_list shrinkers inst + in + {raw = prog, shrinker = shrinker} + end + + fun test_prog_opt prog = + (interpret prog) = (interpret (optimize_prog prog)) + val exp = exp_gen [] 0 3 + val stmt = stmt_gen [] 3 + val prog = program_gen 2 *) +in + +(* +-------------------------------- +ALL TESTS - x +-------------------------------- +*) +(* tc [integer()] (test_bad_half, (fn x => x >= 15)); *) +tc [string(), string()] (append_always_longer, lengths_not_same); +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test +(* shrinking tests - x *) +(* tc [list(integer()), integer()] test_bad_insert; +tc [integer()] (test_bad_half, (fn x => x >= 15)); +tc [string(), string()] (append_always_longer, lengths_not_same); +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; *) + +(* tc^2 tests *) +(* tc [] tc_sort_ordered_always_true; *) + +(* User guide tests *) +(* tc [list(integer()), integer()] cons_length_increase; +tc [list(integer())] my_sort_is_ordered; +tc [list(integer())] my_sort_keep_length; +tc [list(integer())] (my_sort_keep_length, no_duplicates); *) + +(* General functionality tests *) +(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +tc [] no_args; +tc [integer(), integer(), integer(), integer()] tup_test; +write "\nTesting on bools commutative:"; +tc [boolean(), boolean()] bool_commutative; +write "\nTesting on numbers commutative:"; +tc [integer(), integer()] number_commutative; +write "\nTesting on list reverse:"; +tc [list(integer())] list_reverse; +write "\nTesting on int_gen interval:"; +tc [integer()] (int_gen_stays_in_interval, pre_pos); +write "\nTesting on abs_value:"; +tc [one_of_two (integer(), float())] abs_value_is_always_pos; +write "\nTesting on my_floor:"; +tc [float()] my_floor_test; +write "\nTesting that my_count always return non-negative result:"; +tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; +write "\nTesting my_length:"; +tc [list(integer())] my_length_test; +write "\nTesting make_list:"; +tc [pos_integer()] make_list_test; +write "Testing on my_ceil_1:"; +tc [float()] my_ceil_1_test; +write "Testing on my_ceil_2:"; +tc [float()] my_ceil_2_test; +write "Testing on both ceil functions:"; +tc [float()] both_ceil_test *) +end \ No newline at end of file From 442f9b9d7795ff778dd58e512c5e99e35bc9e4bb Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 21 Apr 2024 14:24:48 +0200 Subject: [PATCH 057/121] integrated shrinking - currently working on separating sequence in to list of sequences for each argument --- troupecheck/integrated_shrinking.trp | 55 ++++++++++++++++++---------- 1 file changed, 35 insertions(+), 20 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index eea49da..15d7b68 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -140,14 +140,25 @@ SHRINKING - r else dec_all_aux (append acc [(dec_nth seq i)]) xs (i+1) in dec_all_aux [] seq 0 end + + fun seqs_of_seq sequence lengths = + let fun aux seq acc 0 = (acc, seq) + | aux (x::xs) acc n = + aux xs (append acc [x]) (n-1) in + foldl (fn (x,(acc, s)) => + let val (curr_acc, curr_seq) = aux s [] x in + (append acc [curr_acc], curr_seq) end)([], sequence) lengths - fun shrink_aux seqs gens prop pre size = + fun shrink_aux seqs gens lengths prop pre size = case seqs of (x1::x2::xs) => - let val (test_args, _) = + let val seqs_of_curr = seqs_of_seq x2 lengths + val test_args = mapi (fn (x,i) => x (nth seqs_of_curr (i+1) rep_rng size)) gens + val _ = print (test_args) + (* val (test_args, _) = foldl (fn (x,y) => let val rnd = x y.1 rep_rng size in - (append y.0 [rnd.raw], rnd.sequence) end)([], x2) gens + (append y.0 [rnd.raw], rnd.sequence) end)([], x2) gens *) val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of @@ -161,14 +172,17 @@ SHRINKING - r in {shrunk_ctx = res, count = size} end - and shrink sequence gens prop pre size = - if foldl (fn (x,y) => (x = 0) andalso y) true sequence then - shrink_aux [sequence] gens prop pre size - else - let val decreased_seqs = dec_all sequence - val dec_seqs_w_root = append [sequence] decreased_seqs - val res = shrink_aux dec_seqs_w_root gens prop pre size - in res end + and shrink sequences gens prop pre size = + let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences + in + if foldl (fn (x,y) => (x = 0) andalso y) true sequence then + shrink_aux [sequences] gens prop pre size + else + let val decreased_seqs = dec_all sequence + val dec_seqs_w_root = append [sequence] decreased_seqs + val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size + in res end + end (* -------------------------------- GENERATORS - t @@ -238,11 +252,11 @@ GENERATORS - t val x = (int_gen (0, size) y.sequence rng size) fun fold f acc 0 = acc | fold f acc i = - let val inst = f() in - fold f (acc.0 ^ inst.raw, (append acc.1 inst.sequence)) (i-1) end - val (string, seq) = (fold (fn () => (char_gen ls rng y.raw)) ("", x.sequence) x.raw) + let val inst = f acc.1 rng y.raw in + fold f (acc.0 ^ inst.raw, inst.sequence) (i-1) end + val (string, seq) = (fold char_gen ("", x.sequence) x.raw) in - {raw = string, sequence = seq} (* Not working as it should... *) + {raw = string, sequence = seq} end (* NOTE: Hardcoded for tuple of up to 10 elements *) @@ -292,18 +306,18 @@ CORE FUNCTIONALITY - a *) fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} |core_forall (generator, prop, i, size, pre, cap) = - let val (sequence, raw_args) = foldl (fn (x,y) => - let val arg = x y.0 rec_rng size in - (append y.0 arg.sequence, append y.1 [arg.raw]) end)([],[]) generator + let val (sequences, raw_args) = foldl (fn (x,y) => + let val arg = x [] rec_rng size in + (append y.0 [arg.sequence], append y.1 [arg.raw]) end)([],[]) generator in case pre of () => if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequence, remTests = i, size = size}) + else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequences, remTests = i, size = size}) | _ => if (apply_args pre raw_args) then if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequence, remTests = i, size = size}) + else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequences, remTests = i, size = size}) else (write "x"; if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) @@ -796,6 +810,7 @@ CUSTOM TYPE PROGRAM val test_seq = [1/6, 1/13] val test_res = 16 in + tc [string(), string()] (append_always_longer, lengths_not_same) (* print (shrink test_seq [int_gen(0,100)] (fn x => x < 5) () 10) *) From de6d5c0afd65b3d94d0dd8714cb6f86db4271f37 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 21 Apr 2024 22:38:13 +0200 Subject: [PATCH 058/121] integrated shrinking works for strings --- troupecheck/integrated_shrinking.trp | 35 ++++++++++++++-------------- 1 file changed, 17 insertions(+), 18 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 15d7b68..bac4fb9 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -145,43 +145,42 @@ SHRINKING - r let fun aux seq acc 0 = (acc, seq) | aux (x::xs) acc n = aux xs (append acc [x]) (n-1) in - foldl (fn (x,(acc, s)) => + (foldl (fn (x,(acc, s)) => let val (curr_acc, curr_seq) = aux s [] x in - (append acc [curr_acc], curr_seq) end)([], sequence) lengths + (append acc [curr_acc], curr_seq) end)([], sequence) lengths).0 end fun shrink_aux seqs gens lengths prop pre size = case seqs of (x1::x2::xs) => let val seqs_of_curr = seqs_of_seq x2 lengths - val test_args = mapi (fn (x,i) => x (nth seqs_of_curr (i+1) rep_rng size)) gens - val _ = print (test_args) - (* val (test_args, _) = - foldl (fn (x,y) => - let val rnd = x y.1 rep_rng size in - (append y.0 [rnd.raw], rnd.sequence) end)([], x2) gens *) + val test_args = mapi (fn (i, x) => (x (nth seqs_of_curr (i+1)) rep_rng size).raw) gens val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in + case (apply_args prop test_args) orelse (precond_is_met = false) of - true => shrink_aux (x1::xs) gens prop pre size - |false => shrink x2 gens prop pre size + true => shrink_aux (x1::xs) gens lengths prop pre size + |false => shrink seqs_of_curr gens prop pre size end | (x::xs) => - let val res = (foldl (fn (z,y) => + let val seqs_of_curr = seqs_of_seq x lengths + val res = mapi (fn (i, y) => (y (nth seqs_of_curr (i+1)) rep_rng size).raw) gens + (* res = (foldl (fn (z,y) => let val rnd = z y.1 rep_rng size in - (append y.0 [rnd.raw], rnd.sequence) end) ([], x) gens).0 - in + (append y.0 [rnd.raw], rnd.sequence) end) ([], x) gens).0 *) + in {shrunk_ctx = res, count = size} end and shrink sequences gens prop pre size = let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences in - if foldl (fn (x,y) => (x = 0) andalso y) true sequence then - shrink_aux [sequences] gens prop pre size + if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then + shrink_aux [seqs_comb] gens seq_lengths prop pre size else - let val decreased_seqs = dec_all sequence - val dec_seqs_w_root = append [sequence] decreased_seqs + let val decreased_seqs = dec_all seqs_comb + val dec_seqs_w_root = append [seqs_comb] decreased_seqs val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size - in res end + in + res end end (* -------------------------------- From 4805eddcd074efd0e3d6edef814bfa447ff2482d Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 21 Apr 2024 23:41:20 +0200 Subject: [PATCH 059/121] Shrinking of larger elements now works (and records) --- troupecheck/integrated_shrinking.trp | 32 ++++++++++++++++++++++------ 1 file changed, 25 insertions(+), 7 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index bac4fb9..d160608 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -126,7 +126,7 @@ SHRINKING - r | dec_nth_aux (x::xs) acc i = case i = idx of true => - let val dec_val = if x-1 <= 0 then 0 else x/2 in + let val dec_val = if x-1 <= 0 then 0 else floor (x/2) in dec_nth_aux xs (append acc [dec_val]) (i+1) end | false => dec_nth_aux xs (append acc [x]) (i+1) in @@ -149,26 +149,43 @@ SHRINKING - r let val (curr_acc, curr_seq) = aux s [] x in (append acc [curr_acc], curr_seq) end)([], sequence) lengths).0 end + fun cutoff_at list idx = + let fun aux ls acc 0 = acc + | aux (x::xs) acc i = + aux xs (append acc [x]) (i-1) in + aux list [] idx end + fun shrink_aux seqs gens lengths prop pre size = case seqs of (x1::x2::xs) => let val seqs_of_curr = seqs_of_seq x2 lengths - val test_args = mapi (fn (i, x) => (x (nth seqs_of_curr (i+1)) rep_rng size).raw) gens + val call_gens = mapi (fn (i, x) => (x (nth seqs_of_curr (i+1)) rep_rng size)) gens + val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.raw], append left_overs [x.sequence])) ([],[]) call_gens + val ret_seqs = mapi (fn (i,x) => + if (length x) = 0 then (nth seqs_of_curr (i+1)) + else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of true => shrink_aux (x1::xs) gens lengths prop pre size - |false => shrink seqs_of_curr gens prop pre size + |false => shrink ret_seqs gens prop pre size end | (x::xs) => let val seqs_of_curr = seqs_of_seq x lengths - val res = mapi (fn (i, y) => (y (nth seqs_of_curr (i+1)) rep_rng size).raw) gens + val test_args = mapi (fn (i, y) => (y (nth seqs_of_curr (i+1)) rep_rng size).raw) gens (* res = (foldl (fn (z,y) => let val rnd = z y.1 rep_rng size in (append y.0 [rnd.raw], rnd.sequence) end) ([], x) gens).0 *) + val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in - {shrunk_ctx = res, count = size} end + case (apply_args prop test_args) orelse (precond_is_met = false) of + true => + let val res = mapi (fn (i, y) => (y (nth seqs_of_curr (i+1)) rep_rng (size+1)).raw) gens in + {shrunk_ctx = res, count = size} end + | false => shrink seqs_of_curr gens prop pre (size-1) + + end and shrink sequences gens prop pre size = let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences @@ -279,7 +296,7 @@ Returns record: {raw_inst = <>, meta_data = (ns, < let val res = x y.1 rng size - in ((append y.0 [res.raw]), (append y.1 res.sequence)) end )([],ls) ts + in ((append y.0 [res.raw]), res.sequence) end )([],ls) ts val raw_res = build_record ns ts_vals in {raw = raw_res, sequence = seq} @@ -810,7 +827,8 @@ CUSTOM TYPE PROGRAM val test_res = 16 in -tc [string(), string()] (append_always_longer, lengths_not_same) +tc [string(), string()] (append_always_longer, lengths_not_same); +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test (* print (shrink test_seq [int_gen(0,100)] (fn x => x < 5) () 10) *) (* From d269e09a03bdc93afe78f23d3a8c42bae0cacd01 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 22 Apr 2024 00:06:02 +0200 Subject: [PATCH 060/121] String shrinking now works! --- troupecheck/integrated_shrinking.trp | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index d160608..fe63d38 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -166,17 +166,13 @@ SHRINKING - r else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in - case (apply_args prop test_args) orelse (precond_is_met = false) of true => shrink_aux (x1::xs) gens lengths prop pre size - |false => shrink ret_seqs gens prop pre size + | false => shrink ret_seqs gens prop pre size end | (x::xs) => let val seqs_of_curr = seqs_of_seq x lengths val test_args = mapi (fn (i, y) => (y (nth seqs_of_curr (i+1)) rep_rng size).raw) gens - (* res = (foldl (fn (z,y) => - let val rnd = z y.1 rep_rng size in - (append y.0 [rnd.raw], rnd.sequence) end) ([], x) gens).0 *) val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of @@ -241,10 +237,12 @@ GENERATORS - t (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) fun list_gen (generator) ls rng size = let val length = (int_gen (0, size) ls rng size) - val res = make_list ((fn () => generator ls rng size), length.raw) - val raw_res = map (fn x => x.raw) res - val sequence = foldl (fn (x,y) => append y x.sequence) [length.sequence] res in - {raw = raw_res, sequence = sequence} + fun fold f acc 0 = acc + | fold f (acc, seq) i = + let val inst = f seq rng size in + fold f (append acc [inst.raw], inst.sequence) (i-1) end + val (list, seq) = (fold generator ([], length.sequence) length.raw) in + {raw = list, sequence = seq} end (* NOTE: Generates only letters (upper and lower case) and numbers. *) @@ -828,7 +826,8 @@ CUSTOM TYPE PROGRAM in tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; +tc [list(integer()), integer()] test_bad_insert (* print (shrink test_seq [int_gen(0,100)] (fn x => x < 5) () 10) *) (* From 3986c573b8e4f6e3d741e3c450a237174631fbdc Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 22 Apr 2024 00:11:48 +0200 Subject: [PATCH 061/121] Previous commit Should say "lists" instead of "strings" - for this commit: cleaned up string_gen code --- troupecheck/integrated_shrinking.trp | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index fe63d38..5f2b824 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -237,12 +237,15 @@ GENERATORS - t (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) fun list_gen (generator) ls rng size = let val length = (int_gen (0, size) ls rng size) + fun fold f acc 0 = acc | fold f (acc, seq) i = let val inst = f seq rng size in fold f (append acc [inst.raw], inst.sequence) (i-1) end - val (list, seq) = (fold generator ([], length.sequence) length.raw) in - {raw = list, sequence = seq} + + val (list, seq) = (fold generator ([], length.sequence) length.raw) + in + {raw = list, sequence = seq} end (* NOTE: Generates only letters (upper and lower case) and numbers. *) @@ -262,15 +265,10 @@ GENERATORS - t (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) fun string_gen ls rng size = - let val y = (int_gen (0, size) ls rng size) - val x = (int_gen (0, size) y.sequence rng size) - fun fold f acc 0 = acc - | fold f acc i = - let val inst = f acc.1 rng y.raw in - fold f (acc.0 ^ inst.raw, inst.sequence) (i-1) end - val (string, seq) = (fold char_gen ("", x.sequence) x.raw) + let val {raw, sequence} = list_gen (char_gen) ls rng size + val string = foldl (fn (char, str_acc) => str_acc ^ char) "" raw in - {raw = string, sequence = seq} + {raw = string, sequence = sequence} end (* NOTE: Hardcoded for tuple of up to 10 elements *) From 59fc17403f95a07487a8add4b1e80d1d46605ba2 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 22 Apr 2024 00:55:06 +0200 Subject: [PATCH 062/121] custom type updated - not working yet --- troupecheck/integrated_shrinking.trp | 209 +++++++-------------------- 1 file changed, 56 insertions(+), 153 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 5f2b824..7a8fae6 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -394,10 +394,10 @@ CONVENIENCE FUNCTIONS - s fun record ns ts = rec_gen ns ts - fun one_of ls = - let val idx = (int_gen (1, (length ls)) ((length ls))).raw + fun one_of ls rng_ls rng = + let val idx = (int_gen (1, (length ls)) rng_ls rng ((length ls))) in - nth ls idx + {raw = (nth ls idx.raw), sequence = idx.sequence} end (* -------------------------------- @@ -438,10 +438,10 @@ FUNCTIONS FOR TESTING - d if length xs < 10 then append [x] xs else xs - fun one_of_two (x, y) = - let val bool = (bool_gen 0).raw in - if bool then x - else y end + fun one_of_two (x, y) ls rng size = + let val bool = (bool_gen ls rng size) in + if bool.raw then x bool.sequence rng size + else y bool.sequence rng size end fun bad_half n = if n > 10 then n else n/2 @@ -464,7 +464,7 @@ PROPERTIES FOR TESTING - f reverse(reverse xs) = xs fun int_gen_stays_in_interval i = - (integer(0, i) i).raw <= i + (integer(0, i)[] rec_rng i).raw <= i fun abs_value_is_always_pos i = abs_value i >= 0 @@ -477,7 +477,7 @@ PROPERTIES FOR TESTING - f fun make_list_test i = let val generator = generator_gen i - fun f() = generator ((int_gen(0, inf) i).raw) + fun f() = generator ((int_gen(0, inf) [] rec_rng i).raw) val ls = (make_list (f, i)) in (length ls) = i end @@ -573,7 +573,7 @@ TC^2 - z CUSTOM TYPE PROGRAM -------------------------------- *) -(* fun eval exp env = + fun eval exp env = case exp of ("num", n) => n | ("var", n) => lookup env n ("unknown variable " ^ n) @@ -646,187 +646,90 @@ CUSTOM TYPE PROGRAM append (map optimize_stmt stmts) [optimize_exp exp] end - fun exp_gen ls nesting_level size = + fun exp_gen ls nesting_level rng_ls rng size = let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] - val exp_type = if nesting_level = 2 then "num" else one_of exp_ts + val exp_type = if nesting_level = 2 then {raw = "num", sequence = rng_ls} else one_of exp_ts rng_ls rng in - case exp_type of + case exp_type.raw of "num" => - let val value = int_gen(inf, inf) size - fun shrinker inst = - let val shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in - {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in - {raw = ("num", value.raw), shrinker = shrinker} end + let val value = int_gen(inf, inf) exp_type.sequence rng size in + {raw = ("num", value.raw), sequence = value.sequence} end | "var" => - let val value = one_of ls - fun shrinker inst = - {inst with state = "done"} in - {raw = ("var", value), shrinker = shrinker} end + let val value = one_of ls exp_type.sequence rng in + {raw = ("var", value.raw), sequence = value.sequence} end |"add" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("add", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end + let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size + val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size in - {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} + {raw = ("add", e1.raw, e2.raw), sequence = e2.sequence} end |"sub" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("sub", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end + let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size + val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size in - {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} + {raw = ("sub", e1.raw, e2.raw), sequence = e2.sequence} end |"mul" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("mul", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end + let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size + val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size in - {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} + {raw = ("mul", e1.raw, e2.raw), sequence = e2.sequence} end |"div" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("div", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end + let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size + val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size in - {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} (* maybe just shrinker? *) + {raw = ("div", e1.raw, e2.raw), sequence = e2.sequence} end end - fun assign_stmt_gen ls size = - let val n = string_gen size - val exp = exp_gen ls 0 size - fun shrinker inst = - let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val shrunk_assign = ("assign", n.raw, shrunk_exp.curr) - in - {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} - end + fun assign_stmt_gen ls rng_ls rng size = + let val n = string_gen rng_ls rng size + val exp = exp_gen ls 0 n.sequence rng size in - {raw = ("assign", n.raw, exp.raw), shrinker = shrinker} + {raw = ("assign", n.raw, exp.raw), sequence = exp.sequence} end - fun print_stmt_gen ls size = - let val exp = exp_gen ls 0 size - fun shrinker inst = - let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_print = ("print", shrunk_exp.curr) - in - {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} - end + fun print_stmt_gen ls rng_ls rng size = + let val exp = exp_gen ls 0 rng_ls rng size in - {raw = ("print", exp.raw), shrinker = shrinker} + {raw = ("print", exp.raw), sequence = exp.sequence} end - fun stmt_gen ls size = - let val stmt = one_of ["assign", "print"] + fun stmt_gen ls rng_ls rng size = + let val stmt = one_of ["assign", "print"] rng_ls rng in - case stmt of + case stmt.raw of "assign" => - let val res = assign_stmt_gen ls size in - {raw = res.raw, shrinker = res.shrinker} end + let val res = assign_stmt_gen ls stmt.sequence rng size in + {raw = res.raw, sequence = res.sequence} end |"print" => - let val res = print_stmt_gen ls size in - {raw = res.raw, shrinker = res.shrinker} end + let val res = print_stmt_gen ls stmt.sequence rng size in + {raw = res.raw, sequence = res.sequence} end end - fun assign_in_use_aux stmt_or_exp assign idx = - case stmt_or_exp.0 of - "print" => - assign_in_use_aux stmt_or_exp.1 assign idx - | "assign" => - assign_in_use_aux stmt_or_exp.2 assign idx - | "var" => if stmt_or_exp.1 = assign then true else false - | "num" => false - | _ => - if assign_in_use_aux stmt_or_exp.1 assign idx then - true - else - assign_in_use_aux stmt_or_exp.2 assign idx - - fun assign_in_use [] idxs assign idx bool = (bool, idxs) - | assign_in_use (x::xs) idxs assign idx bool = - let val res = assign_in_use_aux x assign idx - in - if res then assign_in_use xs (append [idx] idxs) assign (idx+1) true - else assign_in_use xs idxs assign (idx+1) bool - end - - fun program_gen size = - let val num_of_insts = (int_gen(0, size) size ).raw - fun prog_gen_aux env p s 0 = (p, s, env) - | prog_gen_aux env p s i = - let val stmt = stmt_gen env size + fun program_gen rng_ls rng size = + let val num_of_insts = (int_gen(0, size) rng_ls rng size) + fun prog_gen_aux env p seq 0 = (p, seq, env) + | prog_gen_aux env p seq i = + let val stmt = stmt_gen env seq rng size val newEnv = if stmt.raw.0 = "assign" then (append [stmt.raw.1] env) else env in - prog_gen_aux newEnv (append p [stmt.raw]) (append s [stmt.shrinker]) (i-1) + prog_gen_aux newEnv (append p [stmt.raw]) stmt.sequence (i-1) end - val (prog_stmts, shrinkers_interim, last_env) = prog_gen_aux [] [] [] num_of_insts - val last_exp = exp_gen last_env 0 size + val (prog_stmts, sequence_interim, last_env) = prog_gen_aux [] [] num_of_insts.sequence num_of_insts.raw + val last_exp = exp_gen last_env 0 sequence_interim rng size val prog = append prog_stmts [last_exp.raw] - val shrinkers = append shrinkers_interim [last_exp.shrinker] - fun shrinker inst = - case inst.state of - "init" => - let val shrunk = shrink_list shrinkers inst - in - shrunk - end - | "cont_size" => - let val next_elem = nth inst.curr (length inst.curr) - in - if next_elem.0 = "assign" then - if (assign_in_use inst.curr [] (next_elem.1) 0 false).0 then - print "testing"; - {inst with idx = inst.idx-1} - else if (next_elem.0 = "var") orelse (next_elem.0 = "num") orelse (next_elem.0 = "add") orelse (next_elem.0 = "sub") orelse - (next_elem.0 = "mul") orelse (next_elem.0 = "div") then - {inst with idx = inst.idx-1} - - else - shrink_list shrinkers inst - else - shrink_list shrinkers inst - end - | _ => - shrink_list shrinkers inst + val res_sequence = last_exp.sequence in - {raw = prog, shrinker = shrinker} + {raw = prog, sequence = res_sequence} end fun test_prog_opt prog = - (interpret prog) = (interpret (optimize_prog prog)) *) - val test_seq = [1/6, 1/13] - val test_res = 16 + (interpret prog) = (interpret (optimize_prog prog)) in -tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; -tc [list(integer()), integer()] test_bad_insert -(* print (shrink test_seq [int_gen(0,100)] (fn x => x < 5) () 10) *) +tc [program_gen] test_prog_opt (* -------------------------------- @@ -847,7 +750,7 @@ tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test (* tc [list(integer()), integer()] cons_length_increase; tc [list(integer())] my_sort_is_ordered; tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); *) +tc [list(integer())] (my_sort_keep_length, no_duplicates) *) (* General functionality tests *) (* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; From 107a59267c0657c542ca881533b41f14fa1457f1 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 24 Apr 2024 10:39:19 +0200 Subject: [PATCH 063/121] committed before implementing state Co-authored-by: Selma --- troupecheck/integrated_shrinking.trp | 87 +++++++++++++++++++--------- 1 file changed, 60 insertions(+), 27 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 7a8fae6..514232f 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -113,7 +113,7 @@ UTILS - e SHRINKING - r -------------------------------- *) - fun rep_rng [] = () + fun rep_rng [] = {rnd = 0, seq = []} | rep_rng (x::xs) = {rnd = x, seq = xs} @@ -138,7 +138,7 @@ SHRINKING - r if x = 0 then dec_all_aux acc xs (i+1) else - dec_all_aux (append acc [(dec_nth seq i)]) xs (i+1) in + dec_all_aux (append acc [(fn () => (dec_nth seq i))]) xs (i+1) in dec_all_aux [] seq 0 end fun seqs_of_seq sequence lengths = @@ -155,10 +155,10 @@ SHRINKING - r aux xs (append acc [x]) (i-1) in aux list [] idx end - fun shrink_aux seqs gens lengths prop pre size = + fun shrink_aux seqs gens lengths prop pre size counter = case seqs of (x1::x2::xs) => - let val seqs_of_curr = seqs_of_seq x2 lengths + let val seqs_of_curr = seqs_of_seq (x2()) lengths val call_gens = mapi (fn (i, x) => (x (nth seqs_of_curr (i+1)) rep_rng size)) gens val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.raw], append left_overs [x.sequence])) ([],[]) call_gens val ret_seqs = mapi (fn (i,x) => @@ -167,34 +167,54 @@ SHRINKING - r val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of - true => shrink_aux (x1::xs) gens lengths prop pre size - | false => shrink ret_seqs gens prop pre size + true => shrink_aux (x1::xs) gens lengths prop pre size (counter+1) + | false => integrated_shrink ret_seqs gens prop pre size (counter+1) end | (x::xs) => - let val seqs_of_curr = seqs_of_seq x lengths - val test_args = mapi (fn (i, y) => (y (nth seqs_of_curr (i+1)) rep_rng size).raw) gens + let val seqs_of_curr = seqs_of_seq (x()) lengths + val test_args = mapi (fn (i, y) => let val res = (y (nth seqs_of_curr (i+1)) rep_rng size) in res.raw end) gens val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in - case (apply_args prop test_args) orelse (precond_is_met = false) of + case (apply_args prop test_args) orelse (precond_is_met = false) orelse (size < 0) of true => - let val res = mapi (fn (i, y) => (y (nth seqs_of_curr (i+1)) rep_rng (size+1)).raw) gens in - {shrunk_ctx = res, count = size} end - | false => shrink seqs_of_curr gens prop pre (size-1) + let val res = mapi (fn (i, y) => let val res = (y (nth seqs_of_curr (i+1)) rep_rng (size+1)) in res.raw end) gens in + {shrunk_ctx = res, count = counter} end + | false => shrink_aux [x] gens lengths prop pre (size-1) (counter+1) end - and shrink sequences gens prop pre size = + and integrated_shrink sequences gens prop pre size counter = let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences in if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then - shrink_aux [seqs_comb] gens seq_lengths prop pre size - else + shrink_aux [seqs_comb] gens seq_lengths prop pre size counter + else let val decreased_seqs = dec_all seqs_comb - val dec_seqs_w_root = append [seqs_comb] decreased_seqs - val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size + val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs + val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter+1) in res end end + + fun random_shrink_aux sequence generators prop pre success size counter = + if (counter = 10000) orelse (size = 0) then {count = success, size = size, sequences = sequence} else + let val new_size = size-1 + val (shrunk_sequeneces, shrunk_args) = foldl (fn (x, (seq_acc, raw_acc)) => + let val res = x [] rec_rng new_size in + ((append seq_acc [res.sequence]), (append raw_acc [res.raw])) end)([], []) generators + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args) else true + in + case (apply_args prop shrunk_args) orelse (precond_is_met = false) of + true => {count = success, size = size, sequences = sequence} + | false => + random_shrink_aux shrunk_sequeneces generators prop pre (success+1) new_size (counter+1) + end + + fun shrink sequence generators prop pre size counter = + let val res = random_shrink_aux sequence generators prop pre 0 size counter + in + print "testing"; + integrated_shrink (res.sequences) generators prop pre res.size (res.count) end (* -------------------------------- GENERATORS - t @@ -204,7 +224,7 @@ GENERATORS - t (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) fun float_gen (low, high) ls rng size = let val x = rng ls - val bool_int = rng x.seq + val bool_int = rng (x.seq) val bool = bool_int.rnd < 1000000/2 val float_of_x = x.rnd/1000000 val lInf = low = 1/0 (* check for inf *) @@ -223,6 +243,7 @@ GENERATORS - t let val res = (float_gen (low, high+1) ls rng size) val raw_res = floor (res.raw) in + {raw = raw_res, sequence = res.sequence} end (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) @@ -318,9 +339,9 @@ CORE FUNCTIONALITY - a *) fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} |core_forall (generator, prop, i, size, pre, cap) = - let val (sequences, raw_args) = foldl (fn (x,y) => + let val (sequences, raw_args) = foldl (fn (x, (seq_acc, arg_acc)) => let val arg = x [] rec_rng size in - (append y.0 [arg.sequence], append y.1 [arg.raw]) end)([],[]) generator + (append seq_acc [arg.sequence], append arg_acc [arg.raw]) end)([],[]) generator in case pre of () => @@ -348,7 +369,7 @@ CORE FUNCTIONALITY - a |_ => report_fail_reason res noOfTests; write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); - let val shrink_res = shrink res.ctx_seq generators prop pre res.size in + let val shrink_res = shrink res.ctx_seq generators prop pre res.size 0 in write "\nFailing test case was shrunk to:\n"; write (args_toString shrink_res.shrunk_ctx); write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); @@ -590,7 +611,7 @@ CUSTOM TYPE PROGRAM in append [(var, value)] env end - | ("print", exp) => (print (toString (eval exp env)); env) + | ("print", exp) => (()(* print ("from prog: " ^ (toString (eval exp env)) *); env) fun interpret prog = let fun interpretHelper [] env = env @@ -647,15 +668,18 @@ CUSTOM TYPE PROGRAM end fun exp_gen ls nesting_level rng_ls rng size = - let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] + let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["var", "num", "add", "sub", "mul", "div"] val exp_type = if nesting_level = 2 then {raw = "num", sequence = rng_ls} else one_of exp_ts rng_ls rng in case exp_type.raw of "num" => - let val value = int_gen(inf, inf) exp_type.sequence rng size in + let val interim_value = int_gen(1, inf) exp_type.sequence rng size + val value = int_gen(1, inf) exp_type.sequence rng size in {raw = ("num", value.raw), sequence = value.sequence} end | "var" => - let val value = one_of ls exp_type.sequence rng in + let val interim_value1 = int_gen(1, inf) exp_type.sequence rng size + val interim_value2 = one_of ls interim_value1.sequence rng + val value = one_of ls interim_value2.sequence rng in {raw = ("var", value.raw), sequence = value.sequence} end |"add" => let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size @@ -697,7 +721,7 @@ CUSTOM TYPE PROGRAM end fun stmt_gen ls rng_ls rng size = - let val stmt = one_of ["assign", "print"] rng_ls rng + let val stmt = one_of ["print", "assign"] rng_ls rng in case stmt.raw of "assign" => @@ -727,9 +751,18 @@ CUSTOM TYPE PROGRAM fun test_prog_opt prog = (interpret prog) = (interpret (optimize_prog prog)) + fun test_prog_shrink prog = + (interpret prog) < 100 + fun for_i body 0 = body() + | for_i body to = body(); for_i body (to-1) in -tc [program_gen] test_prog_opt + +tc [program_gen] test_prog_shrink + + +(* for_i (fn() => tc [program_gen] test_prog_shrink) 50 *) +(* tc [program_gen] test_prog_shrink *) (* -------------------------------- From 8398ca6d2e0e02246176307ea103763e9ad96a7a Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 24 Apr 2024 12:49:13 +0200 Subject: [PATCH 064/121] updated integrtated shrinking to work with a sort of "state" ( using processes) --- troupecheck/integrated_shrinking.trp | 357 +++++++++++++++------------ 1 file changed, 193 insertions(+), 164 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 514232f..ec37cf8 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -48,9 +48,9 @@ UTILS - e else x :: (remove_nth n xs (i + 1)) fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) fun abs_value x = if x < 0 then -x else x @@ -113,13 +113,33 @@ UTILS - e SHRINKING - r -------------------------------- *) - fun rep_rng [] = {rnd = 0, seq = []} - | rep_rng (x::xs) = - {rnd = x, seq = xs} - fun rec_rng ls = - let val rnd = floor (random()*1000000) in - {rnd = rnd, seq = append ls [rnd]} end + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = floor (random()*1000000) + val _ = send (senderid, rnd) + in rec_rng (append ls [rnd]) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, ls) + in rec_rng [] + end] + + fun rep_rng ls = + receive [hn ("REQUEST_RND", senderid) => + case ls of + (x::xs) => + let val _ = send (senderid, x) + in rep_rng xs + end + | [] => + let val _ = send (senderid, 0) + in rep_rng ls + end, + hn ("REQUEST_LEFT", senderid) => + let val _ = send (senderid, ls) + in rep_rng [] + end] fun dec_nth list idx = let fun dec_nth_aux [] acc i = acc @@ -159,8 +179,15 @@ SHRINKING - r case seqs of (x1::x2::xs) => let val seqs_of_curr = seqs_of_seq (x2()) lengths - val call_gens = mapi (fn (i, x) => (x (nth seqs_of_curr (i+1)) rep_rng size)) gens - val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.raw], append left_overs [x.sequence])) ([],[]) call_gens + val args_and_leftovers = mapi (fn (i, x) => + let val rng_replayer = spawn(fn() => rep_rng (nth seqs_of_curr (i+1))) + val arg = x rng_replayer size + val _ = send (rng_replayer, ("REQUEST_LEFT", self())) + val left_overs = receive [hn x => x] + in (arg, left_overs) + end) gens + + val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.0], append left_overs [x.1])) ([],[]) args_and_leftovers val ret_seqs = mapi (fn (i,x) => if (length x) = 0 then (nth seqs_of_curr (i+1)) else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs @@ -172,12 +199,18 @@ SHRINKING - r end | (x::xs) => let val seqs_of_curr = seqs_of_seq (x()) lengths - val test_args = mapi (fn (i, y) => let val res = (y (nth seqs_of_curr (i+1)) rep_rng size) in res.raw end) gens + val test_args = mapi (fn (i, y) => + let val rng_replayer = spawn (fn() => rep_rng (nth seqs_of_curr (i+1))) + val arg = y rng_replayer size + in arg end) gens val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) orelse (size < 0) of true => - let val res = mapi (fn (i, y) => let val res = (y (nth seqs_of_curr (i+1)) rep_rng (size+1)) in res.raw end) gens in + let val res = mapi (fn (i, y) => + let val rng_replayer = spawn(fn() => rep_rng (nth seqs_of_curr (i+1))) + val arg = y rng_replayer (size+1) + in arg end) gens in {shrunk_ctx = res, count = counter} end | false => shrink_aux [x] gens lengths prop pre (size-1) (counter+1) @@ -196,24 +229,28 @@ SHRINKING - r res end end - fun random_shrink_aux sequence generators prop pre success size counter = + fun random_shrink_aux sequence generators prop pre success size counter pid = if (counter = 10000) orelse (size = 0) then {count = success, size = size, sequences = sequence} else let val new_size = size-1 - val (shrunk_sequeneces, shrunk_args) = foldl (fn (x, (seq_acc, raw_acc)) => - let val res = x [] rec_rng new_size in - ((append seq_acc [res.sequence]), (append raw_acc [res.raw])) end)([], []) generators + val (shrunk_args, shrunk_sequences) = + foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x pid size + val _ = send (pid, ("REQUEST_SEQ", self())) + val seq = receive [hn x => x] + in (append arg_acc [arg], append seq_acc [seq]) + end) ([],[]) generators val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args) else true in case (apply_args prop shrunk_args) orelse (precond_is_met = false) of true => {count = success, size = size, sequences = sequence} | false => - random_shrink_aux shrunk_sequeneces generators prop pre (success+1) new_size (counter+1) + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (counter+1) pid end fun shrink sequence generators prop pre size counter = - let val res = random_shrink_aux sequence generators prop pre 0 size counter + let val rng_recorder = spawn (fn() => rec_rng []) + val res = random_shrink_aux sequence generators prop pre 0 size counter rng_recorder in - print "testing"; integrated_shrink (res.sequences) generators prop pre res.size (res.count) end (* -------------------------------- @@ -222,114 +259,92 @@ GENERATORS - t *) (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) - fun float_gen (low, high) ls rng size = - let val x = rng ls - val bool_int = rng (x.seq) - val bool = bool_int.rnd < 1000000/2 - val float_of_x = x.rnd/1000000 + fun float_gen (low, high) pid size = + let val _ = send (pid, ("REQUEST_RND", self())) + val x = receive [hn x => x] + val _ = send (pid, ("REQUEST_RND", self())) + val bool_int = receive [hn x => x] + val bool = bool_int < 1000000/2 + val float_of_x = x/1000000 val lInf = low = 1/0 (* check for inf *) val hInf = high = 1/0 - val raw_res = + val res = case (lInf, hInf) of (true, true) => if bool then float_of_x * size else -float_of_x * size | (true, false) => high - (float_of_x * size) | (false, true) => low + (float_of_x * size) | (false, false) => low + (float_of_x * (high-low)) - in - {raw = raw_res, sequence = bool_int.seq} + in res end - fun int_gen (low, high) ls rng size = - let val res = (float_gen (low, high+1) ls rng size) - val raw_res = floor (res.raw) - in - - {raw = raw_res, sequence = res.sequence} - end - (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) - fun bool_gen ls rng size = - let val rnd = int_gen (0,1) ls rng size - val res = if rnd.raw = 0 then false - else true - in - {raw = res, sequence = rnd.sequence} + fun int_gen (low, high) pid size = + let val res = floor (float_gen (low, high+1) pid size) + in res end - (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) - fun list_gen (generator) ls rng size = - let val length = (int_gen (0, size) ls rng size) + fun bool_gen pid size = + let val rnd = int_gen (0,1) pid size + val res = if rnd = 0 then false + else true + in res + end - fun fold f acc 0 = acc - | fold f (acc, seq) i = - let val inst = f seq rng size in - fold f (append acc [inst.raw], inst.sequence) (i-1) end - - val (list, seq) = (fold generator ([], length.sequence) length.raw) - in - {raw = list, sequence = seq} + fun list_gen (generator) pid size = + let val length = (int_gen (0, size) pid size) + val res = make_list ((fn () => generator pid size), length) + in res end (* NOTE: Generates only letters (upper and lower case) and numbers. *) (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) - fun char_gen ls rng size = + fun char_gen pid size = let val chars = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = (int_gen (1, ((length chars)-1)) ls rng size) - in - {raw = (nth chars x.raw), sequence = x.sequence} + val x = (int_gen (1, ((length chars)-1)) pid size) + in nth chars x end (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) - (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) - fun string_gen ls rng size = - let val {raw, sequence} = list_gen (char_gen) ls rng size - val string = foldl (fn (char, str_acc) => str_acc ^ char) "" raw - in - {raw = string, sequence = sequence} + fun string_gen pid size = + let val char_ls = list_gen (char_gen) pid size + val string = list_to_string char_ls + in string end (* NOTE: Hardcoded for tuple of up to 10 elements *) -(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list - of all generated values in raw_inst along with their respective meta_data. *) - fun tuple_gen ts ls rng size = - let val (ts_vals, seq) = foldl (fn (x,y) => let val res = x y.1 rng size - in ((append y.0 [res.raw]), (append y.1 res.sequence)) end )([],ls) ts - in - {raw = (build_tuple ts_vals), sequence = seq} + fun tuple_gen ts pid size = + let val ts_vals = map (fn x => x pid size) ts + in build_tuple ts_vals end (* ns: list of strings - will be used as fieldnames ts: list of generators - used to generate values for fields - -Returns record: {raw_inst = <>, meta_data = (ns, <>)} *) - fun rec_gen ns ts ls rng size = + fun rec_gen ns ts pid size = if (length ns) <> (length ts) then report_error ("record_mismatch", 0) else - let val (ts_vals, seq) = foldl (fn (x,y) => let val res = x y.1 rng size - in ((append y.0 [res.raw]), res.sequence) end )([],ls) ts - val raw_res = build_record ns ts_vals - in - {raw = raw_res, sequence = seq} + let val ts_vals = map (fn x => x pid size) ts + val res = build_record ns ts_vals + in res end - fun generator_gen rng size = - let val rnd = int_gen rng (1,7) size + fun generator_gen pid size = + let val rnd = int_gen (1,7) pid size val inf = 1/0 - val res = if rnd = 1 then ((fn i => int_gen rng (inf, inf) i)) else - if rnd = 2 then ((fn i => bool_gen rng i)) else - if rnd = 3 then ((fn i => float_gen rng (inf, inf) i)) else - if rnd = 4 then ((fn i => string_gen rng i)) else - if rnd = 5 then ((fn i => char_gen rng i)) else - if rnd = 6 then ((fn i => tuple_gen rng (make_list ((fn () => int_gen(inf, inf)), i)) i)) else - ((fn i => list_gen rng (int_gen(inf, inf)) i)) in + val res = if rnd = 1 then ((fn i => int_gen (inf, inf) pid i)) else + if rnd = 2 then ((fn i => bool_gen pid i)) else + if rnd = 3 then ((fn i => float_gen (inf, inf) pid i)) else + if rnd = 4 then ((fn i => string_gen pid i)) else + if rnd = 5 then ((fn i => char_gen pid i)) else + if rnd = 6 then ((fn i => tuple_gen pid (make_list ((fn () => int_gen(inf, inf) pid i), i)) i)) else + ((fn i => list_gen (int_gen(inf, inf)) pid i)) in res end (* @@ -337,25 +352,35 @@ Returns record: {raw_inst = <>, meta_data = (ns, < - let val arg = x [] rec_rng size in - (append seq_acc [arg.sequence], append arg_acc [arg.raw]) end)([],[]) generator - in + fun core_forall (generators, prop, 0, size, pre, cap, pid) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} + |core_forall (generators, prop, i, size, pre, cap, pid) = + let val (args, sequences) = foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x pid size + val _ = send (pid, ("REQUEST_SEQ", self())) + val seq = receive [hn x => x] + in (append arg_acc [arg], append seq_acc [seq]) + end) ([],[])generators + in case pre of () => - if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequences, remTests = i, size = size}) + if (apply_args prop args) then (write "."; core_forall (generators, prop, i-1, size+1, pre, cap, pid)) + else + let val _ = write "!" + in {failReason = "false_prop", ctx = args, ctx_seq = sequences, remTests = i, size = size} + end | _ => - if (apply_args pre raw_args) then - if (apply_args prop raw_args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", ctx = raw_args, ctx_seq = sequences, remTests = i, size = size}) + if (apply_args pre args) then + if (apply_args prop args) then (write "."; core_forall (generators, prop, i-1, size+1, pre, cap, pid)) + else + let val _ = write "!" + in {failReason = "false_prop", ctx = args, ctx_seq = sequences, remTests = i, size = size} + end else - (write "x"; - if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) - else if size = cap then {failReason = (), ctx = (), ctx_seq = (), remTests = i, size = size} - else core_forall (generator, prop, i, size+1, pre, cap)) + let val _ = write "x" + in if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) + else if size = cap then {failReason = (), ctx = (), ctx_seq = (), remTests = i, size = size} + else core_forall (generators, prop, i, size+1, pre, cap, pid) + end end fun tc_n generators p noOfTests = @@ -363,7 +388,8 @@ CORE FUNCTIONALITY - a case p of (x,y) => (x,y) | x => (x, ()) - val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in + val rng_recorder = spawn (fn() => rec_rng []) + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5), rng_recorder) in case res.failReason of () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true |_ => @@ -404,7 +430,7 @@ CONVENIENCE FUNCTIONS - s fun boolean() = bool_gen - fun list() = list_gen(generator_gen()) (* TODO: generator_gen() should return both raw_gen and meta_data *) + fun list() = list_gen(generator_gen()) |list(type) = list_gen(type) fun string() = string_gen @@ -415,10 +441,10 @@ CONVENIENCE FUNCTIONS - s fun record ns ts = rec_gen ns ts - fun one_of ls rng_ls rng = - let val idx = (int_gen (1, (length ls)) rng_ls rng ((length ls))) + fun one_of ls pid = + let val idx = (int_gen (1, (length ls)) pid ((length ls))) in - {raw = (nth ls idx.raw), sequence = idx.sequence} + (nth ls idx) end (* -------------------------------- @@ -459,10 +485,10 @@ FUNCTIONS FOR TESTING - d if length xs < 10 then append [x] xs else xs - fun one_of_two (x, y) ls rng size = - let val bool = (bool_gen ls rng size) in - if bool.raw then x bool.sequence rng size - else y bool.sequence rng size end + fun one_of_two (x, y) pid size = + let val bool = (bool_gen pid size) in + if bool then x pid size + else y pid size end fun bad_half n = if n > 10 then n else n/2 @@ -485,7 +511,8 @@ PROPERTIES FOR TESTING - f reverse(reverse xs) = xs fun int_gen_stays_in_interval i = - (integer(0, i)[] rec_rng i).raw <= i + let val pid = spawn (fn() => rec_rng []) in + (integer(0, i) pid i) <= i end fun abs_value_is_always_pos i = abs_value i >= 0 @@ -497,8 +524,9 @@ PROPERTIES FOR TESTING - f my_length xs = length xs fun make_list_test i = - let val generator = generator_gen i - fun f() = generator ((int_gen(0, inf) [] rec_rng i).raw) + let val pid = spawn (fn() => rec_rng []) + val generator = generator_gen pid i + fun f() = generator (int_gen(0, inf) pid i) val ls = (make_list (f, i)) in (length ls) = i end @@ -667,86 +695,85 @@ CUSTOM TYPE PROGRAM append (map optimize_stmt stmts) [optimize_exp exp] end - fun exp_gen ls nesting_level rng_ls rng size = - let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["var", "num", "add", "sub", "mul", "div"] - val exp_type = if nesting_level = 2 then {raw = "num", sequence = rng_ls} else one_of exp_ts rng_ls rng + fun exp_gen ls nesting_level pid size = + let val exp_ts = + if nesting_level = 2 then ["num"] + else (if length ls = 0 then ["num", "add", "sub", "mul", "div"] + else ["var", "num", "add", "sub", "mul", "div"]) + val exp_type = one_of exp_ts pid in - case exp_type.raw of + case exp_type of "num" => - let val interim_value = int_gen(1, inf) exp_type.sequence rng size - val value = int_gen(1, inf) exp_type.sequence rng size in - {raw = ("num", value.raw), sequence = value.sequence} end + let val value = int_gen(1, inf) pid size in + ("num", value) end | "var" => - let val interim_value1 = int_gen(1, inf) exp_type.sequence rng size - val interim_value2 = one_of ls interim_value1.sequence rng - val value = one_of ls interim_value2.sequence rng in - {raw = ("var", value.raw), sequence = value.sequence} end + let val value = one_of ls pid in + ("var", value) end |"add" => - let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size - val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size + let val e1 = exp_gen ls (nesting_level+1) pid size + val e2 = exp_gen ls (nesting_level+1) pid size in - {raw = ("add", e1.raw, e2.raw), sequence = e2.sequence} + ("add", e1, e2) end |"sub" => - let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size - val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size + let val e1 = exp_gen ls (nesting_level+1) pid size + val e2 = exp_gen ls (nesting_level+1) pid size in - {raw = ("sub", e1.raw, e2.raw), sequence = e2.sequence} + ("sub", e1, e2) end |"mul" => - let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size - val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size + let val e1 = exp_gen ls (nesting_level+1) pid size + val e2 = exp_gen ls (nesting_level+1) pid size in - {raw = ("mul", e1.raw, e2.raw), sequence = e2.sequence} + ("mul", e1, e2) end |"div" => - let val e1 = exp_gen ls (nesting_level+1) exp_type.sequence rng size - val e2 = exp_gen ls (nesting_level+1) e1.sequence rng size + let val e1 = exp_gen ls (nesting_level+1) pid size + val e2 = exp_gen ls (nesting_level+1) pid size in - {raw = ("div", e1.raw, e2.raw), sequence = e2.sequence} + ("div", e1, e2) end end - fun assign_stmt_gen ls rng_ls rng size = - let val n = string_gen rng_ls rng size - val exp = exp_gen ls 0 n.sequence rng size + fun assign_stmt_gen ls pid size = + let val n = string_gen pid size + val exp = exp_gen ls 0 pid size in - {raw = ("assign", n.raw, exp.raw), sequence = exp.sequence} + ("assign", n, exp) end - fun print_stmt_gen ls rng_ls rng size = - let val exp = exp_gen ls 0 rng_ls rng size + fun print_stmt_gen ls pid size = + let val exp = exp_gen ls 0 pid size in - {raw = ("print", exp.raw), sequence = exp.sequence} + ("print", exp) end - fun stmt_gen ls rng_ls rng size = - let val stmt = one_of ["print", "assign"] rng_ls rng + fun stmt_gen ls pid size = + let val stmt = one_of ["print", "assign"] pid in - case stmt.raw of + case stmt of "assign" => - let val res = assign_stmt_gen ls stmt.sequence rng size in - {raw = res.raw, sequence = res.sequence} end + let val res = assign_stmt_gen ls pid size in + res end |"print" => - let val res = print_stmt_gen ls stmt.sequence rng size in - {raw = res.raw, sequence = res.sequence} end + let val res = print_stmt_gen ls pid size in + res end end - fun program_gen rng_ls rng size = - let val num_of_insts = (int_gen(0, size) rng_ls rng size) - fun prog_gen_aux env p seq 0 = (p, seq, env) - | prog_gen_aux env p seq i = - let val stmt = stmt_gen env seq rng size - val newEnv = if stmt.raw.0 = "assign" then (append [stmt.raw.1] env) else env + fun program_gen pid size = + let val num_of_insts = (int_gen(0, size) pid size) + fun prog_gen_aux env p 0 = (p, env) + | prog_gen_aux env p i = + let val stmt = stmt_gen env pid size + val newEnv = if stmt.0 = "assign" then (append [stmt.1] env) else env in - prog_gen_aux newEnv (append p [stmt.raw]) stmt.sequence (i-1) + prog_gen_aux newEnv (append p [stmt]) (i-1) end - val (prog_stmts, sequence_interim, last_env) = prog_gen_aux [] [] num_of_insts.sequence num_of_insts.raw - val last_exp = exp_gen last_env 0 sequence_interim rng size - val prog = append prog_stmts [last_exp.raw] - val res_sequence = last_exp.sequence + val (prog_stmts, last_env) = prog_gen_aux [] [] num_of_insts + val last_exp = exp_gen last_env 0 pid size + val prog = append prog_stmts [last_exp] in - {raw = prog, sequence = res_sequence} + prog end fun test_prog_opt prog = @@ -758,7 +785,8 @@ CUSTOM TYPE PROGRAM in -tc [program_gen] test_prog_shrink + +tc [program_gen] test_prog_shrink; (* for_i (fn() => tc [program_gen] test_prog_shrink) 50 *) @@ -813,4 +841,5 @@ write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; tc [float()] both_ceil_test *) +exit (authority, 0) end \ No newline at end of file From 1187fa68749850d45f84b0240fa904044fc73ed2 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 24 Apr 2024 15:25:07 +0200 Subject: [PATCH 065/121] shrinking custom programs works - but it doesn't always produce the best shrink --- troupecheck/integrated_shrinking.trp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index ec37cf8..9bdec24 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -229,8 +229,8 @@ SHRINKING - r res end end - fun random_shrink_aux sequence generators prop pre success size counter pid = - if (counter = 10000) orelse (size = 0) then {count = success, size = size, sequences = sequence} else + fun random_shrink_aux sequences generators prop pre success size counter pid = + if (counter = 10000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else let val new_size = size-1 val (shrunk_args, shrunk_sequences) = foldl (fn (x, (arg_acc, seq_acc)) => @@ -242,7 +242,7 @@ SHRINKING - r val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args) else true in case (apply_args prop shrunk_args) orelse (precond_is_met = false) of - true => {count = success, size = size, sequences = sequence} + true => random_shrink_aux sequences generators prop pre success size (counter+1) pid | false => random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (counter+1) pid end @@ -782,13 +782,13 @@ CUSTOM TYPE PROGRAM (interpret prog) < 100 fun for_i body 0 = body() | for_i body to = body(); for_i body (to-1) -in - + val seq = [[267780, 689125, 203803, 618600, 22142, 181797, 268993, 783974, 286438, 440154, 781712, 459460, 962769, 482855, 159926, 418551, 984104, 173034, 540674, 927189, 212169, 718086, 733167, 861479, 102743, 728028, 756405, 33167, 172289, 326962, 170851, 63613, 658659, 592355, 200373, 681450, 464463, 768613, 97359, 366897, 55000, 954642, 56192, 93387, 705644, 488085, 826189, 891989, 524325, 313064, 412008, 797972, 892377, 369868, 883008, 361089, 787380, 821443, 346419, 250197, 301447, 111385, 402424, 327486, 119693, 135341]] + val size = 11 +in +(* integrated_shrink seq [program_gen] test_prog_shrink () size 0; *) tc [program_gen] test_prog_shrink; - - (* for_i (fn() => tc [program_gen] test_prog_shrink) 50 *) (* tc [program_gen] test_prog_shrink *) From 8692b6a97b00ded1a7f0673f476747413090c3bc Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 24 Apr 2024 15:34:48 +0200 Subject: [PATCH 066/121] fixed mistake in random shrinking, so that costum shrinking works now --- troupecheck/integrated_shrinking.trp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 9bdec24..1a793ec 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -194,7 +194,7 @@ SHRINKING - r val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of - true => shrink_aux (x1::xs) gens lengths prop pre size (counter+1) + true => shrink_aux (x1::xs) gens lengths prop pre size counter | false => integrated_shrink ret_seqs gens prop pre size (counter+1) end | (x::xs) => @@ -212,7 +212,7 @@ SHRINKING - r val arg = y rng_replayer (size+1) in arg end) gens in {shrunk_ctx = res, count = counter} end - | false => shrink_aux [x] gens lengths prop pre (size-1) (counter+1) + | false => shrink_aux [x] gens lengths prop pre (size-1) counter end @@ -224,7 +224,7 @@ SHRINKING - r else let val decreased_seqs = dec_all seqs_comb val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs - val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter+1) + val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) in res end end From 27f02375833f66a3fa5b858fbda7c259a804ca92 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 24 Apr 2024 16:43:38 +0200 Subject: [PATCH 067/121] optimised shrinking code, so that it runs a bit faster (only spawns one function for a replay rng) --- troupecheck/integrated_shrinking.trp | 41 +++++++++++++++------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 1a793ec..610616c 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -139,7 +139,9 @@ SHRINKING - r hn ("REQUEST_LEFT", senderid) => let val _ = send (senderid, ls) in rep_rng [] - end] + end, + hn ("UPDATE_LS", new_ls) => + rep_rng new_ls] fun dec_nth list idx = let fun dec_nth_aux [] acc i = acc @@ -175,14 +177,14 @@ SHRINKING - r aux xs (append acc [x]) (i-1) in aux list [] idx end - fun shrink_aux seqs gens lengths prop pre size counter = + fun shrink_aux seqs gens lengths prop pre size counter pid = case seqs of (x1::x2::xs) => let val seqs_of_curr = seqs_of_seq (x2()) lengths val args_and_leftovers = mapi (fn (i, x) => - let val rng_replayer = spawn(fn() => rep_rng (nth seqs_of_curr (i+1))) - val arg = x rng_replayer size - val _ = send (rng_replayer, ("REQUEST_LEFT", self())) + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = x pid size + val _ = send (pid, ("REQUEST_LEFT", self())) val left_overs = receive [hn x => x] in (arg, left_overs) end) gens @@ -194,37 +196,37 @@ SHRINKING - r val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of - true => shrink_aux (x1::xs) gens lengths prop pre size counter - | false => integrated_shrink ret_seqs gens prop pre size (counter+1) + true => shrink_aux (x1::xs) gens lengths prop pre size counter pid + | false => integrated_shrink ret_seqs gens prop pre size (counter+1) pid end | (x::xs) => let val seqs_of_curr = seqs_of_seq (x()) lengths val test_args = mapi (fn (i, y) => - let val rng_replayer = spawn (fn() => rep_rng (nth seqs_of_curr (i+1))) - val arg = y rng_replayer size + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y pid size in arg end) gens val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) orelse (size < 0) of true => let val res = mapi (fn (i, y) => - let val rng_replayer = spawn(fn() => rep_rng (nth seqs_of_curr (i+1))) - val arg = y rng_replayer (size+1) + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y pid (size+1) in arg end) gens in {shrunk_ctx = res, count = counter} end - | false => shrink_aux [x] gens lengths prop pre (size-1) counter + | false => shrink_aux [x] gens lengths prop pre (size-1) counter pid end - and integrated_shrink sequences gens prop pre size counter = + and integrated_shrink sequences gens prop pre size counter pid = let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences in if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then - shrink_aux [seqs_comb] gens seq_lengths prop pre size counter + shrink_aux [seqs_comb] gens seq_lengths prop pre size counter pid else let val decreased_seqs = dec_all seqs_comb val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs - val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) + val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) pid in res end end @@ -234,7 +236,7 @@ SHRINKING - r let val new_size = size-1 val (shrunk_args, shrunk_sequences) = foldl (fn (x, (arg_acc, seq_acc)) => - let val arg = x pid size + let val arg = x pid new_size val _ = send (pid, ("REQUEST_SEQ", self())) val seq = receive [hn x => x] in (append arg_acc [arg], append seq_acc [seq]) @@ -244,14 +246,15 @@ SHRINKING - r case (apply_args prop shrunk_args) orelse (precond_is_met = false) of true => random_shrink_aux sequences generators prop pre success size (counter+1) pid | false => - random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (counter+1) pid + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) pid end fun shrink sequence generators prop pre size counter = let val rng_recorder = spawn (fn() => rec_rng []) val res = random_shrink_aux sequence generators prop pre 0 size counter rng_recorder + val rng_replayer = spawn (fn() => rep_rng []) in - integrated_shrink (res.sequences) generators prop pre res.size (res.count) end + integrated_shrink (res.sequences) generators prop pre res.size (res.count) rng_replayer end (* -------------------------------- GENERATORS - t @@ -788,7 +791,7 @@ CUSTOM TYPE PROGRAM in (* integrated_shrink seq [program_gen] test_prog_shrink () size 0; *) -tc [program_gen] test_prog_shrink; +for_i (fn () => tc [program_gen] test_prog_shrink) 5; (* for_i (fn() => tc [program_gen] test_prog_shrink) 50 *) (* tc [program_gen] test_prog_shrink *) From 214a48ac5128bc4cf2ab5bcd5473299ef4a820bb Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 24 Apr 2024 23:30:58 +0200 Subject: [PATCH 068/121] Optimized shrinking a bit (dec_all now only creates a function for the next list, and a function for the rest) --- troupecheck/integrated_shrinking.trp | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 610616c..b69d25f 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -155,13 +155,13 @@ SHRINKING - r dec_nth_aux list [] 0 end fun dec_all seq = - let fun dec_all_aux acc [] i = acc - | dec_all_aux acc (x::xs) i = + let fun dec_all_aux [] i = [] + | dec_all_aux (x::xs) i = if x = 0 then - dec_all_aux acc xs (i+1) + dec_all_aux xs (i+1) else - dec_all_aux (append acc [(fn () => (dec_nth seq i))]) xs (i+1) in - dec_all_aux [] seq 0 end + append [(fn () => (dec_nth seq i))] [fn () => dec_all_aux xs (i+1)] in + dec_all_aux seq 0 end fun seqs_of_seq sequence lengths = let fun aux seq acc 0 = (acc, seq) @@ -179,7 +179,7 @@ SHRINKING - r fun shrink_aux seqs gens lengths prop pre size counter pid = case seqs of - (x1::x2::xs) => + (x1::x2::x3::xs) => let val seqs_of_curr = seqs_of_seq (x2()) lengths val args_and_leftovers = mapi (fn (i, x) => let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) @@ -196,7 +196,7 @@ SHRINKING - r val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of - true => shrink_aux (x1::xs) gens lengths prop pre size counter pid + true => shrink_aux (x1::x3()) gens lengths prop pre size counter pid | false => integrated_shrink ret_seqs gens prop pre size (counter+1) pid end | (x::xs) => @@ -232,7 +232,7 @@ SHRINKING - r end fun random_shrink_aux sequences generators prop pre success size counter pid = - if (counter = 10000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else + if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else let val new_size = size-1 val (shrunk_args, shrunk_sequences) = foldl (fn (x, (arg_acc, seq_acc)) => @@ -791,7 +791,13 @@ CUSTOM TYPE PROGRAM in (* integrated_shrink seq [program_gen] test_prog_shrink () size 0; *) -for_i (fn () => tc [program_gen] test_prog_shrink) 5; + +tc [list(integer()), integer()] test_bad_insert; +tc [integer()] (test_bad_half, (fn x => x >= 15)); +tc [string(), string()] (append_always_longer, lengths_not_same); +tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; +tc [program_gen] test_prog_shrink; + (* for_i (fn() => tc [program_gen] test_prog_shrink) 50 *) (* tc [program_gen] test_prog_shrink *) From d7967905cf0114f4bc9e92651136f0436d288471 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 25 Apr 2024 13:20:24 +0200 Subject: [PATCH 069/121] no longer need to give pids as arguments to generators Co-authored-by: Selma --- troupecheck/integrated_shrinking.trp | 228 ++++++++++++++++----------- 1 file changed, 133 insertions(+), 95 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index b69d25f..60144c1 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -113,6 +113,17 @@ UTILS - e SHRINKING - r -------------------------------- *) + fun produce_rng rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in produce_rng rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + produce_rng new_rng end] + + val rng_producer = spawn (fn() => produce_rng ()) + fun rec_rng ls = receive [hn ("REQUEST_RND", senderid) => @@ -177,13 +188,15 @@ SHRINKING - r aux xs (append acc [x]) (i-1) in aux list [] idx end - fun shrink_aux seqs gens lengths prop pre size counter pid = - case seqs of + fun shrink_aux seqs gens lengths prop pre size counter = + let val _ = send(rng_producer, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + in case seqs of (x1::x2::x3::xs) => let val seqs_of_curr = seqs_of_seq (x2()) lengths val args_and_leftovers = mapi (fn (i, x) => let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) - val arg = x pid size + val arg = x size val _ = send (pid, ("REQUEST_LEFT", self())) val left_overs = receive [hn x => x] in (arg, left_overs) @@ -196,14 +209,14 @@ SHRINKING - r val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in case (apply_args prop test_args) orelse (precond_is_met = false) of - true => shrink_aux (x1::x3()) gens lengths prop pre size counter pid - | false => integrated_shrink ret_seqs gens prop pre size (counter+1) pid + true => shrink_aux (x1::x3()) gens lengths prop pre size counter + | false => integrated_shrink ret_seqs gens prop pre size (counter+1) end | (x::xs) => let val seqs_of_curr = seqs_of_seq (x()) lengths val test_args = mapi (fn (i, y) => let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) - val arg = y pid size + val arg = y size in arg end) gens val precond_is_met = if (pre <> ()) then (apply_args pre test_args) else true in @@ -211,32 +224,35 @@ SHRINKING - r true => let val res = mapi (fn (i, y) => let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) - val arg = y pid (size+1) + val arg = y (size+1) in arg end) gens in {shrunk_ctx = res, count = counter} end - | false => shrink_aux [x] gens lengths prop pre (size-1) counter pid + | false => shrink_aux [x] gens lengths prop pre (size-1) counter - end + end + end - and integrated_shrink sequences gens prop pre size counter pid = + and integrated_shrink sequences gens prop pre size counter = let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences in if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then - shrink_aux [seqs_comb] gens seq_lengths prop pre size counter pid + shrink_aux [seqs_comb] gens seq_lengths prop pre size counter else let val decreased_seqs = dec_all seqs_comb val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs - val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) pid + val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) in res end end - fun random_shrink_aux sequences generators prop pre success size counter pid = + fun random_shrink_aux sequences generators prop pre success size counter = if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else - let val new_size = size-1 + let val _ = send(rng_producer, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val new_size = size-1 val (shrunk_args, shrunk_sequences) = foldl (fn (x, (arg_acc, seq_acc)) => - let val arg = x pid new_size + let val arg = x new_size val _ = send (pid, ("REQUEST_SEQ", self())) val seq = receive [hn x => x] in (append arg_acc [arg], append seq_acc [seq]) @@ -244,17 +260,21 @@ SHRINKING - r val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args) else true in case (apply_args prop shrunk_args) orelse (precond_is_met = false) of - true => random_shrink_aux sequences generators prop pre success size (counter+1) pid + true => random_shrink_aux sequences generators prop pre success size (counter+1) | false => - random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) pid + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) end fun shrink sequence generators prop pre size counter = let val rng_recorder = spawn (fn() => rec_rng []) - val res = random_shrink_aux sequence generators prop pre 0 size counter rng_recorder + val _ = send (rng_producer, ("UPDATE_RNG", self(), rng_recorder)) + val _ = receive [hn x => ()] + val res = random_shrink_aux sequence generators prop pre 0 size counter val rng_replayer = spawn (fn() => rep_rng []) + val _ = send (rng_producer, ("UPDATE_RNG", self(), rng_replayer)) + val _ = receive [hn x => ()] in - integrated_shrink (res.sequences) generators prop pre res.size (res.count) rng_replayer end + integrated_shrink (res.sequences) generators prop pre res.size (res.count) end (* -------------------------------- GENERATORS - t @@ -262,8 +282,10 @@ GENERATORS - t *) (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) - fun float_gen (low, high) pid size = - let val _ = send (pid, ("REQUEST_RND", self())) + fun float_gen (low, high) size = + let val _ = send (rng_producer, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send (pid, ("REQUEST_RND", self())) val x = receive [hn x => x] val _ = send (pid, ("REQUEST_RND", self())) val bool_int = receive [hn x => x] @@ -280,47 +302,47 @@ GENERATORS - t in res end - fun int_gen (low, high) pid size = - let val res = floor (float_gen (low, high+1) pid size) + fun int_gen (low, high) size = + let val res = floor (float_gen (low, high+1) size) in res end - fun bool_gen pid size = - let val rnd = int_gen (0,1) pid size + fun bool_gen size = + let val rnd = int_gen (0,1) size val res = if rnd = 0 then false else true in res end - fun list_gen (generator) pid size = - let val length = (int_gen (0, size) pid size) - val res = make_list ((fn () => generator pid size), length) + fun list_gen (generator) size = + let val length = (int_gen (0, size) size) + val res = make_list ((fn () => generator size), length) in res end (* NOTE: Generates only letters (upper and lower case) and numbers. *) (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) - fun char_gen pid size = + fun char_gen size = let val chars = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = (int_gen (1, ((length chars)-1)) pid size) + val x = (int_gen (1, ((length chars)-1)) size) in nth chars x end (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) - fun string_gen pid size = - let val char_ls = list_gen (char_gen) pid size + fun string_gen size = + let val char_ls = list_gen (char_gen) size val string = list_to_string char_ls in string end (* NOTE: Hardcoded for tuple of up to 10 elements *) - fun tuple_gen ts pid size = - let val ts_vals = map (fn x => x pid size) ts + fun tuple_gen ts size = + let val ts_vals = map (fn x => x size) ts in build_tuple ts_vals end @@ -328,26 +350,26 @@ GENERATORS - t ns: list of strings - will be used as fieldnames ts: list of generators - used to generate values for fields *) - fun rec_gen ns ts pid size = + fun rec_gen ns ts size = if (length ns) <> (length ts) then report_error ("record_mismatch", 0) else - let val ts_vals = map (fn x => x pid size) ts + let val ts_vals = map (fn x => x size) ts val res = build_record ns ts_vals in res end - fun generator_gen pid size = - let val rnd = int_gen (1,7) pid size + fun generator_gen size = + let val rnd = int_gen (1,7) size val inf = 1/0 - val res = if rnd = 1 then ((fn i => int_gen (inf, inf) pid i)) else - if rnd = 2 then ((fn i => bool_gen pid i)) else - if rnd = 3 then ((fn i => float_gen (inf, inf) pid i)) else - if rnd = 4 then ((fn i => string_gen pid i)) else - if rnd = 5 then ((fn i => char_gen pid i)) else - if rnd = 6 then ((fn i => tuple_gen pid (make_list ((fn () => int_gen(inf, inf) pid i), i)) i)) else - ((fn i => list_gen (int_gen(inf, inf)) pid i)) in + val res = if rnd = 1 then ((fn i => int_gen (inf, inf) i)) else + if rnd = 2 then ((fn i => bool_gen i)) else + if rnd = 3 then ((fn i => float_gen (inf, inf) i)) else + if rnd = 4 then ((fn i => string_gen i)) else + if rnd = 5 then ((fn i => char_gen i)) else + if rnd = 6 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf) i), i)) i)) else + ((fn i => list_gen (int_gen(inf, inf)) i)) in res end (* @@ -355,10 +377,12 @@ ts: list of generators - used to generate values for fields CORE FUNCTIONALITY - a -------------------------------- *) - fun core_forall (generators, prop, 0, size, pre, cap, pid) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} - |core_forall (generators, prop, i, size, pre, cap, pid) = - let val (args, sequences) = foldl (fn (x, (arg_acc, seq_acc)) => - let val arg = x pid size + fun core_forall (generators, prop, 0, size, pre, cap) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} + |core_forall (generators, prop, i, size, pre, cap) = + let val _ = send(rng_producer, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val (args, sequences) = foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x size val _ = send (pid, ("REQUEST_SEQ", self())) val seq = receive [hn x => x] in (append arg_acc [arg], append seq_acc [seq]) @@ -366,14 +390,14 @@ CORE FUNCTIONALITY - a in case pre of () => - if (apply_args prop args) then (write "."; core_forall (generators, prop, i-1, size+1, pre, cap, pid)) + if (apply_args prop args) then (write "."; core_forall (generators, prop, i-1, size+1, pre, cap)) else let val _ = write "!" in {failReason = "false_prop", ctx = args, ctx_seq = sequences, remTests = i, size = size} end | _ => if (apply_args pre args) then - if (apply_args prop args) then (write "."; core_forall (generators, prop, i-1, size+1, pre, cap, pid)) + if (apply_args prop args) then (write "."; core_forall (generators, prop, i-1, size+1, pre, cap)) else let val _ = write "!" in {failReason = "false_prop", ctx = args, ctx_seq = sequences, remTests = i, size = size} @@ -382,7 +406,7 @@ CORE FUNCTIONALITY - a let val _ = write "x" in if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) else if size = cap then {failReason = (), ctx = (), ctx_seq = (), remTests = i, size = size} - else core_forall (generators, prop, i, size+1, pre, cap, pid) + else core_forall (generators, prop, i, size+1, pre, cap) end end @@ -392,7 +416,9 @@ CORE FUNCTIONALITY - a (x,y) => (x,y) | x => (x, ()) val rng_recorder = spawn (fn() => rec_rng []) - val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5), rng_recorder) in + val _ = send (rng_producer, ("UPDATE_RNG", self(), rng_recorder)) + val _ = receive [hn x => ()] + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in case res.failReason of () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true |_ => @@ -408,8 +434,17 @@ CORE FUNCTIONALITY - a fun tc generator p = tc_n generator p 100 - fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) - | troupecheck generator p = spawn (fn() => tc generator p) + fun troupecheck props = + let val n = toString (length props) + fun tc_aux [] i = exit (authority, 0) + | tc_aux (x::xs) i = + let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") + val self_id = self() + val _ = spawn (fn () => let val res = x() in send(self_id, "done") end ) + val _ = receive [hn x => ()] + in tc_aux xs (i+1) end + in tc_aux props 1 + end (* -------------------------------- @@ -444,8 +479,8 @@ CONVENIENCE FUNCTIONS - s fun record ns ts = rec_gen ns ts - fun one_of ls pid = - let val idx = (int_gen (1, (length ls)) pid ((length ls))) + fun one_of ls = + let val idx = (int_gen (1, (length ls)) ((length ls))) in (nth ls idx) end @@ -488,10 +523,10 @@ FUNCTIONS FOR TESTING - d if length xs < 10 then append [x] xs else xs - fun one_of_two (x, y) pid size = - let val bool = (bool_gen pid size) in - if bool then x pid size - else y pid size end + fun one_of_two (x, y) size = + let val bool = (bool_gen size) in + if bool then x size + else y size end fun bad_half n = if n > 10 then n else n/2 @@ -514,8 +549,7 @@ PROPERTIES FOR TESTING - f reverse(reverse xs) = xs fun int_gen_stays_in_interval i = - let val pid = spawn (fn() => rec_rng []) in - (integer(0, i) pid i) <= i end + (integer(0, i) i) <= i fun abs_value_is_always_pos i = abs_value i >= 0 @@ -527,9 +561,8 @@ PROPERTIES FOR TESTING - f my_length xs = length xs fun make_list_test i = - let val pid = spawn (fn() => rec_rng []) - val generator = generator_gen pid i - fun f() = generator (int_gen(0, inf) pid i) + let val generator = generator_gen i + fun f() = generator (int_gen(0, inf) i) val ls = (make_list (f, i)) in (length ls) = i end @@ -698,82 +731,82 @@ CUSTOM TYPE PROGRAM append (map optimize_stmt stmts) [optimize_exp exp] end - fun exp_gen ls nesting_level pid size = + fun exp_gen ls nesting_level size = let val exp_ts = if nesting_level = 2 then ["num"] else (if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["var", "num", "add", "sub", "mul", "div"]) - val exp_type = one_of exp_ts pid + val exp_type = one_of exp_ts in case exp_type of "num" => - let val value = int_gen(1, inf) pid size in + let val value = int_gen(1, inf) size in ("num", value) end | "var" => - let val value = one_of ls pid in + let val value = one_of ls in ("var", value) end |"add" => - let val e1 = exp_gen ls (nesting_level+1) pid size - val e2 = exp_gen ls (nesting_level+1) pid size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size in ("add", e1, e2) end |"sub" => - let val e1 = exp_gen ls (nesting_level+1) pid size - val e2 = exp_gen ls (nesting_level+1) pid size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size in ("sub", e1, e2) end |"mul" => - let val e1 = exp_gen ls (nesting_level+1) pid size - val e2 = exp_gen ls (nesting_level+1) pid size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size in ("mul", e1, e2) end |"div" => - let val e1 = exp_gen ls (nesting_level+1) pid size - val e2 = exp_gen ls (nesting_level+1) pid size + let val e1 = exp_gen ls (nesting_level+1) size + val e2 = exp_gen ls (nesting_level+1) size in ("div", e1, e2) end end - fun assign_stmt_gen ls pid size = - let val n = string_gen pid size - val exp = exp_gen ls 0 pid size + fun assign_stmt_gen ls size = + let val n = string_gen size + val exp = exp_gen ls 0 size in ("assign", n, exp) end - fun print_stmt_gen ls pid size = - let val exp = exp_gen ls 0 pid size + fun print_stmt_gen ls size = + let val exp = exp_gen ls 0 size in ("print", exp) end - fun stmt_gen ls pid size = - let val stmt = one_of ["print", "assign"] pid + fun stmt_gen ls size = + let val stmt = one_of ["print", "assign"] in case stmt of "assign" => - let val res = assign_stmt_gen ls pid size in + let val res = assign_stmt_gen ls size in res end |"print" => - let val res = print_stmt_gen ls pid size in + let val res = print_stmt_gen ls size in res end end - fun program_gen pid size = - let val num_of_insts = (int_gen(0, size) pid size) + fun program_gen size = + let val num_of_insts = (int_gen(0, size) size) fun prog_gen_aux env p 0 = (p, env) | prog_gen_aux env p i = - let val stmt = stmt_gen env pid size + let val stmt = stmt_gen env size val newEnv = if stmt.0 = "assign" then (append [stmt.1] env) else env in prog_gen_aux newEnv (append p [stmt]) (i-1) end val (prog_stmts, last_env) = prog_gen_aux [] [] num_of_insts - val last_exp = exp_gen last_env 0 pid size + val last_exp = exp_gen last_env 0 size val prog = append prog_stmts [last_exp] in prog @@ -788,15 +821,21 @@ CUSTOM TYPE PROGRAM val seq = [[267780, 689125, 203803, 618600, 22142, 181797, 268993, 783974, 286438, 440154, 781712, 459460, 962769, 482855, 159926, 418551, 984104, 173034, 540674, 927189, 212169, 718086, 733167, 861479, 102743, 728028, 756405, 33167, 172289, 326962, 170851, 63613, 658659, 592355, 200373, 681450, 464463, 768613, 97359, 366897, 55000, 954642, 56192, 93387, 705644, 488085, 826189, 891989, 524325, 313064, 412008, 797972, 892377, 369868, 883008, 361089, 787380, 821443, 346419, 250197, 301447, 111385, 402424, 327486, 119693, 135341]] val size = 11 + + fun prop_bad_insert() = tc [list(integer()), integer()] test_bad_insert + fun prop_bad_half() = tc [integer()] (test_bad_half, (fn x => x >= 15)) + fun prop_record_shrink() = tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test + fun prop_program_shrink() = tc [program_gen] test_prog_shrink + fun prop_not_satisfied() = tc [boolean(), boolean()] bool_commutative in -(* integrated_shrink seq [program_gen] test_prog_shrink () size 0; *) +troupecheck [prop_bad_insert, prop_bad_half, prop_not_satisfied, prop_record_shrink, prop_program_shrink] -tc [list(integer()), integer()] test_bad_insert; +(* tc [list(integer()), integer()] test_bad_insert; tc [integer()] (test_bad_half, (fn x => x >= 15)); tc [string(), string()] (append_always_longer, lengths_not_same); tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; -tc [program_gen] test_prog_shrink; +tc [program_gen] test_prog_opt; *) (* for_i (fn() => tc [program_gen] test_prog_shrink) 50 *) (* tc [program_gen] test_prog_shrink *) @@ -850,5 +889,4 @@ write "Testing on my_ceil_2:"; tc [float()] my_ceil_2_test; write "Testing on both ceil functions:"; tc [float()] both_ceil_test *) -exit (authority, 0) end \ No newline at end of file From 4d8dad2f18325b5794412fd323efc53ffb49bf1e Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 25 Apr 2024 14:29:33 +0200 Subject: [PATCH 070/121] Some comments updated and tc_n removed (tc now takes a tuple of either 2 or 3 elements as argument) Co-authored-by: Selma --- troupecheck/integrated_shrinking.trp | 165 ++++++++++++++++----------- 1 file changed, 101 insertions(+), 64 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 60144c1..47a8150 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -1,19 +1,26 @@ import lists (* -------------------------------- -PRINTING TO CONSOLE - q +PRINTING TO CONSOLE + +Simple functions for more convenient printing to console. + -------------------------------- *) let val out = getStdout authority fun write x = fwrite (out, x) - (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) + + fun args_toString args = let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) | aux_toString acc (x::xs) = acc ^ (toString x) in aux_toString "" args end (* -------------------------------- -ERROR HANDLING - w +ERROR HANDLING + +Handles the printing of appropriate error messages for errors that may occur in the use of TroupeCheck. + -------------------------------- *) fun report_error error_reason = @@ -39,7 +46,10 @@ ERROR HANDLING - w if (getType p)<>"function" then report_error ("type_mismatch", 0) else () (* -------------------------------- -UTILS - e +UTILS + +Different utility functions that are used across the library. + -------------------------------- *) fun remove_nth n [] i = [] @@ -55,11 +65,10 @@ UTILS - e fun abs_value x = if x < 0 then -x else x -(* applies the list of arguments to the property - one by one - reporting errors along the way *) (* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l = case l of - [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) + [] => boolean_check (p()); p() (* this case is only reached if there are no generators to begin with *) | (x::xs) => let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in boolean_check res; @@ -74,6 +83,7 @@ UTILS - e aux xs (append acc [x]) end in aux s [] end + (* Combines a list of individual strings to a single string *) fun list_to_string ls = foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls @@ -94,6 +104,7 @@ UTILS - e aux {} names vals end + (* Hardcoded until a tuple from list function is implemented in Troupe - an issue has been raised on GH.*) fun build_tuple ls = case ls of [] => (0) @@ -108,9 +119,52 @@ UTILS - e |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) |_ => (2, 3, 4, 5) + + fun dec_nth list idx = + let fun dec_nth_aux [] acc i = acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => + let val dec_val = if x-1 <= 0 then 0 else floor (x/2) in + dec_nth_aux xs (append acc [dec_val]) (i+1) end + | false => dec_nth_aux xs (append acc [x]) (i+1) + in + dec_nth_aux list [] 0 end + + fun dec_all seq = + let fun dec_all_aux [] i = [] + | dec_all_aux (x::xs) i = + if x = 0 then + dec_all_aux xs (i+1) + else + append [(fn () => (dec_nth seq i))] [fn () => dec_all_aux xs (i+1)] in + dec_all_aux seq 0 end + + fun seqs_of_seq sequence lengths = + let fun aux seq acc 0 = (acc, seq) + | aux (x::xs) acc n = + aux xs (append acc [x]) (n-1) in + (foldl (fn (x,(acc, s)) => + let val (curr_acc, curr_seq) = aux s [] x in + (append acc [curr_acc], curr_seq) end)([], sequence) lengths).0 end + + fun cutoff_at list idx = + let fun aux ls acc 0 = acc + | aux (x::xs) acc i = + aux xs (append acc [x]) (i-1) in + aux list [] idx end (* -------------------------------- -SHRINKING - r +SHRINKING + +Works by first using random shrinking when a failing example has been found (shrink & random_shrink_aux). +Random shrinking means simply generating new test cases with gradually smaller size, to find a case smaller than the original one. This rarely produces a minmal result. +The smallest randomly shrunk instance is then further shrunk using integrated shrinking. (integrated_shrink & shrink_aux) +Integrated shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. + +This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (produce_rng, rc_rng & rep_rng). +All of these functions are spawned and then requests or updates may be send to them, so that the correct RNG's are used at different points in the code. + -------------------------------- *) fun produce_rng rng = @@ -154,40 +208,6 @@ SHRINKING - r hn ("UPDATE_LS", new_ls) => rep_rng new_ls] - fun dec_nth list idx = - let fun dec_nth_aux [] acc i = acc - | dec_nth_aux (x::xs) acc i = - case i = idx of - true => - let val dec_val = if x-1 <= 0 then 0 else floor (x/2) in - dec_nth_aux xs (append acc [dec_val]) (i+1) end - | false => dec_nth_aux xs (append acc [x]) (i+1) - in - dec_nth_aux list [] 0 end - - fun dec_all seq = - let fun dec_all_aux [] i = [] - | dec_all_aux (x::xs) i = - if x = 0 then - dec_all_aux xs (i+1) - else - append [(fn () => (dec_nth seq i))] [fn () => dec_all_aux xs (i+1)] in - dec_all_aux seq 0 end - - fun seqs_of_seq sequence lengths = - let fun aux seq acc 0 = (acc, seq) - | aux (x::xs) acc n = - aux xs (append acc [x]) (n-1) in - (foldl (fn (x,(acc, s)) => - let val (curr_acc, curr_seq) = aux s [] x in - (append acc [curr_acc], curr_seq) end)([], sequence) lengths).0 end - - fun cutoff_at list idx = - let fun aux ls acc 0 = acc - | aux (x::xs) acc i = - aux xs (append acc [x]) (i-1) in - aux list [] idx end - fun shrink_aux seqs gens lengths prop pre size counter = let val _ = send(rng_producer, ("REQUEST_RNG", self())) val pid = receive [hn x => x] @@ -277,22 +297,36 @@ SHRINKING - r integrated_shrink (res.sequences) generators prop pre res.size (res.count) end (* -------------------------------- -GENERATORS - t +GENERATORS + +Contains generators for Troupe's built-in types. All generators must return a single instance of the type they generate, +and take a 'size' argument as the very last argument. +This size will be given to all generators in the generation of test cases (and shrinking). +Generators that take more arguments, will need to have these passed along to them before passing the generator to the testing facilities +(convenience functions for this are supplied later). + +It is recommended that all user defined generators only make use of pre-defined generators or their matching convenience functions +for random decisions (i.e. a call to float_gen/float() or int_gen/integer()), instead of having to send and receive the correct messages to the RNG threads. +However, it can be done if the users wishes to and understands what is going on. + -------------------------------- *) - (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) - (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) fun float_gen (low, high) size = let val _ = send (rng_producer, ("REQUEST_RNG", self())) val pid = receive [hn x => x] + val _ = send (pid, ("REQUEST_RND", self())) val x = receive [hn x => x] + val _ = send (pid, ("REQUEST_RND", self())) val bool_int = receive [hn x => x] + val bool = bool_int < 1000000/2 val float_of_x = x/1000000 + val lInf = low = 1/0 (* check for inf *) val hInf = high = 1/0 + val res = case (lInf, hInf) of (true, true) => if bool then float_of_x * size else -float_of_x * size @@ -321,7 +355,6 @@ GENERATORS - t end (* NOTE: Generates only letters (upper and lower case) and numbers. *) - (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) fun char_gen size = let val chars = ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", @@ -333,23 +366,22 @@ GENERATORS - t in nth chars x end -(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) fun string_gen size = let val char_ls = list_gen (char_gen) size val string = list_to_string char_ls in string end -(* NOTE: Hardcoded for tuple of up to 10 elements *) + (* ts: list of generators - used to generate values for fields *) + (* NOTE: Hardcoded for tuple of up to 10 elements - see build_tuple in 'UTILS' *) fun tuple_gen ts size = let val ts_vals = map (fn x => x size) ts in build_tuple ts_vals end -(* -ns: list of strings - will be used as fieldnames -ts: list of generators - used to generate values for fields -*) + (* ns: list of strings - will be used as fieldnames *) + (* ts: list of generators - used to generate values for fields *) fun rec_gen ns ts size = if (length ns) <> (length ts) then report_error ("record_mismatch", 0) @@ -359,7 +391,7 @@ ts: list of generators - used to generate values for fields in res end - + (* TODO: needs to be completed... *) fun generator_gen size = let val rnd = int_gen (1,7) size val inf = 1/0 @@ -374,7 +406,10 @@ ts: list of generators - used to generate values for fields (* -------------------------------- -CORE FUNCTIONALITY - a +CORE FUNCTIONALITY + +Handles running the tests (core_forall), shrinking, preparing the recorder RNG and reporting the results to the user (tc). + -------------------------------- *) fun core_forall (generators, prop, 0, size, pre, cap) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} @@ -410,7 +445,8 @@ CORE FUNCTIONALITY - a end end - fun tc_n generators p noOfTests = + fun tc (generators, p) = tc (generators, p, 100) + | tc (generators, p, noOfTests) = let val (prop, pre) = case p of (x,y) => (x,y) @@ -432,7 +468,7 @@ CORE FUNCTIONALITY - a end end - fun tc generator p = tc_n generator p 100 + (* fun tc generator p = tc_n generator p 100 *) fun troupecheck props = let val n = toString (length props) @@ -448,7 +484,7 @@ CORE FUNCTIONALITY - a (* -------------------------------- -CONVENIENCE FUNCTIONS - s +CONVENIENCE FUNCTIONS -------------------------------- *) val inf = 1 / 0 @@ -648,10 +684,10 @@ TC^2 - z -------------------------------- *) fun tc_sort_length_always_fails () = - tc [list(integer())] my_sort_keep_length = false + tc ([list(integer())], my_sort_keep_length) = false fun tc_sort_ordered_always_true () = - tc [list(integer())] my_sort_is_ordered = true + tc ([list(integer())], my_sort_is_ordered) = true (* -------------------------------- @@ -822,14 +858,15 @@ CUSTOM TYPE PROGRAM val seq = [[267780, 689125, 203803, 618600, 22142, 181797, 268993, 783974, 286438, 440154, 781712, 459460, 962769, 482855, 159926, 418551, 984104, 173034, 540674, 927189, 212169, 718086, 733167, 861479, 102743, 728028, 756405, 33167, 172289, 326962, 170851, 63613, 658659, 592355, 200373, 681450, 464463, 768613, 97359, 366897, 55000, 954642, 56192, 93387, 705644, 488085, 826189, 891989, 524325, 313064, 412008, 797972, 892377, 369868, 883008, 361089, 787380, 821443, 346419, 250197, 301447, 111385, 402424, 327486, 119693, 135341]] val size = 11 - fun prop_bad_insert() = tc [list(integer()), integer()] test_bad_insert - fun prop_bad_half() = tc [integer()] (test_bad_half, (fn x => x >= 15)) - fun prop_record_shrink() = tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test - fun prop_program_shrink() = tc [program_gen] test_prog_shrink - fun prop_not_satisfied() = tc [boolean(), boolean()] bool_commutative + fun prop_bad_insert() = tc ([list(integer()), integer()], test_bad_insert) + fun prop_bad_half() = tc ([integer()], (test_bad_half, (fn x => x >= 15))) + fun prop_record_shrink() = tc ([record ["theInteger", "theString"] [integer(), string()]], record_shrink_test) + fun prop_program_shrink() = tc ([program_gen], test_prog_shrink) + fun prop_not_satisfied() = tc ([boolean(), boolean()], bool_commutative) + fun prop_count_non_negative() = tc ([integer(), list(integer())], my_count_returns_non_negative_int, 1000) in -troupecheck [prop_bad_insert, prop_bad_half, prop_not_satisfied, prop_record_shrink, prop_program_shrink] +troupecheck [prop_bad_insert, prop_bad_half, prop_not_satisfied, prop_record_shrink, prop_program_shrink, prop_count_non_negative] (* tc [list(integer()), integer()] test_bad_insert; tc [integer()] (test_bad_half, (fn x => x >= 15)); From 027538d337e44832ea56693e1f313253666105d1 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 26 Apr 2024 14:12:45 +0200 Subject: [PATCH 071/121] changed name of "tc" function to "for_all" --- troupecheck/integrated_shrinking.trp | 143 ++++++++++++++++----------- 1 file changed, 85 insertions(+), 58 deletions(-) diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 47a8150..2649223 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -10,7 +10,6 @@ Simple functions for more convenient printing to console. let val out = getStdout authority fun write x = fwrite (out, x) - fun args_toString args = let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) | aux_toString acc (x::xs) = acc ^ (toString x) in @@ -153,6 +152,9 @@ Different utility functions that are used across the library. | aux (x::xs) acc i = aux xs (append acc [x]) (i-1) in aux list [] idx end + + fun for_i body 0 = body() + | for_i body to = body(); for_i body (to-1) (* -------------------------------- SHRINKING @@ -445,8 +447,8 @@ Handles running the tests (core_forall), shrinking, preparing the recorder RNG a end end - fun tc (generators, p) = tc (generators, p, 100) - | tc (generators, p, noOfTests) = + fun for_all (generators, p) = for_all (generators, p, 100) + | for_all (generators, p, noOfTests) = let val (prop, pre) = case p of (x,y) => (x,y) @@ -467,24 +469,25 @@ Handles running the tests (core_forall), shrinking, preparing the recorder RNG a false end end - - (* fun tc generator p = tc_n generator p 100 *) fun troupecheck props = let val n = toString (length props) - fun tc_aux [] i = exit (authority, 0) - | tc_aux (x::xs) i = + fun troupecheck_aux [] i = exit (authority, 0) + | troupecheck_aux (x::xs) i = let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") val self_id = self() val _ = spawn (fn () => let val res = x() in send(self_id, "done") end ) val _ = receive [hn x => ()] - in tc_aux xs (i+1) end - in tc_aux props 1 + in troupecheck_aux xs (i+1) end + in troupecheck_aux props 1 end (* -------------------------------- -CONVENIENCE FUNCTIONS +CONVENIENCE FUNCTIONS + +These are functions that make it easier for the user to make use of the different generators, and define their own generators. + -------------------------------- *) val inf = 1 / 0 @@ -522,7 +525,10 @@ CONVENIENCE FUNCTIONS end (* -------------------------------- -FUNCTIONS FOR TESTING - d +FUNCTIONS FOR TESTING + +These functions exist only to define some test properties later, which are used in the development of TroupeCheck, to make sure it works as expected. + -------------------------------- *) fun my_reverse xs = @@ -572,7 +578,10 @@ FUNCTIONS FOR TESTING - d (* -------------------------------- -PROPERTIES FOR TESTING - f +PROPERTY FUNCTIONS FOR TESTING + +See 'FUNCTIONS FOR TESTING'. + -------------------------------- *) fun bool_commutative x y = @@ -641,7 +650,23 @@ PROPERTIES FOR TESTING - f (* -------------------------------- -USED FOR USERGUIDE - g +PROPERTIES FOR TESTING + +see 'FUNCTIONS FOR TESTING'. + +-------------------------------- + *) + fun prop_bad_insert() = for_all ([list(integer()), integer()], test_bad_insert) + fun prop_bad_half() = for_all ([integer()], (test_bad_half, (fn x => x >= 15))) + fun prop_record_shrink() = for_all ([record ["theInteger", "theString"] [integer(), string()]], record_shrink_test) + fun prop_not_satisfied() = for_all ([boolean(), boolean()], bool_commutative) + fun prop_count_non_negative() = for_all ([integer(), list(integer())], my_count_returns_non_negative_int, 1000) +(* +-------------------------------- +USED FOR USERGUIDE + +Functions used for demonstrating how to use TroupeCheck in the userguide. + -------------------------------- *) fun filter_less ([], _) = [] @@ -678,20 +703,32 @@ USED FOR USERGUIDE - g fun cons_length_increase xs x = (length (x::xs)) = ((length xs) + 1) + + (* -------------------------------- -TC^2 - z +TC^2 + +Functions for testing TroupeCheck using TroupeCheck. + -------------------------------- *) fun tc_sort_length_always_fails () = - tc ([list(integer())], my_sort_keep_length) = false + for_all ([list(integer())], my_sort_keep_length) = false fun tc_sort_ordered_always_true () = - tc ([list(integer())], my_sort_is_ordered) = true + for_all ([list(integer())], my_sort_is_ordered) = true (* -------------------------------- CUSTOM TYPE PROGRAM + +Used for testing the creation of complex custom generators. +Here we defined an interpreter and generator for simple programs consisting of: +expr := ("num", number) |("var", string) |("add", expr, expr) |("sub", expr, expr) |("mul", expr, expr) |("div", expr, expr) +stmt := ("assign", string, expr) |("print", expr) +prog := [[stmt], expr] + -------------------------------- *) fun eval exp env = @@ -852,78 +889,68 @@ CUSTOM TYPE PROGRAM (interpret prog) = (interpret (optimize_prog prog)) fun test_prog_shrink prog = (interpret prog) < 100 - fun for_i body 0 = body() - | for_i body to = body(); for_i body (to-1) - - val seq = [[267780, 689125, 203803, 618600, 22142, 181797, 268993, 783974, 286438, 440154, 781712, 459460, 962769, 482855, 159926, 418551, 984104, 173034, 540674, 927189, 212169, 718086, 733167, 861479, 102743, 728028, 756405, 33167, 172289, 326962, 170851, 63613, 658659, 592355, 200373, 681450, 464463, 768613, 97359, 366897, 55000, 954642, 56192, 93387, 705644, 488085, 826189, 891989, 524325, 313064, 412008, 797972, 892377, 369868, 883008, 361089, 787380, 821443, 346419, 250197, 301447, 111385, 402424, 327486, 119693, 135341]] - val size = 11 + fun prop_program_shrink() = for_all ([program_gen], test_prog_shrink) - fun prop_bad_insert() = tc ([list(integer()), integer()], test_bad_insert) - fun prop_bad_half() = tc ([integer()], (test_bad_half, (fn x => x >= 15))) - fun prop_record_shrink() = tc ([record ["theInteger", "theString"] [integer(), string()]], record_shrink_test) - fun prop_program_shrink() = tc ([program_gen], test_prog_shrink) - fun prop_not_satisfied() = tc ([boolean(), boolean()], bool_commutative) - fun prop_count_non_negative() = tc ([integer(), list(integer())], my_count_returns_non_negative_int, 1000) in troupecheck [prop_bad_insert, prop_bad_half, prop_not_satisfied, prop_record_shrink, prop_program_shrink, prop_count_non_negative] -(* tc [list(integer()), integer()] test_bad_insert; -tc [integer()] (test_bad_half, (fn x => x >= 15)); -tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; -tc [program_gen] test_prog_opt; *) +(* for_all [list(integer()), integer()] test_bad_insert; +for_all [integer()] (test_bad_half, (fn x => x >= 15)); +for_all [string(), string()] (append_always_longer, lengths_not_same); +for_all [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; +for_all [program_gen] test_prog_opt; *) -(* for_i (fn() => tc [program_gen] test_prog_shrink) 50 *) -(* tc [program_gen] test_prog_shrink *) +(* for_i (fn() => for_all [program_gen] test_prog_shrink) 50 *) +(* for_all [program_gen] test_prog_shrink *) (* -------------------------------- ALL TESTS - x -------------------------------- *) -(* tc [integer(), integer()] number_commutative *) +(* for_all [integer(), integer()] number_commutative *) (* shrinking tests - x *) -(* tc [list(integer()), integer()] test_bad_insert; -tc [integer()] (test_bad_half, (fn x => x >= 15)); -tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; *) +(* for_all [list(integer()), integer()] test_bad_insert; +for_all [integer()] (test_bad_half, (fn x => x >= 15)); +for_all [string(), string()] (append_always_longer, lengths_not_same); +for_all [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; *) (* tc^2 tests *) -(* tc [] tc_sort_ordered_always_true; *) +(* for_all [] tc_sort_ordered_always_true; *) (* User guide tests *) -(* tc [list(integer()), integer()] cons_length_increase; -tc [list(integer())] my_sort_is_ordered; -tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates) *) +(* for_all [list(integer()), integer()] cons_length_increase; +for_all [list(integer())] my_sort_is_ordered; +for_all [list(integer())] my_sort_keep_length; +for_all [list(integer())] (my_sort_keep_length, no_duplicates) *) (* General functionality tests *) -(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; -tc [] no_args; -tc [integer(), integer(), integer(), integer()] tup_test; +(* for_all [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; +for_all [] no_args; +for_all [integer(), integer(), integer(), integer()] tup_test; write "\nTesting on bools commutative:"; -tc [boolean(), boolean()] bool_commutative; +for_all [boolean(), boolean()] bool_commutative; write "\nTesting on numbers commutative:"; -tc [integer(), integer()] number_commutative; +for_all [integer(), integer()] number_commutative; write "\nTesting on list reverse:"; -tc [list(integer())] list_reverse; +for_all [list(integer())] list_reverse; write "\nTesting on int_gen interval:"; -tc [integer()] (int_gen_stays_in_interval, pre_pos); +for_all [integer()] (int_gen_stays_in_interval, pre_pos); write "\nTesting on abs_value:"; -tc [one_of_two (integer(), float())] abs_value_is_always_pos; +for_all [one_of_two (integer(), float())] abs_value_is_always_pos; write "\nTesting on my_floor:"; -tc [float()] my_floor_test; +for_all [float()] my_floor_test; write "\nTesting that my_count always return non-negative result:"; tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; write "\nTesting my_length:"; -tc [list(integer())] my_length_test; +for_all [list(integer())] my_length_test; write "\nTesting make_list:"; -tc [pos_integer()] make_list_test; +for_all [pos_integer()] make_list_test; write "Testing on my_ceil_1:"; -tc [float()] my_ceil_1_test; +for_all [float()] my_ceil_1_test; write "Testing on my_ceil_2:"; -tc [float()] my_ceil_2_test; +for_all [float()] my_ceil_2_test; write "Testing on both ceil functions:"; -tc [float()] both_ceil_test *) +for_all [float()] both_ceil_test *) end \ No newline at end of file From 644c47e0e262d5d80e27a65de9583167aba06831 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 1 May 2024 13:09:31 +0200 Subject: [PATCH 072/121] Battleship work begun Co-authored-by: Selma --- troupecheck/battleship.trp | 71 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) create mode 100644 troupecheck/battleship.trp diff --git a/troupecheck/battleship.trp b/troupecheck/battleship.trp new file mode 100644 index 0000000..97de564 --- /dev/null +++ b/troupecheck/battleship.trp @@ -0,0 +1,71 @@ +import lists + +let fun write x = + fwrite ((getStdout authority), x) + + fun make_list (f, i) = + case i of + 0 => [] + | _ => append (make_list (f, i-1)) [f i] + + fun bound_from_ship ship = + case ship of + "C" => 5 + | "B" => 4 + | "S" => 3 + | "D" => 2 + + fun place_ship board_or_error coordinate = + case getType board_or_error of + "string" => board_or_error + | _ => + let fun place_horizontal (x, y) ship_type board = + let val y_ls = nth board y + val upperbound = x + (bound_from_ship ship_type) + val is_valid = (x >= 1) andalso (upperbound <= 11) + in if is_valid then + let val new_y = make_list ((fn i => if (i >= x) andalso (i < upperbound) then ship_type else (nth y_ls i)), 10) + val new_board = make_list ((fn i => if i = y then new_y else (nth board i)), 10) + in new_board + end + else + ("Invalid coordinates for ship of type: " ^ ship_type) + end + + fun place_vertical (x, y) ship_type board = + let val upperbound = y + (bound_from_ship ship_type) + val is_valid = (x >= 1) andalso (upperbound <= 11) + in if is_valid then + let val new_board = make_list ((fn i => + if i >= y andalso i < upperbound then + make_list ((fn j => if j = x then ship_type else nth (nth board i) j), 10) + else nth board i), 10) + in new_board + end + else + ("Invalid coordinates for ship of type: " ^ ship_type) + end + val ((x,y), direction, ship) = coordinate + in case direction of + "v" => place_vertical (x,y) ship board_or_error + | "h" => place_horizontal (x,y) ship board_or_error + end + + fun make_board ls = + let val start_board = make_list ((fn _ => make_list ((fn _ => "-"), 10)), 10) + val board = foldl (fn (x,y) => place_ship y x) start_board ls + in board + end + val c1 = ((1,1), "h", "C") + val c2 = ((1,2), "h", "B") + val c3 = ((10,1), "v", "S") + val c4 = ((9,1), "v", "S") + val c5 = ((9,10), "h", "D") + + fun print_board b = + foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b + + val board_test = make_board [c1, c2, c3, c4, c5] +in + print_board (board_test) +end \ No newline at end of file From 1cdd6a30470b601283e39ed6c20cdeec9011cf46 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 1 May 2024 17:45:28 +0200 Subject: [PATCH 073/121] do_attack and check_attack added --- troupecheck/battleship.trp | 38 +++++++++++++++++++++++++++++++++----- 1 file changed, 33 insertions(+), 5 deletions(-) diff --git a/troupecheck/battleship.trp b/troupecheck/battleship.trp index 97de564..8ac2b6f 100644 --- a/troupecheck/battleship.trp +++ b/troupecheck/battleship.trp @@ -3,6 +3,9 @@ import lists let fun write x = fwrite ((getStdout authority), x) + fun print_board b = + foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b + fun make_list (f, i) = case i of 0 => [] @@ -14,6 +17,8 @@ let fun write x = | "B" => 4 | "S" => 3 | "D" => 2 + | "X" => 1 + | "O" => 1 fun place_ship board_or_error coordinate = case getType board_or_error of @@ -56,16 +61,39 @@ let fun write x = val board = foldl (fn (x,y) => place_ship y x) start_board ls in board end + + fun check_attack board (x,y) = + if (x > 10) orelse (y > 10) orelse (x < 1) orelse (y < 1) then "Illegal corrdinate" + else + let val coord = nth (nth board y) x + in case coord of + "-" => "Miss" + |"O" => "Illegal corrdinate" + |"X" => "Illegal corrdinate" + |_ => "Hit" + end + + fun do_attack board (x,y) = + case check_attack board (x,y) of + "Illegal corrdinate" => ("Illegal corrdinate", board) + | "Miss" => ("Miss", (place_ship board ((x,y), "h", "O"))) + | "Hit" => ("Hit", (place_ship board ((x,y), "h", "X"))) + val c1 = ((1,1), "h", "C") val c2 = ((1,2), "h", "B") val c3 = ((10,1), "v", "S") val c4 = ((9,1), "v", "S") val c5 = ((9,10), "h", "D") - fun print_board b = - foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b - - val board_test = make_board [c1, c2, c3, c4, c5] + val board_test = make_board [c1,c2,c3,c4,c5] + + val (att, new_board_test) = do_attack board_test (3,1) + val (att2, new_board_test2) = do_attack new_board_test (3,3) in - print_board (board_test) +print_board board_test; +write (att ^ "\n"); +print_board new_board_test; +write (att2 ^ "\n"); +print_board new_board_test2 + end \ No newline at end of file From 1f65f58006a959f6b2b790aedfe1af08e940af91 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 2 May 2024 14:40:44 +0200 Subject: [PATCH 074/121] troupecheck now works as a library file --- Makefile | 1 + lib/troupecheck.trp | 573 +++++++++++++++++++++++++++ troupecheck/integrated_shrinking.trp | 24 +- troupecheck/tc.trp | 4 +- 4 files changed, 599 insertions(+), 3 deletions(-) create mode 100644 lib/troupecheck.trp diff --git a/Makefile b/Makefile index 38490f2..422eb12 100644 --- a/Makefile +++ b/Makefile @@ -25,6 +25,7 @@ libs: $(COMPILER) ./lib/raft_debug.trp -l $(COMPILER) ./lib/bst.trp -l $(COMPILER) ./lib/localregistry.trp -l + $(COMPILER) ./lib/troupecheck.trp -l test: mkdir -p out diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp new file mode 100644 index 0000000..0bccdce --- /dev/null +++ b/lib/troupecheck.trp @@ -0,0 +1,573 @@ +import lists + +(* +-------------------------------- +INIT FUNCTION + +To be called when starting out testing + +-------------------------------- +*) +let fun init_tc auth rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in init_tc auth rng end, + + hn ("REQUEST_AUTH", senderid) => + let val _ = send (senderid, auth) + in init_tc auth rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + init_tc auth new_rng end] + +(* +-------------------------------- +PRINTING TO CONSOLE + +Simple functions for more convenient printing to console. + +-------------------------------- +*) + fun write x auth = + fwrite ((getStdout auth), x) + + fun args_toString args = + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x) in + aux_toString "" args end + +(* +-------------------------------- +ERROR HANDLING + +Handles the printing of appropriate error messages for errors that may occur in the use of TroupeCheck. + +-------------------------------- +*) + fun report_error error_reason tco = + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + | ("shrinking_looped", _) => "Shrinking looped.\n" + | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" + in + write "\u001B[31m \nError: " auth; (* Changing the print color to red *) + write (err_string ^ "\u001B[0m") auth; (* Changing the color back *) + exit (auth, 0) end + + fun boolean_check x tco = + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) tco else () + + fun function_not_done_check p tco = + if (getType p)<>"function" then report_error ("type_mismatch", 0) tco else () +(* +-------------------------------- +UTILS + +Different utility functions that are used across the library. + +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + + fun abs_value x = + if x < 0 then -x else x + +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l tco = + case l of + [] => boolean_check (p()) tco; p() (* this case is only reached if there are no generators to begin with *) + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l in + boolean_check res tco; + res + end + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + (* Combines a list of individual strings to a single string *) + fun list_to_string ls tco = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) tco else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) + + fun report_fail_reason rec noOfTests tco = + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] in + case rec.failReason of + "false_prop" => + write "\nFailure at input: " auth; + write (args_toString rec.ctx) auth; + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") auth + end + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + (* Hardcoded until a tuple from list function is implemented in Troupe - an issue has been raised on GH.*) + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) + + fun dec_nth list idx = + let fun dec_nth_aux [] acc i = acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => + let val dec_val = if x-1 <= 0 then 0 else floor (x/2) in + dec_nth_aux xs (append acc [dec_val]) (i+1) end + | false => dec_nth_aux xs (append acc [x]) (i+1) + in + dec_nth_aux list [] 0 end + + fun dec_all seq = + let fun dec_all_aux [] i = [] + | dec_all_aux (x::xs) i = + if x = 0 then + dec_all_aux xs (i+1) + else + append [(fn () => (dec_nth seq i))] [fn () => dec_all_aux xs (i+1)] in + dec_all_aux seq 0 end + + fun seqs_of_seq sequence lengths = + let fun aux seq acc 0 = (acc, seq) + | aux (x::xs) acc n = + aux xs (append acc [x]) (n-1) in + (foldl (fn (x,(acc, s)) => + let val (curr_acc, curr_seq) = aux s [] x in + (append acc [curr_acc], curr_seq) end)([], sequence) lengths).0 end + + fun cutoff_at list idx = + let fun aux ls acc 0 = acc + | aux (x::xs) acc i = + aux xs (append acc [x]) (i-1) in + aux list [] idx end + + fun for_i body 0 = body() + | for_i body to = body(); for_i body (to-1) +(* +-------------------------------- +SHRINKING + +Works by first using random shrinking when a failing example has been found (shrink & random_shrink_aux). +Random shrinking means simply generating new test cases with gradually smaller size, to find a case smaller than the original one. This rarely produces a minmal result. +The smallest randomly shrunk instance is then further shrunk using integrated shrinking. (integrated_shrink & shrink_aux) +Integrated shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. + +This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (produce_rng, rc_rng & rep_rng). +All of these functions are spawned and then requests or updates may be send to them, so that the correct RNG's are used at different points in the code. + +-------------------------------- +*) + fun produce_rng rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in produce_rng rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + produce_rng new_rng end] + + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = floor (random()*1000000) + val _ = send (senderid, rnd) + in rec_rng (append ls [rnd]) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, ls) + in rec_rng [] + end] + + fun rep_rng ls = + receive [hn ("REQUEST_RND", senderid) => + case ls of + (x::xs) => + let val _ = send (senderid, x) + in rep_rng xs + end + | [] => + let val _ = send (senderid, 0) + in rep_rng ls + end, + hn ("REQUEST_LEFT", senderid) => + let val _ = send (senderid, ls) + in rep_rng [] + end, + hn ("UPDATE_LS", new_ls) => + rep_rng new_ls] + + fun shrink_aux seqs gens lengths prop pre size counter tco = + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + in case seqs of + (x1::x2::x3::xs) => + let val seqs_of_curr = seqs_of_seq (x2()) lengths + val args_and_leftovers = mapi (fn (i, x) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = x tco size + val _ = send (pid, ("REQUEST_LEFT", self())) + val left_overs = receive [hn x => x] + in (arg, left_overs) + end) gens + + val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.0], append left_overs [x.1])) ([],[]) args_and_leftovers + val ret_seqs = mapi (fn (i,x) => + if (length x) = 0 then (nth seqs_of_curr (i+1)) + else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs + val precond_is_met = if (pre <> ()) then (apply_args pre test_args tco) else true + in + case (apply_args prop test_args tco) orelse (precond_is_met = false) of + true => shrink_aux (x1::x3()) gens lengths prop pre size counter tco + | false => integrated_shrink ret_seqs gens prop pre size (counter+1) tco + end + | (x::xs) => + let val seqs_of_curr = seqs_of_seq (x()) lengths + val test_args = mapi (fn (i, y) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y tco size + in arg end) gens + val precond_is_met = if (pre <> ()) then (apply_args pre test_args tco) else true + in + case (apply_args prop test_args tco) orelse (precond_is_met = false) orelse (size < 0) of + true => + let val res = mapi (fn (i, y) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y tco (size+1) + in arg end) gens in + {shrunk_ctx = res, count = counter} end + | false => shrink_aux [x] gens lengths prop pre (size-1) counter tco + + end + end + + and integrated_shrink sequences gens prop pre size counter tco = + let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences + in + if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then + shrink_aux [seqs_comb] gens seq_lengths prop pre size counter tco + else + let val decreased_seqs = dec_all seqs_comb + val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs + val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) tco + in + res end + end + + fun random_shrink_aux sequences generators prop pre success size counter tco = + if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val new_size = size-1 + val (shrunk_args, shrunk_sequences) = + foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x tco new_size + val _ = send (pid, ("REQUEST_SEQ", self())) + val seq = receive [hn x => x] + in (append arg_acc [arg], append seq_acc [seq]) + end) ([],[]) generators + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true + in + case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of + true => random_shrink_aux sequences generators prop pre success size (counter+1) tco + | false => + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) tco + end + + fun shrink sequence generators prop pre size counter tco = + let val rng_recorder = spawn (fn() => rec_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) + val _ = receive [hn x => ()] + val res = random_shrink_aux sequence generators prop pre 0 size counter tco + val rng_replayer = spawn (fn() => rep_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) + val _ = receive [hn x => ()] + in + integrated_shrink (res.sequences) generators prop pre res.size (res.count) tco end +(* +-------------------------------- +GENERATORS + +Contains generators for Troupe's built-in types. All generators must return a single instance of the type they generate, +and take a 'size' argument as the very last argument. +This size will be given to all generators in the generation of test cases (and shrinking). +Generators that take more arguments, will need to have these passed along to them before passing the generator to the testing facilities +(convenience functions for this are supplied later). + +It is recommended that all user defined generators only make use of pre-defined generators or their matching convenience functions +for random decisions (i.e. a call to float_gen/float() or int_gen/integer()), instead of having to send and receive the correct messages to the RNG threads. +However, it can be done if the users wishes to and understands what is going on. + +-------------------------------- +*) + fun float_gen (low, high) tco size = + let val _ = send (tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + + val _ = send (pid, ("REQUEST_RND", self())) + val x = receive [hn x => x] + + val _ = send (pid, ("REQUEST_RND", self())) + val bool_int = receive [hn x => x] + + val bool = bool_int < (1000000/2) + val float_of_x = x/1000000 + + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + + val res = + case (lInf, hInf) of + (true, true) => if bool then float_of_x * size else -float_of_x * size + | (true, false) => high - (float_of_x * size) + | (false, true) => low + (float_of_x * size) + | (false, false) => low + (float_of_x * (high-low)) + in res + end + + fun int_gen (low, high) tco size = + let val res = floor (float_gen (low, high+1) tco size) + in res + end + + fun bool_gen tco size = + let val rnd = int_gen (0,1) tco size + val res = if rnd = 0 then false + else true + in res + end + + fun list_gen (generator) tco size = + let val length = (int_gen (0, size) tco size) + val res = make_list ((fn () => generator tco size), length) + in res + end + + (* NOTE: Generates only letters (upper and lower case) and numbers. *) + fun char_gen tco size = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = (int_gen (1, ((length chars)-1)) tco size) + in nth chars x + end + + (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + fun string_gen tco size = + let val char_ls = list_gen (char_gen) tco size + val string = list_to_string char_ls tco + in string + end + + (* ts: list of generators - used to generate values for fields *) + (* NOTE: Hardcoded for tuple of up to 10 elements - see build_tuple in 'UTILS' *) + fun tuple_gen ts tco size = + let val ts_vals = map (fn x => x tco size) ts + in build_tuple ts_vals + end + + (* ns: list of strings - will be used as fieldnames *) + (* ts: list of generators - used to generate values for fields *) + fun rec_gen ns ts tco size = + if (length ns) <> (length ts) then + report_error ("record_mismatch", 0) tco + else + let val ts_vals = map (fn x => x size) ts + val res = build_record ns ts_vals + in res + end + + (* TODO: needs to be completed... *) + fun generator_gen tco size = + let val rnd = int_gen (1,7) size + val inf = 1/0 + val res = if rnd = 1 then ((fn i => int_gen (inf, inf) tco i)) else + if rnd = 2 then ((fn i => bool_gen tco i)) else + if rnd = 3 then ((fn i => float_gen (inf, inf) tco i)) else + if rnd = 4 then ((fn i => string_gen tco i)) else + if rnd = 5 then ((fn i => char_gen tco i)) else + if rnd = 6 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf) tco i), i)) tco i)) else + ((fn i => list_gen (int_gen(inf, inf)) tco i)) in + res end + +(* +-------------------------------- +CORE FUNCTIONALITY + +Handles running the tests (core_forall), shrinking, preparing the recorder RNG and reporting the results to the user (tc). + +-------------------------------- +*) + fun core_forall (generators, prop, 0, size, pre, cap, tco) = {failReason = (), ctx = (), ctx_seq = (), remTests = 0, size = size} + |core_forall (generators, prop, i, size, pre, cap, tco) = + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + val (args, sequences) = foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x tco size + val _ = send (pid, ("REQUEST_SEQ", self())) + val seq = receive [hn x => x] + in (append arg_acc [arg], append seq_acc [seq]) + end) ([],[])generators + in + case pre of + () => + if (apply_args prop args tco) then (write "." auth; core_forall (generators, prop, i-1, size+1, pre, cap, tco)) + else + let val _ = write "!" auth + in {failReason = "false_prop", ctx = args, ctx_seq = sequences, remTests = i, size = size} + end + | _ => + if (apply_args pre args tco) then + if (apply_args prop args tco) then (write "." auth; core_forall (generators, prop, i-1, size+1, pre, cap, tco)) + else + let val _ = write "!" auth + in {failReason = "false_prop", ctx = args, ctx_seq = sequences, remTests = i, size = size} + end + else + let val _ = write "x" auth + in if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) tco + else if size = cap then {failReason = (), ctx = (), ctx_seq = (), remTests = i, size = size} + else core_forall (generators, prop, i, size+1, pre, cap, tco) + end + end + + fun for_all (generators, p) auth = for_all (generators, p, 100) auth + | for_all (generators, p, noOfTests) auth = + let val (prop, pre) = + case p of + (x,y) => (x,y) + | x => (x, ()) + val rng_recorder = spawn (fn() => rec_rng []) + val tco = spawn (fn() => init_tc auth rng_recorder) + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5), tco) in + case res.failReason of + () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n") auth; true + |_ => + report_fail_reason res noOfTests tco; + write ("\u001B[1m\u001B[34mShrinking\u001B[0m:") auth; + let val shrink_res = shrink res.ctx_seq generators prop pre res.size 0 tco in + write "\nFailing test case was shrunk to:\n" auth; + write (args_toString shrink_res.shrunk_ctx) auth; + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n") auth; + false + end + end + + fun troupecheck props auth = + let val n = toString (length props) + fun troupecheck_aux [] i = exit (auth, 0) + | troupecheck_aux (x::xs) i = + let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") auth + val self_id = self() + val _ = spawn (fn () => let val _ = (x() auth) in send(self_id, "done") end ) + val _ = receive [hn x => ()] + in troupecheck_aux xs (i+1) end + in troupecheck_aux props 1 + end + +(* +-------------------------------- +CONVENIENCE FUNCTIONS + +These are functions that make it easier for the user to make use of the different generators, and define their own generators. + +-------------------------------- +*) + val inf = 1 / 0 + fun integer () = int_gen(inf, inf) + | integer (h, l) = int_gen(h, l) + + fun pos_integer () = integer(0, inf) + + fun neg_integer () = integer(inf, -1) + + fun float () = float_gen(inf, inf) + | float (h, l) = float_gen(h, l) + + fun pos_float () = float(0, inf) + + fun neg_float () = float(inf, 0) + + fun boolean () = bool_gen + + fun list () = list_gen(generator_gen()) + |list (type) = list_gen(type) + + fun string () = string_gen + + fun char () = char_gen + + fun tuple ts = tuple_gen ts + + fun record ns ts = rec_gen ns ts + + fun one_of ls = + let val idx = (int_gen (1, (length ls)) ((length ls))) + in + (nth ls idx) + end +in + [ ("make_list", make_list) + , ("build_record", build_record) + , ("build_tuple", build_tuple) + , ("for_all", for_all) + , ("troupecheck", troupecheck) + , ("inf", inf) + , ("integer", integer) + , ("pos_integer", pos_integer) + , ("neg_integer", neg_integer) + , ("float", float) + , ("pos_float", pos_float) + , ("neg_float", neg_float) + , ("boolean", boolean) + , ("list", list) + , ("string", string) + , ("char", char) + , ("tuple", tuple) + , ("record", record) + , ("one_of", one_of) + ] +end diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/integrated_shrinking.trp index 2649223..d038814 100644 --- a/troupecheck/integrated_shrinking.trp +++ b/troupecheck/integrated_shrinking.trp @@ -323,7 +323,7 @@ However, it can be done if the users wishes to and understands what is going on. val _ = send (pid, ("REQUEST_RND", self())) val bool_int = receive [hn x => x] - val bool = bool_int < 1000000/2 + val bool = bool_int < (1000000/2) val float_of_x = x/1000000 val lInf = low = 1/0 (* check for inf *) @@ -704,6 +704,25 @@ Functions used for demonstrating how to use TroupeCheck in the userguide. fun cons_length_increase xs x = (length (x::xs)) = ((length xs) + 1) + fun list_no_duplicates (generator) size = + let val length = (integer(0, size) size) + fun no_dups_aux acc 0 = acc + | no_dups_aux acc i = + let val value = generator size + in if elem value acc + then no_dups_aux acc i + else no_dups_aux (value::acc) (i-1) + end + in no_dups_aux [] length + end + + fun is_ordered_prop() = for_all ([list(integer())], my_sort_is_ordered) + + fun keep_length_prop() = for_all ([list_no_duplicates(integer())], my_sort_keep_length) + + fun keep_length_fixed_prop() = for_all ([list(integer())], (my_sort_keep_length, no_duplicates)) + + fun length_increase_prop() = for_all ([list(integer()), integer()], cons_length_increase) (* -------------------------------- @@ -891,9 +910,10 @@ prog := [[stmt], expr] (interpret prog) < 100 fun prop_program_shrink() = for_all ([program_gen], test_prog_shrink) + in -troupecheck [prop_bad_insert, prop_bad_half, prop_not_satisfied, prop_record_shrink, prop_program_shrink, prop_count_non_negative] +troupecheck [keep_length_prop] (* for_all [list(integer()), integer()] test_bad_insert; for_all [integer()] (test_bad_half, (fn x => x >= 15)); diff --git a/troupecheck/tc.trp b/troupecheck/tc.trp index d18f90d..08b05a8 100644 --- a/troupecheck/tc.trp +++ b/troupecheck/tc.trp @@ -950,7 +950,9 @@ in ALL TESTS - x -------------------------------- *) -tc [program_gen] test_prog_opt + +tc [list(integer())] my_sort_keep_length +(* tc [program_gen] test_prog_opt *) (* shrinking tests - x *) (* tc [list(integer()), integer()] test_bad_insert; From a2a24fa3eca615b1335ee5ff98c69aee2990f537 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 2 May 2024 15:30:08 +0200 Subject: [PATCH 075/121] Created some test files and updated the library file --- lib/troupecheck.trp | 5 +- troupecheck/general-testing.trp | 174 ++++++++++++++++++++++++++++++++ troupecheck/userguide-tests.trp | 67 ++++++++++++ 3 files changed, 245 insertions(+), 1 deletion(-) create mode 100644 troupecheck/general-testing.trp create mode 100644 troupecheck/userguide-tests.trp diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 0bccdce..0387122 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -413,7 +413,7 @@ However, it can be done if the users wishes to and understands what is going on. if (length ns) <> (length ts) then report_error ("record_mismatch", 0) tco else - let val ts_vals = map (fn x => x size) ts + let val ts_vals = map (fn x => x tco size) ts val res = build_record ns ts_vals in res end @@ -540,6 +540,8 @@ These are functions that make it easier for the user to make use of the differen fun char () = char_gen + fun generator() = generator_gen + fun tuple ts = tuple_gen ts fun record ns ts = rec_gen ns ts @@ -566,6 +568,7 @@ in , ("list", list) , ("string", string) , ("char", char) + , ("generator", generator) , ("tuple", tuple) , ("record", record) , ("one_of", one_of) diff --git a/troupecheck/general-testing.trp b/troupecheck/general-testing.trp new file mode 100644 index 0000000..6a13509 --- /dev/null +++ b/troupecheck/general-testing.trp @@ -0,0 +1,174 @@ +import lists +import troupecheck +(* +-------------------------------- +FUNCTIONS FOR TESTING + +These functions exist only to define some test properties later, which are used in the development of TroupeCheck, to make sure it works as expected. + +-------------------------------- +*) +let fun my_reverse xs = + xs + + fun abs_value x = + if x < 0 then -x else x + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_length [] = 0 + | my_length (x::xs) = 1 + (my_length xs) + + fun my_count y [] = 0 + | my_count y (x::xs) = + let val z = + if y = x then 1 else 0 + in + z + my_count y xs end + + fun my_floor i = + if i >=0 then i - (i mod 1) + else i - (i mod 1) - 1 + + fun my_ceil1 i = + if i > 0 then i + (1 - (i mod 1)) + else i + (1 - (i mod 1)) - 1 + + fun my_ceil2 i = + if i > 0 then (my_floor i) + 1 + else if i = 0 then 0 + else (my_floor i) + 1 + + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs + + fun one_of_two (x, y) tco size = + let val bool = (boolean() tco size) in + if bool then x tco size + else y tco size end + + fun bad_half n = + if n > 10 then n else n/2 + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + fun string_length s = + length (string_to_list s) + + fun lengths_not_same s1 s2 = + (string_length s1) <> (string_length s2) + + + +(* +-------------------------------- +PROPERTY FUNCTIONS FOR TESTING + +See 'FUNCTIONS FOR TESTING'. + +-------------------------------- +*) + fun bool_commutative x y = + (x andalso y) = (y andalso x) + + fun number_commutative x y = + x * y <= 50 + + fun list_reverse xs = + reverse(reverse xs) = xs + + fun int_gen_stays_in_interval i = + i <= 50 + + fun abs_value_is_always_pos i = + abs_value i >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_length_test xs = + my_length xs = length xs + + fun make_list_test generator i = + let fun f() = generator i + val ls = (make_list (f, i)) in + (length ls) = i end + + fun my_count_returns_non_negative_int x xs = + (my_count x xs) >= 0 + + fun rec_test rec i = + {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} + + fun pre_pos x = + x >= 0 + + fun my_floor_test i = + my_floor i = floor i + + fun my_ceil1_test i = + my_ceil1 i = ceil i + + fun my_ceil2_test i = + my_ceil2 i = ceil i + + fun both_ceil_test i = + my_ceil1 i = my_ceil2 i + + fun shrink_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) + + fun no_args() = true + + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + + fun test_bad_half n = + n > (bad_half n) + + fun append_always_longer s1 s2 = + string_length s1 < string_length (s1 ^ s2) + + fun record_shrink_test r = + r.theInteger < 50 + +(* +-------------------------------- +PROPERTIES FOR TESTING + +see 'FUNCTIONS FOR TESTING'. + +-------------------------------- + *) + fun prop_bad_insert() = for_all ([list(integer()), integer()], test_bad_insert) + fun prop_bad_half() = for_all ([integer()], (test_bad_half, (fn x => x >= 15))) + fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) + fun prop_bool_commutative() = for_all ([boolean(), boolean()], bool_commutative) + fun prop_count_non_negative() = for_all ([integer(), list(integer())], my_count_returns_non_negative_int) (* 1000 *) + fun prop_rec_test() = for_all ([(record ["theInteger", "theString"][integer(), string()]), integer()], rec_test) + fun prop_no_args() = for_all ([], no_args) + fun prop_shrink_test() = for_all ([integer(), integer(), integer(), integer()], shrink_test) + fun prop_number_commutative() = for_all ([integer(), integer()], number_commutative) + fun prop_list_reverse() = for_all ([list(integer())], list_reverse) + fun prop_integer_interval_works() = for_all ([integer(0, 50)], (int_gen_stays_in_interval, pre_pos)) + fun prop_abs_value() = for_all ([(one_of_two (integer(), float()))], abs_value_is_always_pos) + fun prop_floor() = for_all ([float()], my_floor_test) + fun prop_my_length() = for_all ([list(integer())], my_length_test) + fun prop_make_list_test() = for_all ([generator(), pos_integer()], make_list_test) + fun prop_my_ceil1() = for_all ([float()], my_ceil1_test) + fun prop_my_ceil2() = for_all ([float()], my_ceil2_test) + fun prop_both_ceil() = for_all ([float()], both_ceil_test) + + val test_list = [prop_bad_insert, prop_bad_half, prop_record_shrink, prop_bool_commutative, prop_count_non_negative, prop_rec_test, + prop_no_args, prop_shrink_test, prop_number_commutative, prop_list_reverse, prop_integer_interval_works, prop_abs_value, + prop_floor, prop_my_length, prop_make_list_test, prop_my_ceil1, prop_my_ceil2, prop_both_ceil] +in troupecheck test_list authority +end \ No newline at end of file diff --git a/troupecheck/userguide-tests.trp b/troupecheck/userguide-tests.trp new file mode 100644 index 0000000..829ddf7 --- /dev/null +++ b/troupecheck/userguide-tests.trp @@ -0,0 +1,67 @@ +import lists +import troupecheck +(* +-------------------------------- +USED FOR USERGUIDE + +Functions used for demonstrating how to use TroupeCheck in the userguide. + +-------------------------------- +*) +let fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + + fun ordered [] = true + | ordered (x::[]) = true + | ordered (x::y::ys) = + if x <= y then ordered (y::ys) else false + + fun my_sort_is_ordered xs = + ordered (my_quicksort xs) + + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + + fun pre_list_size_greater_than_one xs = + if (length xs) <= 1 then false else true + + fun no_duplicates[] = true + | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs + + fun cons_length_increase xs x = + (length (x::xs)) = ((length xs) + 1) + + fun list_no_duplicates (generator) tco size = + let val length = (integer(0, size) tco size) + fun no_dups_aux acc 0 = acc + | no_dups_aux acc i = + let val value = generator tco size + in if elem value acc + then no_dups_aux acc i + else no_dups_aux (value::acc) (i-1) + end + in no_dups_aux [] length + end + + fun is_ordered_prop() = for_all ([list(integer())], my_sort_is_ordered) + + fun keep_length_prop() = for_all ([list(integer())], my_sort_keep_length) + + fun keep_length_fixed_prop() = for_all ([list(integer())], (my_sort_keep_length, no_duplicates)) + + fun length_increase_prop() = for_all ([list(integer()), integer()], cons_length_increase) +in +troupecheck [keep_length_prop, length_increase_prop] authority +end From d8bb29e3ca018a3de65bb6b63abb59a9c353217b Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 3 May 2024 10:45:19 +0200 Subject: [PATCH 076/121] Optimized make_list function with the use of threads --- lib/troupecheck.trp | 55 +++++++++++++++++++++++++++++---------------- 1 file changed, 36 insertions(+), 19 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 0387122..cc3485b 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -82,9 +82,26 @@ Different utility functions that are used across the library. else x :: (remove_nth n xs (i + 1)) fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) + let fun make_ls_aux (f_aux, n)= + case n of + 0 => [] + | _ => append [f_aux()] (make_ls_aux (f_aux, n-1)) + val i1 = floor (i/4) + val i2 = i1 + val i3 = i1 + val i4 = i - (i1+i2+i3) + val self_id = self() + val _ = spawn (fn () => let val res = make_ls_aux (f, i1) in send(self_id, ("l1", res)) end) + val _ = spawn (fn () => let val res = make_ls_aux (f, i2) in send(self_id, ("l2", res)) end) + val _ = spawn (fn () => let val res = make_ls_aux (f, i3) in send(self_id, ("l3", res)) end) + val _ = spawn (fn () => let val res = make_ls_aux (f, i4) in send(self_id, ("l4", res)) end) + val interim1 = receive [hn ("l1", x) => x] + val interim2 = receive [hn ("l2", x) => x] + val interim3 = receive [hn ("l3", x) => x] + val interim4 = receive [hn ("l4", x) => x] + val res = append (append (append interim1 interim2) interim3) interim4 + in res + end fun abs_value x = if x < 0 then -x else x @@ -152,7 +169,7 @@ Different utility functions that are used across the library. | dec_nth_aux (x::xs) acc i = case i = idx of true => - let val dec_val = if x-1 <= 0 then 0 else floor (x/2) in + let val dec_val = if x <= 1/1000000 then 0 else x/2 in dec_nth_aux xs (append acc [dec_val]) (i+1) end | false => dec_nth_aux xs (append acc [x]) (i+1) in @@ -207,15 +224,15 @@ All of these functions are spawned and then requests or updates may be send to t produce_rng new_rng end] fun rec_rng ls = - receive [hn ("REQUEST_RND", senderid) => - let val rnd = floor (random()*1000000) - val _ = send (senderid, rnd) - in rec_rng (append ls [rnd]) - end, - hn ("REQUEST_SEQ", senderid) => - let val _ = send (senderid, ls) - in rec_rng [] - end] + receive [hn ("REQUEST_RND", senderid) => + let val rnd = random() + val _ = send (senderid, rnd) + in rec_rng (append ls [rnd]) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, ls) + in rec_rng [] + end] fun rep_rng ls = receive [hn ("REQUEST_RND", senderid) => @@ -348,18 +365,18 @@ However, it can be done if the users wishes to and understands what is going on. val _ = send (pid, ("REQUEST_RND", self())) val bool_int = receive [hn x => x] - val bool = bool_int < (1000000/2) - val float_of_x = x/1000000 + val bool = bool_int < (1/2) + (* val float_of_x = x/1000000 *) val lInf = low = 1/0 (* check for inf *) val hInf = high = 1/0 val res = case (lInf, hInf) of - (true, true) => if bool then float_of_x * size else -float_of_x * size - | (true, false) => high - (float_of_x * size) - | (false, true) => low + (float_of_x * size) - | (false, false) => low + (float_of_x * (high-low)) + (true, true) => if bool then x * size else -x * size + | (true, false) => high - (x * size) + | (false, true) => low + (x * size) + | (false, false) => low + (x * (high-low)) in res end From 255fcc4972f0c15ecd34536b67e37e449cdb4df6 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 3 May 2024 12:09:10 +0200 Subject: [PATCH 077/121] Updated the optimization code for lists to be more modifiable --- lib/troupecheck.trp | 34 ++++++++++++++++----------------- troupecheck/general-testing.trp | 2 +- 2 files changed, 17 insertions(+), 19 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index cc3485b..3938ccf 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -81,25 +81,23 @@ Different utility functions that are used across the library. if n = i then xs else x :: (remove_nth n xs (i + 1)) + fun divide_list_work f length num_workers = + let fun make_infols acc 1 = append acc [(length - (floor(length/num_workers) * (num_workers-1)))] + | make_infols acc i = + make_infols (append acc [floor(length/num_workers)]) (i-1) + val infols = make_infols [] num_workers + val _ = map (fn x => spawn(fn()=> f x)) infols + val res = foldl (fn (_,y) => let val res = receive[hn x => x] in append res y end)[] infols in + res end + fun make_list (f, i) = let fun make_ls_aux (f_aux, n)= case n of 0 => [] | _ => append [f_aux()] (make_ls_aux (f_aux, n-1)) - val i1 = floor (i/4) - val i2 = i1 - val i3 = i1 - val i4 = i - (i1+i2+i3) val self_id = self() - val _ = spawn (fn () => let val res = make_ls_aux (f, i1) in send(self_id, ("l1", res)) end) - val _ = spawn (fn () => let val res = make_ls_aux (f, i2) in send(self_id, ("l2", res)) end) - val _ = spawn (fn () => let val res = make_ls_aux (f, i3) in send(self_id, ("l3", res)) end) - val _ = spawn (fn () => let val res = make_ls_aux (f, i4) in send(self_id, ("l4", res)) end) - val interim1 = receive [hn ("l1", x) => x] - val interim2 = receive [hn ("l2", x) => x] - val interim3 = receive [hn ("l3", x) => x] - val interim4 = receive [hn ("l4", x) => x] - val res = append (append (append interim1 interim2) interim3) interim4 + fun func (l) = let val res = make_ls_aux (f, l) in send (self_id, (res)) end + val res = divide_list_work func i 4 in res end @@ -309,11 +307,11 @@ All of these functions are spawned and then requests or updates may be send to t res end end - fun random_shrink_aux sequences generators prop pre success size counter tco = + fun random_shrink_aux sequences generators prop pre success size counter divi tco = if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] - val new_size = size-1 + val new_size = floor (size/divi) val (shrunk_args, shrunk_sequences) = foldl (fn (x, (arg_acc, seq_acc)) => let val arg = x tco new_size @@ -324,16 +322,16 @@ All of these functions are spawned and then requests or updates may be send to t val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true in case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of - true => random_shrink_aux sequences generators prop pre success size (counter+1) tco + true => random_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco | false => - random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) tco + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco end fun shrink sequence generators prop pre size counter tco = let val rng_recorder = spawn (fn() => rec_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) val _ = receive [hn x => ()] - val res = random_shrink_aux sequence generators prop pre 0 size counter tco + val res = random_shrink_aux sequence generators prop pre 0 size counter 2 tco val rng_replayer = spawn (fn() => rep_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) val _ = receive [hn x => ()] diff --git a/troupecheck/general-testing.trp b/troupecheck/general-testing.trp index 6a13509..c3c0ff1 100644 --- a/troupecheck/general-testing.trp +++ b/troupecheck/general-testing.trp @@ -124,7 +124,7 @@ See 'FUNCTIONS FOR TESTING'. fun both_ceil_test i = my_ceil1 i = my_ceil2 i - fun shrink_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) + fun shrink_test x y z w = x+y+z+w < 100 fun no_args() = true From 870ab4a25137e82a092b3a3a44b5f1ca8915f490 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 5 May 2024 19:04:11 +0200 Subject: [PATCH 078/121] Implemented most of battleship --- troupecheck/battleship.trp | 62 ++++++--- troupecheck/battleship/Makefile | 20 +++ troupecheck/battleship/README.md | 8 ++ troupecheck/battleship/aliases.json | 1 + troupecheck/battleship/battleship-game.trp | 71 ++++++++++ troupecheck/battleship/battleship-player.trp | 128 ++++++++++++++++++ .../battleship/ids/battleship-game.json | 1 + .../battleship/ids/battleship-player1.json | 1 + .../battleship/ids/battleship-player2.json | 1 + 9 files changed, 274 insertions(+), 19 deletions(-) create mode 100644 troupecheck/battleship/Makefile create mode 100644 troupecheck/battleship/README.md create mode 100644 troupecheck/battleship/aliases.json create mode 100644 troupecheck/battleship/battleship-game.trp create mode 100644 troupecheck/battleship/battleship-player.trp create mode 100644 troupecheck/battleship/ids/battleship-game.json create mode 100644 troupecheck/battleship/ids/battleship-player1.json create mode 100644 troupecheck/battleship/ids/battleship-player2.json diff --git a/troupecheck/battleship.trp b/troupecheck/battleship.trp index 8ac2b6f..72ce355 100644 --- a/troupecheck/battleship.trp +++ b/troupecheck/battleship.trp @@ -6,10 +6,10 @@ let fun write x = fun print_board b = foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b - fun make_list (f, i) = + fun make_row (f, i) = case i of 0 => [] - | _ => append (make_list (f, i-1)) [f i] + | _ => append (make_row (f, i-1)) [f i] fun bound_from_ship ship = case ship of @@ -20,7 +20,7 @@ let fun write x = | "X" => 1 | "O" => 1 - fun place_ship board_or_error coordinate = + fun update_board board_or_error coordinate = case getType board_or_error of "string" => board_or_error | _ => @@ -29,8 +29,8 @@ let fun write x = val upperbound = x + (bound_from_ship ship_type) val is_valid = (x >= 1) andalso (upperbound <= 11) in if is_valid then - let val new_y = make_list ((fn i => if (i >= x) andalso (i < upperbound) then ship_type else (nth y_ls i)), 10) - val new_board = make_list ((fn i => if i = y then new_y else (nth board i)), 10) + let val new_y = make_row ((fn i => if (i >= x) andalso (i < upperbound) then ship_type else (nth y_ls i)), 10) + val new_board = make_row ((fn i => if i = y then new_y else (nth board i)), 10) in new_board end else @@ -41,9 +41,9 @@ let fun write x = let val upperbound = y + (bound_from_ship ship_type) val is_valid = (x >= 1) andalso (upperbound <= 11) in if is_valid then - let val new_board = make_list ((fn i => + let val new_board = make_row ((fn i => if i >= y andalso i < upperbound then - make_list ((fn j => if j = x then ship_type else nth (nth board i) j), 10) + make_row ((fn j => if j = x then ship_type else nth (nth board i) j), 10) else nth board i), 10) in new_board end @@ -57,8 +57,8 @@ let fun write x = end fun make_board ls = - let val start_board = make_list ((fn _ => make_list ((fn _ => "-"), 10)), 10) - val board = foldl (fn (x,y) => place_ship y x) start_board ls + let val start_board = make_row ((fn _ => make_row ((fn _ => "-"), 10)), 10) + val board = foldl (fn (x,y) => update_board y x) start_board ls in board end @@ -76,8 +76,8 @@ let fun write x = fun do_attack board (x,y) = case check_attack board (x,y) of "Illegal corrdinate" => ("Illegal corrdinate", board) - | "Miss" => ("Miss", (place_ship board ((x,y), "h", "O"))) - | "Hit" => ("Hit", (place_ship board ((x,y), "h", "X"))) + | "Miss" => ("Miss", (update_board board ((x,y), "h", "O"))) + | "Hit" => ("Hit", (update_board board ((x,y), "h", "X"))) val c1 = ((1,1), "h", "C") val c2 = ((1,2), "h", "B") @@ -85,15 +85,39 @@ let fun write x = val c4 = ((9,1), "v", "S") val c5 = ((9,10), "h", "D") - val board_test = make_board [c1,c2,c3,c4,c5] + fun player board game = + receive [hn ("YOURTURN", senderid) => + let val _ = write "\nIt's your turn. Please pick what column: \n>" + val x_attack = inputLine() + val _ = "\nPlease pick the row: \n>" + val y_attack = inputLine() + val _ = send(senderid, ("ATTACK", (stringToInt(x_attack), stringToInt(y_attack)))) + in player board game + end, + + hn ("ILLEGAL", senderid) => + let val _ = write "\nYour move was illegal. Please pick a column again: \n>" + val x_attack = inputLine() + val _ = "\nPlease pick the row: \n>" + val y_attack = inputLine() + val _ = send(senderid, ("ATTACK", (stringToInt(x_attack), stringToInt(y_attack)))) + in player board game + end, + + hn (("ATTACK_RESP", x), senderid) => + let val _ = write ("\nYour move was a " ^ x ^ "!") + val _ = write ("\nWaiting for other player to attack...\n") + in player board game + end, + + hn (("ATTACK", x), senderid) => + let val (msg, new_board) = do_attack board x + val _ = send (senderid, ("ATTACK_RESP", msg)) + in player new_board game + end + ] - val (att, new_board_test) = do_attack board_test (3,1) - val (att2, new_board_test2) = do_attack new_board_test (3,3) in -print_board board_test; -write (att ^ "\n"); -print_board new_board_test; -write (att2 ^ "\n"); -print_board new_board_test2 + end \ No newline at end of file diff --git a/troupecheck/battleship/Makefile b/troupecheck/battleship/Makefile new file mode 100644 index 0000000..94b34ed --- /dev/null +++ b/troupecheck/battleship/Makefile @@ -0,0 +1,20 @@ +MKID=node $(TROUPE)/rt/built/p2p/mkid.mjs +MKALIASES=node $(TROUPE)/rt/built/p2p/mkaliases.js +START=$(TROUPE)/network.sh + +battleship-game: + + $(START) battleship-game.trp --id=ids/battleship-game.json --port=6789 # --debug --debugp2p + +battleship-player1: + $(START) battleship-player.trp --id=ids/battleship-player1.json --aliases=aliases.json # --debug --debugp2p + +battleship-player2: + $(START) battleship-player.trp --id=ids/battleship-player2.json --aliases=aliases.json # --debug --debugp2p + +create-network-identifiers: + mkdir -p ids + $(MKID) --outfile=ids/battleship-game.json + $(MKID) --outfile=ids/battleship-player1.json + $(MKID) --outfile=ids/battleship-player2.json + $(MKALIASES) --include ids/battleship-game.json --include ids/battleship-player1.json --include ids/battleship-player2.json --outfile aliases.json diff --git a/troupecheck/battleship/README.md b/troupecheck/battleship/README.md new file mode 100644 index 0000000..54dbc51 --- /dev/null +++ b/troupecheck/battleship/README.md @@ -0,0 +1,8 @@ +# Battleship game example + +1. *First-time only* Run `make create-network-identifiers`. This command will create two network identifiers in the local subdirectory `ids/`, and an alias file with the generated identifiers. + +2. Run the server by running `make battleship-game` +3. Open another terminal window and start player 1 by running `make battleship-player1` +4. Open another terminal window again and start player 2 by running `make battleship-player2` + diff --git a/troupecheck/battleship/aliases.json b/troupecheck/battleship/aliases.json new file mode 100644 index 0000000..1e90cdc --- /dev/null +++ b/troupecheck/battleship/aliases.json @@ -0,0 +1 @@ +{"battleship-game":"12D3KooWLz6JNygFFtyTjujjU29ivACgp9bxYGCHheoyfwxpgpv7","battleship-player1":"12D3KooWCCB5cy5eYhdrzPqUqYbmcQjKiKjBA8EH3jvtP5R6jkxc","battleship-player2":"12D3KooWQwT7Pv3vVTZjkhztwU4zzp3mNMQSstzkN2vvNai4uqNv"} \ No newline at end of file diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp new file mode 100644 index 0000000..8a2e0d6 --- /dev/null +++ b/troupecheck/battleship/battleship-game.trp @@ -0,0 +1,71 @@ +import lists + +let fun write x = + fwrite ((getStdout authority), x) + + fun print_board b = + foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b + + fun make_row (f, i) = + case i of + 0 => [] + | _ => append (make_row (f, i-1)) [f i] + + fun update_board board (x,y) marker = + let val y_ls = nth board y + val new_y = make_row ((fn i => if (i = x) then marker else (nth y_ls i)), 10) + val new_board = make_row ((fn i => if i = y then new_y else (nth board i)), 10) + in new_board + end + + fun check_attack board (x,y) = + if (x > 10) orelse (y > 10) orelse (x < 1) orelse (y < 1) then "Illegal coordinate" + else + let val coord = nth (nth board y) x + in case coord of + "-" => "Miss" + |"O" => "Illegal coordinate" + |"X" => "Illegal coordinate" + |_ => "Hit" + end + + fun do_attack board (x,y) = + case check_attack board (x,y) of + "Illegal coordinate" => ("Illegal coordinate", board) + | "Miss" => ("Miss", (update_board board (x,y) "O")) + | "Hit" => ("Hit", (update_board board (x,y) "X")) + + fun switch_turn turn = + if turn = 1 then 2 else 1 + + fun game p1 p2 turn = + let val player_in = if turn = 1 then p1 else p2 + val player_out = if turn = 1 then p2 else p1 + val _ = send(player_in.id, ("YOURTURN", self())) + in + receive [hn (("ATTACK", x), senderid) => + let val (msg, new_board) = do_attack player_out.board x + val next_turn = if msg = "Illegal coordinate" then turn else switch_turn turn + val _ = send (senderid, ("ATTACK_RESP", msg)) + val _ = send (player_out.id, ("UPDATE_MSG", x, msg, new_board)) + in if next_turn = 1 + then game {p1 with board = new_board} p2 next_turn + else game p1 {p2 with board = new_board} next_turn + end + ] + end + + val _ = register ("battleship", self(), authority) + + fun setup p1 count = + receive [hn ("JOINING", board, senderid) => + case count of + 1 => + let val p2 = {board = board, id = senderid} + val _ = send (p1.id, ("STARTING", 1)) + val _ = send (p2.id, ("STARTING", 2)) + in game p1 p2 1 + end + |0 => setup {board = board, id = senderid} (count+1)] +in setup {} 0 +end \ No newline at end of file diff --git a/troupecheck/battleship/battleship-player.trp b/troupecheck/battleship/battleship-player.trp new file mode 100644 index 0000000..4641b1d --- /dev/null +++ b/troupecheck/battleship/battleship-player.trp @@ -0,0 +1,128 @@ +import lists + +let fun write x = + fwrite ((getStdout authority), x) + + fun print_board b = + foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b + + fun make_row (f, i) = + case i of + 0 => [] + | _ => append (make_row (f, i-1)) [f i] + + fun bound_from_ship ship = + case ship of + "C" => 5 + | "B" => 4 + | "S" => 3 + | "D" => 2 + + fun update_board board_or_error coordinate = + case getType board_or_error of + "string" => board_or_error + | _ => + let fun place_horizontal (x, y) ship_type board = + let val y_ls = nth board y + val upperbound = x + (bound_from_ship ship_type) + val is_valid = (x >= 1) andalso (upperbound <= 11) + in if is_valid then + let val new_y = make_row ((fn i => if (i >= x) andalso (i < upperbound) then ship_type else (nth y_ls i)), 10) + val new_board = make_row ((fn i => if i = y then new_y else (nth board i)), 10) + in new_board + end + else + ("Invalid coordinates for ship of type: " ^ ship_type) + end + + fun place_vertical (x, y) ship_type board = + let val upperbound = y + (bound_from_ship ship_type) + val is_valid = (x >= 1) andalso (upperbound <= 11) + in if is_valid then + let val new_board = make_row ((fn i => + if i >= y andalso i < upperbound then + make_row ((fn j => if j = x then ship_type else nth (nth board i) j), 10) + else nth board i), 10) + in new_board + end + else + ("Invalid coordinates for ship of type: " ^ ship_type) + end + val ((x,y), direction, ship) = coordinate + in case direction of + "v" => place_vertical (x,y) ship board_or_error + | "h" => place_horizontal (x,y) ship board_or_error + end + + fun make_board ls = + let val start_board = make_row ((fn _ => make_row ((fn _ => "-"), 10)), 10) + val board = foldl (fn (x,y) => update_board y x) start_board ls + in board + end + + + val c1 = ((1,1), "h", "C") + val c2 = ((1,2), "h", "B") + val c3 = ((10,1), "v", "S") + val c4 = ((9,1), "v", "S") + val c5 = ((9,10), "h", "D") + + fun player() = + receive [hn ("STARTING", player_num) => + let val _ = write "\nBoth players have joined. Player 1 starts.\n" + val _ = write ("\nYou are player " ^ (toString player_num) ^ ".\n") + in player() + end, + + hn ("YOURTURN", senderid) => + let val _ = write "\nPlease pick x-coordinate of attack: \n>" + val x_attack = inputLine() + val _ = write "\nPlease pick y-coordinate of attack: \n>" + val y_attack = inputLine() + val (x, y) = + let pini authority + val res = (stringToInt(x_attack), stringToInt(y_attack)) + val _ = debugpc() + in res + end + val _ = send(senderid, ("ATTACK", (x,y))) + in player() + end, + + hn (("ATTACK_RESP", msg), senderid) => + case msg of + "Illegal coordinate" => + let val _ = write ("\nIllegal attack coordinate! Try with another coordinate...\n") + in player() + end + |_ => + let val _ = write ("\nYour move was a " ^ msg ^ "!") + val _ = write ("\nWaiting for opponent to attack...\n") + in player () + end, + + hn ("UPDATE_MSG", coords, msg, new_board) => + let val _ = write ("\nOpponent attacked (" ^ (toString coords.0) ^ ", " ^ (toString coords.1) ^").") + in case msg of + "Illegal coordinate" => + let val _ = write ("\nThis is an illegal attack coordinate! Wait for opponent to try again...\n") + in player() + end + |_ => + let val _ = print_board new_board + val _ = write ("\nThis move was a " ^ msg ^ "!") + val _ = write ("\nIt is now your turn.\n") + in player() + end + end + ] + + fun join() = + let val board = make_board [c1, c2, c3, c4, c5] + val game = whereis ("@battleship-game", "battleship") + val _ = send(game, ("JOINING", board, self())) + in player() + end + +in join() +end \ No newline at end of file diff --git a/troupecheck/battleship/ids/battleship-game.json b/troupecheck/battleship/ids/battleship-game.json new file mode 100644 index 0000000..a0133f8 --- /dev/null +++ b/troupecheck/battleship/ids/battleship-game.json @@ -0,0 +1 @@ +{"id":"12D3KooWLz6JNygFFtyTjujjU29ivACgp9bxYGCHheoyfwxpgpv7","privKey":"CAESQHzfORXAw9jg1Orw0QnFl7xQZih3VCrcDXMgW+mgXFxbpe5r/80tddCxZVNjofJTk47pqn2Jq5rIbhtWLAiDdYw=","pubKey":"CAESIKXua//NLXXQsWVTY6HyU5OO6ap9iauayG4bViwIg3WM"} \ No newline at end of file diff --git a/troupecheck/battleship/ids/battleship-player1.json b/troupecheck/battleship/ids/battleship-player1.json new file mode 100644 index 0000000..ed2454e --- /dev/null +++ b/troupecheck/battleship/ids/battleship-player1.json @@ -0,0 +1 @@ +{"id":"12D3KooWCCB5cy5eYhdrzPqUqYbmcQjKiKjBA8EH3jvtP5R6jkxc","privKey":"CAESQIVYFeWVRwsLSKymg6z+FzoNveYRo19ERFdki4P8GxZUI02dMRgIJkdHC10Wfe0ihkVhHixN0fFLwAW/WN7L4YU=","pubKey":"CAESICNNnTEYCCZHRwtdFn3tIoZFYR4sTdHxS8AFv1jey+GF"} \ No newline at end of file diff --git a/troupecheck/battleship/ids/battleship-player2.json b/troupecheck/battleship/ids/battleship-player2.json new file mode 100644 index 0000000..6d7769a --- /dev/null +++ b/troupecheck/battleship/ids/battleship-player2.json @@ -0,0 +1 @@ +{"id":"12D3KooWQwT7Pv3vVTZjkhztwU4zzp3mNMQSstzkN2vvNai4uqNv","privKey":"CAESQIw7wMQo9IIb0d4cxLEDQIEPq+rtO3enBQp+ukOtP1Ez4K/1MjIIUEC1afWig9nWdspiw2fpp9GuSGgJcBlRZ2c=","pubKey":"CAESIOCv9TIyCFBAtWn1ooPZ1nbKYsNn6afRrkhoCXAZUWdn"} \ No newline at end of file From 63f9dc25525b9b4d60cbe76ded380e21a17262ed Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 6 May 2024 11:31:58 +0200 Subject: [PATCH 079/121] Battleship works --- troupecheck/battleship/battleship-game.trp | 2 +- troupecheck/battleship/battleship-player.trp | 16 ++++++---------- 2 files changed, 7 insertions(+), 11 deletions(-) diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index 8a2e0d6..91bba4e 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -46,7 +46,7 @@ let fun write x = receive [hn (("ATTACK", x), senderid) => let val (msg, new_board) = do_attack player_out.board x val next_turn = if msg = "Illegal coordinate" then turn else switch_turn turn - val _ = send (senderid, ("ATTACK_RESP", msg)) + val _ = send (senderid, (("ATTACK_RESP", msg), self())) val _ = send (player_out.id, ("UPDATE_MSG", x, msg, new_board)) in if next_turn = 1 then game {p1 with board = new_board} p2 next_turn diff --git a/troupecheck/battleship/battleship-player.trp b/troupecheck/battleship/battleship-player.trp index 4641b1d..78b735d 100644 --- a/troupecheck/battleship/battleship-player.trp +++ b/troupecheck/battleship/battleship-player.trp @@ -1,9 +1,10 @@ import lists - +import stdio let fun write x = fwrite ((getStdout authority), x) fun print_board b = + write "\n"; foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b fun make_row (f, i) = @@ -76,16 +77,11 @@ let fun write x = hn ("YOURTURN", senderid) => let val _ = write "\nPlease pick x-coordinate of attack: \n>" - val x_attack = inputLine() + val x_attack = inputLineAtLevel authority `{}` val _ = write "\nPlease pick y-coordinate of attack: \n>" - val y_attack = inputLine() - val (x, y) = - let pini authority - val res = (stringToInt(x_attack), stringToInt(y_attack)) - val _ = debugpc() - in res - end - val _ = send(senderid, ("ATTACK", (x,y))) + val y_attack = inputLineAtLevel authority `{}` + val (x, y) = (stringToInt(x_attack), stringToInt(y_attack)) + val _ = send(senderid, (("ATTACK", (x,y)), self())) in player() end, From 63d9bc6d654acba1e453ec2d96ca7b727ca90ef9 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 6 May 2024 13:52:54 +0200 Subject: [PATCH 080/121] Battleship now finds a winner and a loser Co-authored-by: Selma --- troupecheck/battleship/battleship-game.trp | 49 ++++++++++++++------ troupecheck/battleship/battleship-player.trp | 48 +++++++++++++++---- 2 files changed, 74 insertions(+), 23 deletions(-) diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index 91bba4e..f0df819 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -1,5 +1,5 @@ import lists - +import timeout let fun write x = fwrite ((getStdout authority), x) @@ -29,11 +29,24 @@ let fun write x = |_ => "Hit" end - fun do_attack board (x,y) = + fun update_ship ship (x,y) = + let val res = foldl (fn (z,w) => if z = (x,y) then w else append w [z]) [] ship + in res + end + + + fun update_ships ships (x,y) = + let val interim_ships = map (fn z => update_ship z (x,y)) ships + val res = foldl (fn (z,w) => if (length z) = 0 then w else (append w [z])) [] interim_ships + in res + end + + + fun do_attack board ships (x,y) = case check_attack board (x,y) of - "Illegal coordinate" => ("Illegal coordinate", board) - | "Miss" => ("Miss", (update_board board (x,y) "O")) - | "Hit" => ("Hit", (update_board board (x,y) "X")) + "Illegal coordinate" => ("Illegal coordinate", board, ships) + | "Miss" => ("Miss", (update_board board (x,y) "O"), ships) + | "Hit" => ("Hit", (update_board board (x,y) "X"), (update_ships ships (x,y))) fun switch_turn turn = if turn = 1 then 2 else 1 @@ -44,13 +57,20 @@ let fun write x = val _ = send(player_in.id, ("YOURTURN", self())) in receive [hn (("ATTACK", x), senderid) => - let val (msg, new_board) = do_attack player_out.board x + let val (msg, new_board, new_ships) = do_attack player_out.board player_out.ships x val next_turn = if msg = "Illegal coordinate" then turn else switch_turn turn - val _ = send (senderid, (("ATTACK_RESP", msg), self())) - val _ = send (player_out.id, ("UPDATE_MSG", x, msg, new_board)) - in if next_turn = 1 - then game {p1 with board = new_board} p2 next_turn - else game p1 {p2 with board = new_board} next_turn + in if length new_ships = 0 then + let val _ = send (senderid, "YOUWON") + val _ = send (player_out.id, ("YOULOST", new_board, x)) + in exitAfterTimeout authority 10 0 "Game has ended." + end + else + let val _ = send (senderid, (("ATTACK_RESP", msg), self())) + val _ = send (player_out.id, ("UPDATE_MSG", x, msg, new_board)) + in if next_turn = 1 + then game {p1 with board = new_board, ships = new_ships} p2 next_turn + else game p1 {p2 with board = new_board, ships = new_ships} next_turn + end end ] end @@ -58,14 +78,15 @@ let fun write x = val _ = register ("battleship", self(), authority) fun setup p1 count = - receive [hn ("JOINING", board, senderid) => + receive [hn ("JOINING", board, ships, senderid) => case count of 1 => - let val p2 = {board = board, id = senderid} + let val p2 = {board = board, id = senderid, ships = ships} val _ = send (p1.id, ("STARTING", 1)) val _ = send (p2.id, ("STARTING", 2)) in game p1 p2 1 end - |0 => setup {board = board, id = senderid} (count+1)] + |0 => + setup {board = board, id = senderid, ships = ships} (count+1)] in setup {} 0 end \ No newline at end of file diff --git a/troupecheck/battleship/battleship-player.trp b/troupecheck/battleship/battleship-player.trp index 78b735d..b4c7014 100644 --- a/troupecheck/battleship/battleship-player.trp +++ b/troupecheck/battleship/battleship-player.trp @@ -55,18 +55,36 @@ let fun write x = | "h" => place_horizontal (x,y) ship board_or_error end + fun for_i body acc 0 = acc.0 + | for_i body acc to = for_i body (body acc) (to-1) + + fun ship_coords_from_info info = + let val (org_x, org_y) = info.0 + val count = (bound_from_ship info.2)-1 + in case info.1 of + "h" => + let val coords = for_i (fn acc => (append acc.0 [((acc.1)+1, org_y)], (acc.1)+1)) ([info.0], org_x) count + in coords + end + |"v" => + let val coords = for_i (fn acc => (append acc.0 [(org_x, (acc.1)+1)], (acc.1)+1)) ([info.0], org_y) count + in coords + end + end + + fun make_board ls = let val start_board = make_row ((fn _ => make_row ((fn _ => "-"), 10)), 10) - val board = foldl (fn (x,y) => update_board y x) start_board ls - in board + val (board, ships) = foldl (fn (x,(board_acc, ships_acc)) => (update_board board_acc x, append ships_acc [ship_coords_from_info x])) (start_board, []) ls + in (board, ships) end - val c1 = ((1,1), "h", "C") - val c2 = ((1,2), "h", "B") - val c3 = ((10,1), "v", "S") - val c4 = ((9,1), "v", "S") - val c5 = ((9,10), "h", "D") + val c1 = ((3,2), "h", "C") + val c2 = ((2,3), "v", "S") + val c3 = ((8,9), "h", "D") + val c4 = ((3,5), "v", "B") + val c5 = ((8,3), "h", "D") fun player() = receive [hn ("STARTING", player_num) => @@ -110,13 +128,25 @@ let fun write x = val _ = write ("\nIt is now your turn.\n") in player() end + end, + + hn "YOUWON" => + let val _ = write ("\nCongratulations! You sank all the opponent's ships. You are the Winner!\n") + in exit (authority, 0) + end, + + hn ("YOULOST", new_board, coords) => + let val _ = write ("\nOpponent attacked (" ^ (toString coords.0) ^ ", " ^ (toString coords.1) ^").") + val _ = print_board new_board + val _ = write ("\nToo bad! The opponent sank all your ships. You lost...\n") + in exit (authority, 0) end ] fun join() = - let val board = make_board [c1, c2, c3, c4, c5] + let val (board, ships) = make_board [c1,c2,c3,c4, c5] val game = whereis ("@battleship-game", "battleship") - val _ = send(game, ("JOINING", board, self())) + val _ = send(game, ("JOINING", board, ships, self())) in player() end From 6faa3d24f67af65e6bf1ce37f7eab87e57ee8a5b Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 7 May 2024 11:26:15 +0200 Subject: [PATCH 081/121] Removed use of tuple indexing --- lib/troupecheck.trp | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 3938ccf..36283dc 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -185,10 +185,12 @@ Different utility functions that are used across the library. fun seqs_of_seq sequence lengths = let fun aux seq acc 0 = (acc, seq) | aux (x::xs) acc n = - aux xs (append acc [x]) (n-1) in - (foldl (fn (x,(acc, s)) => + aux xs (append acc [x]) (n-1) + val (res, _) = (foldl (fn (x,(acc, s)) => let val (curr_acc, curr_seq) = aux s [] x in - (append acc [curr_acc], curr_seq) end)([], sequence) lengths).0 end + (append acc [curr_acc], curr_seq) end)([], sequence) lengths) + in res + end fun cutoff_at list idx = let fun aux ls acc 0 = acc @@ -261,10 +263,10 @@ All of these functions are spawned and then requests or updates may be send to t val arg = x tco size val _ = send (pid, ("REQUEST_LEFT", self())) val left_overs = receive [hn x => x] - in (arg, left_overs) + in {arg = arg, left_overs = left_overs} end) gens - val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.0], append left_overs [x.1])) ([],[]) args_and_leftovers + val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.arg], append left_overs [x.left_overs])) ([],[]) args_and_leftovers val ret_seqs = mapi (fn (i,x) => if (length x) = 0 then (nth seqs_of_curr (i+1)) else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs From 3df083c302eae578218d7e82f993a132e49e64ea Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 7 May 2024 12:08:16 +0200 Subject: [PATCH 082/121] Added so that the for_all functino now takes a bool deciding whether to shrink or not --- lib/troupecheck.trp | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 36283dc..5c09115 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -491,8 +491,8 @@ Handles running the tests (core_forall), shrinking, preparing the recorder RNG a end end - fun for_all (generators, p) auth = for_all (generators, p, 100) auth - | for_all (generators, p, noOfTests) auth = + fun for_all (generators, p, to_shrink) auth = for_all (generators, p, to_shrink, 100) auth + | for_all (generators, p, to_shrink, noOfTests) auth = let val (prop, pre) = case p of (x,y) => (x,y) @@ -504,13 +504,16 @@ Handles running the tests (core_forall), shrinking, preparing the recorder RNG a () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n") auth; true |_ => report_fail_reason res noOfTests tco; - write ("\u001B[1m\u001B[34mShrinking\u001B[0m:") auth; - let val shrink_res = shrink res.ctx_seq generators prop pre res.size 0 tco in - write "\nFailing test case was shrunk to:\n" auth; - write (args_toString shrink_res.shrunk_ctx) auth; - write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n") auth; - false - end + if to_shrink then + (write ("\u001B[1m\u001B[34mShrinking\u001B[0m:") auth; + let val shrink_res = shrink res.ctx_seq generators prop pre res.size 0 tco in + write "\nFailing test case was shrunk to:\n" auth; + write (args_toString shrink_res.shrunk_ctx) auth; + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n") auth; + false + end) + else + false end fun troupecheck props auth = From 89abf2574574a08d950dea84faf11451cac9b28e Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 7 May 2024 15:48:33 +0200 Subject: [PATCH 083/121] Added a for_all_noshrink for testing without shrinking, and for_all again always shrinks --- lib/troupecheck.trp | 10 ++++++++-- troupecheck/general-testing.trp | 2 +- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 5c09115..925b2bf 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -491,8 +491,7 @@ Handles running the tests (core_forall), shrinking, preparing the recorder RNG a end end - fun for_all (generators, p, to_shrink) auth = for_all (generators, p, to_shrink, 100) auth - | for_all (generators, p, to_shrink, noOfTests) auth = + fun run_tests (generators, p, to_shrink, noOfTests) auth = let val (prop, pre) = case p of (x,y) => (x,y) @@ -516,6 +515,12 @@ Handles running the tests (core_forall), shrinking, preparing the recorder RNG a false end + fun for_all (generators, p) auth = run_tests (generators, p, true, 100) auth + | for_all (generators, p, noOfTests) auth = run_tests (generators, p, true, noOfTests) auth + + fun for_all_noshrink (generators, p) auth = run_tests (generators, p, false, 100) auth + | for_all_noshrink (generators, p, noOfTests) auth = run_tests (generators, p, false, noOfTests) auth + fun troupecheck props auth = let val n = toString (length props) fun troupecheck_aux [] i = exit (auth, 0) @@ -576,6 +581,7 @@ in , ("build_record", build_record) , ("build_tuple", build_tuple) , ("for_all", for_all) + , ("for_all_noshrink", for_all_noshrink) , ("troupecheck", troupecheck) , ("inf", inf) , ("integer", integer) diff --git a/troupecheck/general-testing.trp b/troupecheck/general-testing.trp index c3c0ff1..e91261f 100644 --- a/troupecheck/general-testing.trp +++ b/troupecheck/general-testing.trp @@ -149,7 +149,7 @@ see 'FUNCTIONS FOR TESTING'. -------------------------------- *) fun prop_bad_insert() = for_all ([list(integer()), integer()], test_bad_insert) - fun prop_bad_half() = for_all ([integer()], (test_bad_half, (fn x => x >= 15))) + fun prop_bad_half() = for_all_noshrink ([integer()], (test_bad_half, (fn x => x >= 15))) fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) fun prop_bool_commutative() = for_all ([boolean(), boolean()], bool_commutative) fun prop_count_non_negative() = for_all ([integer(), list(integer())], my_count_returns_non_negative_int) (* 1000 *) From b742d96089c13985c2d15a3b5b9b6638c7edd31b Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 7 May 2024 16:00:03 +0200 Subject: [PATCH 084/121] Cleaned up the filing in troupecheck folder --- troupecheck/battleship.trp | 123 --- troupecheck/language_interpreter.trp | 214 ----- troupecheck/random_shrinking.trp | 817 ------------------ .../{tc.trp => tc_archive/tc_ext_shrink.trp} | 0 .../tc_int_shrink.trp} | 0 .../{ => tc_tests}/general-testing.trp | 0 .../{ => tc_tests}/userguide-tests.trp | 0 7 files changed, 1154 deletions(-) delete mode 100644 troupecheck/battleship.trp delete mode 100644 troupecheck/language_interpreter.trp delete mode 100644 troupecheck/random_shrinking.trp rename troupecheck/{tc.trp => tc_archive/tc_ext_shrink.trp} (100%) rename troupecheck/{integrated_shrinking.trp => tc_archive/tc_int_shrink.trp} (100%) rename troupecheck/{ => tc_tests}/general-testing.trp (100%) rename troupecheck/{ => tc_tests}/userguide-tests.trp (100%) diff --git a/troupecheck/battleship.trp b/troupecheck/battleship.trp deleted file mode 100644 index 72ce355..0000000 --- a/troupecheck/battleship.trp +++ /dev/null @@ -1,123 +0,0 @@ -import lists - -let fun write x = - fwrite ((getStdout authority), x) - - fun print_board b = - foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b - - fun make_row (f, i) = - case i of - 0 => [] - | _ => append (make_row (f, i-1)) [f i] - - fun bound_from_ship ship = - case ship of - "C" => 5 - | "B" => 4 - | "S" => 3 - | "D" => 2 - | "X" => 1 - | "O" => 1 - - fun update_board board_or_error coordinate = - case getType board_or_error of - "string" => board_or_error - | _ => - let fun place_horizontal (x, y) ship_type board = - let val y_ls = nth board y - val upperbound = x + (bound_from_ship ship_type) - val is_valid = (x >= 1) andalso (upperbound <= 11) - in if is_valid then - let val new_y = make_row ((fn i => if (i >= x) andalso (i < upperbound) then ship_type else (nth y_ls i)), 10) - val new_board = make_row ((fn i => if i = y then new_y else (nth board i)), 10) - in new_board - end - else - ("Invalid coordinates for ship of type: " ^ ship_type) - end - - fun place_vertical (x, y) ship_type board = - let val upperbound = y + (bound_from_ship ship_type) - val is_valid = (x >= 1) andalso (upperbound <= 11) - in if is_valid then - let val new_board = make_row ((fn i => - if i >= y andalso i < upperbound then - make_row ((fn j => if j = x then ship_type else nth (nth board i) j), 10) - else nth board i), 10) - in new_board - end - else - ("Invalid coordinates for ship of type: " ^ ship_type) - end - val ((x,y), direction, ship) = coordinate - in case direction of - "v" => place_vertical (x,y) ship board_or_error - | "h" => place_horizontal (x,y) ship board_or_error - end - - fun make_board ls = - let val start_board = make_row ((fn _ => make_row ((fn _ => "-"), 10)), 10) - val board = foldl (fn (x,y) => update_board y x) start_board ls - in board - end - - fun check_attack board (x,y) = - if (x > 10) orelse (y > 10) orelse (x < 1) orelse (y < 1) then "Illegal corrdinate" - else - let val coord = nth (nth board y) x - in case coord of - "-" => "Miss" - |"O" => "Illegal corrdinate" - |"X" => "Illegal corrdinate" - |_ => "Hit" - end - - fun do_attack board (x,y) = - case check_attack board (x,y) of - "Illegal corrdinate" => ("Illegal corrdinate", board) - | "Miss" => ("Miss", (update_board board ((x,y), "h", "O"))) - | "Hit" => ("Hit", (update_board board ((x,y), "h", "X"))) - - val c1 = ((1,1), "h", "C") - val c2 = ((1,2), "h", "B") - val c3 = ((10,1), "v", "S") - val c4 = ((9,1), "v", "S") - val c5 = ((9,10), "h", "D") - - fun player board game = - receive [hn ("YOURTURN", senderid) => - let val _ = write "\nIt's your turn. Please pick what column: \n>" - val x_attack = inputLine() - val _ = "\nPlease pick the row: \n>" - val y_attack = inputLine() - val _ = send(senderid, ("ATTACK", (stringToInt(x_attack), stringToInt(y_attack)))) - in player board game - end, - - hn ("ILLEGAL", senderid) => - let val _ = write "\nYour move was illegal. Please pick a column again: \n>" - val x_attack = inputLine() - val _ = "\nPlease pick the row: \n>" - val y_attack = inputLine() - val _ = send(senderid, ("ATTACK", (stringToInt(x_attack), stringToInt(y_attack)))) - in player board game - end, - - hn (("ATTACK_RESP", x), senderid) => - let val _ = write ("\nYour move was a " ^ x ^ "!") - val _ = write ("\nWaiting for other player to attack...\n") - in player board game - end, - - hn (("ATTACK", x), senderid) => - let val (msg, new_board) = do_attack board x - val _ = send (senderid, ("ATTACK_RESP", msg)) - in player new_board game - end - ] - -in - - -end \ No newline at end of file diff --git a/troupecheck/language_interpreter.trp b/troupecheck/language_interpreter.trp deleted file mode 100644 index 5a4c518..0000000 --- a/troupecheck/language_interpreter.trp +++ /dev/null @@ -1,214 +0,0 @@ -import lists -(* Program: statement list - Statement: ("assign", var, exp) | ("print", exp) *) - -let fun eval exp env = - case exp of - ("num", n) => n - | ("var", n) => lookup env n ("unknown variable " ^ n) - | ("add", e1, e2) => (eval e1 env) + (eval e2 env) - | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) - | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) - | ("div", e1, e2) => (eval e1 env) / (eval e2 env) - | _ => print ("Error: ill defined expression: "); exit (authority, 1) - - fun execute stmt env = - case stmt of - ("assign", var, exp) => - let val value = eval exp env - in - append [(var, value)] env - end - | ("print", exp) => (print (toString (eval exp env)); env) - - fun interpret stmts = - let fun interpretHelper [] env = env - | interpretHelper (stmt :: rest) env = - let val newEnv = execute stmt env - in - interpretHelper rest newEnv - end - in - (interpretHelper stmts []) - end - - val statements = [ - ("assign", "x", ("num", 5)), - ("assign", "y", ("num", 7)), - ("print", ("var", "x")), - ("print", ("var", "y")), - ("print", ("add", ("var", "x"), ("var", "y"))) - ] - - fun one_of ls = - let val idx = (int_gen (1, (length ls)) ((length ls))).raw - in - nth ls idx - end - - fun exp_gen ls size = - let val exp_ts = ["num", "var", "add", "sub", "mul", "div"] - val exp_type_interim = one_of exp_ts - val exp_type = if (exp_type_interim = "var") andalso (length ls = 0) then "num" else "var" - in - case exp_type of - "num" => - let val value = int_gen(inf, inf) size - fun shrinker inst = - let val shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in - {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in - {raw = ("num", value.raw), shrinker = shrinker} end - | "var" => - let val value = one_of ls size - fun shrinker inst = - {inst with state = "done"} in - {raw = ("var", value), shrinker = shrinker} end - |"add" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state - in - {state = next_state, curr = ("add", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} - end - in - {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} - end - |"sub" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state - in - {state = next_state, curr = ("sub", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} - end - in - {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} - end - |"mul" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state - in - {state = next_state, curr = ("mul", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} - end - in - {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} - end - |"div" => - let val e1 = exp_gen ls size - val e2 = exp_gen ls size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr, prev = inst.prev} - val next_state = if shrunk_e1.state = "done" then e2.state else e1.state - in - {state = next_state, curr = ("div", shrunk_e1.raw, shrunk_e2.raw), prev = inst.prev} - end - in - {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} - end - end - - fun assign_stmt_gen ls size = - let val n = string_gen size - val exp = exp_gen ls size - fun shrinker inst = - let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val shrunk_assign = ("assign", n, shrunk_exp.curr) - in - {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} - end - in - {raw = ("assign", n, exp.raw), shrinker = shrinker} - end - - fun print_stmt_gen ls size = - let val exp = exp_gen ls size - fun shrinker inst = - let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val shrunk_print = ("print", shrunk_exp.curr) - in - {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} - end - in - {raw = ("print", exp.raw), shrinker = shrinker} - end - - fun stmt_gen ls size = - let val stmt = one_of ["assign", "print"] - in - case stmt of - "assign" => - let val res = assign_stmt_gen ls size in - {raw = res.raw, shrinker = res.shrinker} end - |"print" => - let val res = print_stmt_gen ls size in - {raw = res.raw, shrinker = res.shrinker} end - end - - fun assign_in_use_aux stm_or_exp assign idx = - case stmt_or_exp.0 of - "print" => - assign_in_use_aux stmt_or_exp.1 assign idx - | "assign" => - assign_in_use_aux stmt_or_exp.2 assign idx - | "var" => if stm_or_exp.1 = assign then true else false - | "num" => false - | _ => - if assign_in_use stmt_or_exp.1 assign idx then - true - else - assign_in_use_aux stm_or_exp.2 assign idx - - fun assign_in_use [] idxs assign idx bool = bool - | assign_in_use (x::xs) idxs assign idx bool = - let val res = assign_in_use_aux x assign (length (x::xs)) idx - in - if res then assign_in_use xs (append [idx] idxs) assign idx+1 true - else assign_in_use xs idxs assign idx+1 bool - end - - - - - fun program_gen size = - let val num_of_insts = int_gen(0, size) size - fun prog_gen_aux env p 0 = (p,s) - | prog_gen_aux env p s i = - let val stmt = stmt_gen env size - val newEnv = if stmt.raw.0 = "assign" then append [stmt.raw.1] env else env - in - prog_gen_aux newEnv (append [stmt.raw] p) (append [stmt.shrinker] s) (i-1) - end - val (prog, shrinkers) = prog_gen_aux [] [] [] num_of_insts - fun shrinker inst = - case inst.state of - "init" => - let val shrunk = shrink_list shrinkers inst - in shrunk end - | "cont_size" => - let val next_elem = inst.curr[inst.idx-1] - in - if next_elem.0 = "assign" then - if (assign_in_use(next_elem.1)).0 then - {inst with idx = inst.idx-1} - else - shrink_list shrinkers inst - else - shrink_list shrinkers inst - end - | _ => - shrink_list shrinkers inst - in - {raw = prog, shrinker = shrinker} - end -in -print (program_gen 50) end \ No newline at end of file diff --git a/troupecheck/random_shrinking.trp b/troupecheck/random_shrinking.trp deleted file mode 100644 index 082e2a2..0000000 --- a/troupecheck/random_shrinking.trp +++ /dev/null @@ -1,817 +0,0 @@ -import lists -(* --------------------------------- -PRINTING TO CONSOLE - q --------------------------------- -*) -let val out = getStdout authority - fun write x = fwrite (out, x) - (* arguments are always in a list - for easier readability these are removed when converting arguments to string *) - fun args_toString args = - let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) - | aux_toString acc (x::xs) = acc ^ (toString x) in - aux_toString "" args end -(* --------------------------------- -ERROR HANDLING - w --------------------------------- -*) - fun report_error error_reason = - write "\u001B[31m \nError: "; (* Changing the print color to red *) - let val err_string = case error_reason of - ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " - ^ (toString tries) ^ " tries.\n" - | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" - | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" - | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" - | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" - | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" - | ("shrinking_looped", _) => "Shrinking looped.\n" - | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" - in - write (err_string ^ "\u001B[0m"); (* Changing the color back *) - exit (authority, 0) end - - fun boolean_check x = - if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) else () - - fun function_not_done_check p = - if (getType p)<>"function" then report_error ("type_mismatch", 0) else () -(* --------------------------------- -UTILS - e --------------------------------- -*) - fun remove_nth n [] i = [] - | remove_nth n (x::xs) i = - if n = i then xs - else x :: (remove_nth n xs (i + 1)) - - fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) - - fun abs_value x = - if x < 0 then -x else x - -(* applies the list of arguments to the property - one by one - reporting errors along the way *) -(* TODO: handle when arguments are passed to a property that does not take arguments *) - fun apply_args p l = - case l of - [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) - | (x::xs) => - let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in - boolean_check res; - res - end - - fun string_to_list s = - let fun aux "" acc = acc - | aux s acc = - let val x = substring (s, 0, 1) - val xs = substring (s, 1, 1/0) in - aux xs (append acc [x]) end in - aux s [] end - - fun list_to_string ls = - foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls - - fun string_length s = - length (string_to_list s) - - fun report_fail_reason rec noOfTests= - case rec.failReason of - "false_prop" => - write "\nFailure at input: "; - write (args_toString rec.cEx); - write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") - - fun build_record names vals = - let fun aux r [] [] = r - | aux r (n::ns) (v::vs) = - aux (recordExtend(r, n, v)) ns vs in - aux {} names vals - end - - fun build_tuple ls = - case ls of - [] => (0) - |[x] => (x) - |[x1,x2] => (x1,x2) - |[x1,x2,x3] => (x1,x2,x3) - |[x1,x2,x3,x4] => (x1,x2,x3,x4) - |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) - |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) - |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) - |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) - |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) - |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) - |_ => (2, 3, 4, 5) -(* --------------------------------- -GENERATORS - t --------------------------------- -*) - (* return - {raw: bool, shrinker: fn {state: string, curr: bool, prev: bool} => ..: {state: string, curr: bool, prev: bool}} *) - fun bool_gen size = - let val rnd = random() - val res = if rnd < 1/2 then false - else true - in - res - end - - (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) - (* TODO: Fix shrinking towards zero -> should shrink towards lowest valid val *) - fun float_gen (low, high) size = - let val x = random() - val lInf = low = 1/0 (* check for inf *) - val hInf = high = 1/0 - val raw_res = - case (lInf, hInf) of - (true, true) => if (bool_gen size) then x*size else -x*size - | (true, false) => high - (x*size) - | (false, true) => low + (x*size) - | (false, false) => low + (x * (high-low)) - in - raw_res - end - - (* return - {raw: number, shrinker: fn {state: string, curr: number, prev: number} => ..: {state: string, curr: number, prev: number}} *) - fun int_gen (low, high) size = - let val raw_res = floor ((float_gen(low, high+1) size)) - in - raw_res - end - - (* return - {raw: list, shrinker: fn {state: string, curr: list, prev: list} => ..: {state: string, curr: list, prev: list}} *) - fun list_gen (generator) size = - let val length = (int_gen(0, size) size) - val res = make_list ((fn () => generator size), length) in - res - end - - (* NOTE: Generates only letters (upper and lower case) and numbers. *) - (* return - {raw: char, shrinker: fn {state: string, curr: char, prev: char} => ..: {state: string, curr: char, prev: char}} *) - fun char_gen size = - let val chars = - ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", - "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", - "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", - "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = (int_gen (1, ((length chars)-1)) size) - in - (nth chars x) - end - -(* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) - (* return - {raw: string, shrinker: fn {state: string, curr: string, prev: string} => ..: {state: string, curr: string, prev: string}} *) - fun string_gen size = - let val x = (int_gen (0, size) size) - fun fold f acc 0 = acc - | fold f acc i = fold f (acc ^ (f())) (i-1) - val raw_string = (fold (fn () => (char_gen x)) "" x) - in - raw_string - end - -(* NOTE: Hardcoded for tuple of up to 10 elements *) -(* returns a record with raw_inst: a tuple of whatever values specified, and meta_data is a list - of all generated values in raw_inst along with their respective meta_data. *) - fun tuple_gen ts size = - let val ts_vals = map (fn x => x size) ts - in - (build_tuple ts_vals) - end - -(* -ns: list of strings - will be used as fieldnames -ts: list of generators - used to generate values for fields - -Returns record: {raw_inst = <>, meta_data = (ns, <>)} -*) - fun rec_gen ns ts size = - if (length ns) <> (length ts) then - report_error ("record_mismatch", 0) - else - let val ts_vals = map (fn x => x size) ts - val raw_res = build_record ns ts_vals - in - raw_res - end - - - fun generator_gen size = - let val rnd = random() - val inf = 1/0 - val res = if rnd <= 1/7 then ((fn i => int_gen(inf, inf) i)) else - if rnd <= 2/7 then ((fn i => bool_gen i)) else - if rnd <= 3/7 then ((fn i => float_gen(inf, inf) i)) else - if rnd <= 4/7 then ((fn i => string_gen i)) else - if rnd <= 5/7 then ((fn i => char_gen i)) else - if rnd <= 6/7 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf)), i)) i)) else - ((fn i => list_gen (int_gen(inf, inf)) i)) in - res end - -(* --------------------------------- -SHRINKING - r --------------------------------- -*) - fun max(x, y) = - if x >= y then x else y - - - fun dec_nth list idx = - let fun dec_nth_aux [] acc i = acc - | dec_nth_aux (x::xs) acc i = - case i = idx of - true => dec_nth_aux xs (append acc [max(x-1, 0)]) (i+1) - | false => dec_nth_aux xs (append acc [x]) (i+1) - in - dec_nth_aux list [] 0 end - - fun is_all ls n = - foldl (fn (x,y) => x = n andalso y) true ls - - - fun shrink_aux generators curr sizes prop pre success counter = - if (counter = 10000) orelse (is_all sizes 0) then {shrunk_ctx = curr, count = success} else - let val n = int_gen(0, ((length sizes)-1)) (length sizes) - val new_sizes = dec_nth sizes n - val shrunk_args = mapi (fn (i, x) => x (nth new_sizes (i+1))) generators - val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args) else true in - case (apply_args prop shrunk_args) orelse (precond_is_met = false) of - true => shrink_aux generators curr sizes prop pre success (counter+1) - | false => - shrink_aux generators shrunk_args new_sizes prop pre (success+1) (counter+1) end - - fun shrink generators curr size prop pre = - let val size_ls = map (fn _ => size) generators - val res = shrink_aux generators curr size_ls prop pre 0 0 - in res end - -(* --------------------------------- -CORE FUNCTIONALITY - a --------------------------------- -*) - fun core_forall (generator, prop, 0, size, pre, cap) = {failReason = (), cEx = (), remTests = 0, size = size} - |core_forall (generator, prop, i, size, pre, cap) = - let val args = map (fn x => x size) generator in - case pre of - () => - if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", cEx = args, remTests = i, size = size}) - | _ => - if (apply_args pre args) then - if (apply_args prop args) then (write "."; core_forall (generator, prop, i-1, size+1, pre, cap)) - else (write "!"; {failReason = "false_prop", cEx = args, remTests = i, size = size}) - else - (write "x"; - if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) - else if size = cap then {failReason = (), cEx = (), remTests = i, size = size} - else core_forall (generator, prop, i, size+1, pre, cap)) - end - - fun tc_n generators p noOfTests = - let val (prop, pre) = - case p of - (x,y) => (x,y) - | x => (x, ()) - val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5)) in - case res.failReason of - () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n"); true - |_ => - report_fail_reason res noOfTests; - write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); - let val shrink_res = shrink generators res.cEx res.size prop pre in - write "\nFailing test case was shrunk to:\n"; - write (args_toString shrink_res.shrunk_ctx); - write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); - false - end - end - - fun tc generator p = tc_n generator p 100 - - fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) - | troupecheck generator p = spawn (fn() => tc generator p) - -(* --------------------------------- -CONVENIENCE FUNCTIONS - s --------------------------------- -*) - val inf = 1 / 0 - fun integer() = int_gen(inf, inf) - | integer (h, l) = int_gen(h, l) - - fun pos_integer() = integer(0, inf) - - fun neg_integer() = integer(inf, -1) - - fun float() = float_gen(inf, inf) - | float(h, l) = float_gen(h, l) - - fun pos_float() = float(0, inf) - - fun neg_float() = float(inf, 0) - - fun boolean() = bool_gen - - fun list() = list_gen(generator_gen()) (* TODO: generator_gen() should return both raw_gen and meta_data *) - |list(type) = list_gen(type) - - fun string() = string_gen - - fun char() = char_gen - - fun tuple ts = tuple_gen ts - - fun record ns ts = rec_gen ns ts - - fun one_of ls = - let val idx = (int_gen (1, (length ls)) ((length ls))).raw - in - nth ls idx - end -(* --------------------------------- -FUNCTIONS FOR TESTING - d --------------------------------- -*) - fun my_reverse xs = - xs - - fun my_floor i = - if i >=0 then i - (i mod 1) - else i - (i mod 1) - 1 - - fun my_length [] = 0 - | my_length (x::xs) = 1 + (my_length xs) - - fun my_count y [] = 0 - | my_count y (x::xs) = - let val z = - if y = x then 1 else 0 - in - z + my_count y xs end - - fun my_floor i = - if i >=0 then i - (i mod 1) - else i - (i mod 1) - 1 - - fun my_ceil_1 i = - if i > 0 then i + (1 - (i mod 1)) - else i + (1 - (i mod 1)) - 1 - - fun my_ceil_2 i = - if i > 0 then (my_floor i) + 1 - else if i = 0 then 0 - else (my_floor i) + 1 - - fun bad_insert xs x = - if length xs < 10 then append [x] xs else - xs - - fun one_of_two (x, y) = - let val bool = (bool_gen 0).raw in - if bool then x - else y end - - fun bad_half n = - if n > 10 then n else n/2 - - fun lengths_not_same s1 s2 = - (string_length s1) <> (string_length s2) - -(* --------------------------------- -PROPERTIES FOR TESTING - f --------------------------------- -*) - fun bool_commutative x y = - (x andalso y) = (y andalso x) - - fun number_commutative x y = - x * y = y * x - - fun list_reverse xs = - reverse(reverse xs) = xs - - fun int_gen_stays_in_interval i = - (integer(0, i) i).raw <= i - - fun abs_value_is_always_pos i = - abs_value i >= 0 - - fun my_floor_test i = - my_floor i = floor i - - fun my_length_test xs = - my_length xs = length xs - - fun make_list_test i = - let val generator = generator_gen i - fun f() = generator ((int_gen(0, inf) i).raw) - val ls = (make_list (f, i)) in - (length ls) = i end - - fun my_count_returns_non_negative_int x xs = - (my_count x xs) >= 0 - - fun rec_test rec i = - {theInteger = rec.theInteger, theString = rec.theString, z = i} = {rec with z = i} - - fun pre_pos x = - x >= 0 - - fun my_floor_test i = - my_floor i = floor i - - fun my_ceil_1_test i = - my_ceil_1 i = ceil i - - fun my_ceil_2_test i = - my_ceil_2 i = ceil i - - fun both_ceil_test i = - my_ceil_1 i = my_ceil_2 i - - fun tup_test x y z w = x+y+z+w < 100 (* = w+z+y+x *) - - fun no_args() = true - - fun test_bad_insert xs x = - length (bad_insert xs x) = (length xs) + 1 - - fun test_bad_half n = - n > (bad_half n) - - fun append_always_longer s1 s2 = - string_length s1 < string_length (s1 ^ s2) - - fun record_shrink_test r = - r.theInteger < 50 - -(* --------------------------------- -USED FOR USERGUIDE - g --------------------------------- -*) - fun filter_less ([], _) = [] - | filter_less ((x::xs), p) = - if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) - - fun filter_greater ([], _) = [] - | filter_greater ((x::xs), p) = - if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) - - - fun my_quicksort [] = [] - | my_quicksort (x::xs) = - let val smaller = my_quicksort(filter_less(xs, x)) - val greater = my_quicksort(filter_greater(xs, x)) in - append (append smaller [x]) (greater) end - - fun ordered [] = true - | ordered (x::[]) = true - | ordered (x::y::ys) = - if x <= y then ordered (y::ys) else false - - fun my_sort_is_ordered xs = - ordered (my_quicksort xs) - - fun my_sort_keep_length xs = - length xs = length (my_quicksort(xs)) - - fun pre_list_size_greater_than_one xs = - if (length xs) <= 1 then false else true - - fun no_duplicates[] = true - | no_duplicates (x::xs) = if (elem x xs) then false else no_duplicates xs - - fun cons_length_increase xs x = - (length (x::xs)) = ((length xs) + 1) -(* --------------------------------- -TC^2 - z --------------------------------- -*) - fun tc_sort_length_always_fails () = - tc [list(integer())] my_sort_keep_length = false - - fun tc_sort_ordered_always_true () = - tc [list(integer())] my_sort_is_ordered = true - -(* --------------------------------- -CUSTOM TYPE PROGRAM --------------------------------- -*) -(* fun eval exp env = - case exp of - ("num", n) => n - | ("var", n) => lookup env n ("unknown variable " ^ n) - | ("add", e1, e2) => (eval e1 env) + (eval e2 env) - | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) - | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) - | ("div", e1, e2) => (eval e1 env) / (eval e2 env) - | _ => print ("Error: ill defined expression"); exit (authority, 1) - - fun execute stmt env = - case stmt of - ("assign", var, exp) => - let val value = eval exp env - in - append [(var, value)] env - end - | ("print", exp) => (print (toString (eval exp env)); env) - - fun interpret prog = - let fun interpretHelper [] env = env - | interpretHelper (stmt :: rest) env = - let val newEnv = execute stmt env - in - interpretHelper rest newEnv - end - val stmts = remove_nth ((length prog)-1) prog 0 - val exp = nth prog (length prog) - val last_env = (interpretHelper stmts []) - in - eval exp last_env - end - - fun optimize_prog prog = - let val stmts = remove_nth ((length prog)-1) prog 0 - val exp = nth prog (length prog) - fun optimize_exp exp = - case exp of - ("num", n) => ("num", n) - | ("var", x) => ("var", x) - | ("add", e1, e2) => - (case e1 of - ("num", n1) => (case e2 of - ("num", n2) => ("num", (n1+n2)) - |_ => ("add", (optimize_exp e1), (optimize_exp e2))) - | _ => ("add", (optimize_exp e1), (optimize_exp e2))) - | ("sub", e1, e2) => - (case e1 of - ("num", n1) => (case e2 of - ("num", n2) => ("num", (n1-n2)) - |_ => ("sub", (optimize_exp e1), (optimize_exp e2)) ) - |_ => ("sub", (optimize_exp e1), (optimize_exp e2))) - | ("mul", e1, e2) => - (case e1 of - ("num", n1) => (case e2 of - ("num", n2) => ("num", (n1*n2)) - |_ => ("mul", (optimize_exp e1), (optimize_exp e2)) ) - |_ => ("mul", (optimize_exp e1), (optimize_exp e2))) - | ("div", e1, e2) => - (case e1 of - ("num", n1) => (case e2 of - ("num", n2) => if ((n1 = 0) andalso (n2 = 0)) then ("div", e1, e2) else ("num", (n1/n2)) - |_ => ("div", (optimize_exp e1), (optimize_exp e2)) ) - |_ => ("div", (optimize_exp e1), (optimize_exp e2))) - - fun optimize_stmt stmt = - case stmt of - ("assign", var, exp) => ("assign", var, (optimize_exp exp)) - | ("print", exp) => ("print", (optimize_exp exp)) - in - append (map optimize_stmt stmts) [optimize_exp exp] - end - - fun exp_gen ls nesting_level size = - let val exp_ts = if length ls = 0 then ["num", "add", "sub", "mul", "div"] else ["num", "var", "add", "sub", "mul", "div"] - val exp_type = if nesting_level = 2 then "num" else one_of exp_ts - in - case exp_type of - "num" => - let val value = int_gen(inf, inf) size - fun shrinker inst = - let val shrunk_val = value.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} in - {state = shrunk_val.state, curr = ("num", shrunk_val.curr), prev = ("num", shrunk_val.prev)} end in - {raw = ("num", value.raw), shrinker = shrinker} end - | "var" => - let val value = one_of ls - fun shrinker inst = - {inst with state = "done"} in - {raw = ("var", value), shrinker = shrinker} end - |"add" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("add", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end - in - {raw = ("add", e1.raw, e2.raw), shrinker = shrinker} - end - |"sub" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("sub", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end - in - {raw = ("sub", e1.raw, e2.raw), shrinker = shrinker} - end - |"mul" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("mul", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end - in - {raw = ("mul", e1.raw, e2.raw), shrinker = shrinker} - end - |"div" => - let val e1 = exp_gen ls (nesting_level+1) size - val e2 = exp_gen ls (nesting_level+1) size - fun shrinker inst = - let val shrunk_e1 = e1.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_e2 = e2.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val next_state = if shrunk_e1.state = "done" then shrunk_e2.state else shrunk_e1.state - in - {state = next_state, curr = ("div", shrunk_e1.curr, shrunk_e2.curr), prev = inst.prev} - end - in - {raw = ("div", e1.raw, e2.raw), shrinker = shrinker} (* maybe just shrinker? *) - end - end - - fun assign_stmt_gen ls size = - let val n = string_gen size - val exp = exp_gen ls 0 size - fun shrinker inst = - let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.2, prev = inst.prev.2} - val shrunk_assign = ("assign", n.raw, shrunk_exp.curr) - in - {state = shrunk_exp.state, curr = shrunk_assign, prev = inst.curr} - end - in - {raw = ("assign", n.raw, exp.raw), shrinker = shrinker} - end - - fun print_stmt_gen ls size = - let val exp = exp_gen ls 0 size - fun shrinker inst = - let val shrunk_exp = exp.shrinker {state = inst.state, curr = inst.curr.1, prev = inst.prev.1} - val shrunk_print = ("print", shrunk_exp.curr) - in - {state = shrunk_exp.state, curr = shrunk_print, prev = inst.curr} - end - in - {raw = ("print", exp.raw), shrinker = shrinker} - end - - fun stmt_gen ls size = - let val stmt = one_of ["assign", "print"] - in - case stmt of - "assign" => - let val res = assign_stmt_gen ls size in - {raw = res.raw, shrinker = res.shrinker} end - |"print" => - let val res = print_stmt_gen ls size in - {raw = res.raw, shrinker = res.shrinker} end - end - - fun assign_in_use_aux stmt_or_exp assign idx = - case stmt_or_exp.0 of - "print" => - assign_in_use_aux stmt_or_exp.1 assign idx - | "assign" => - assign_in_use_aux stmt_or_exp.2 assign idx - | "var" => if stmt_or_exp.1 = assign then true else false - | "num" => false - | _ => - if assign_in_use_aux stmt_or_exp.1 assign idx then - true - else - assign_in_use_aux stmt_or_exp.2 assign idx - - fun assign_in_use [] idxs assign idx bool = (bool, idxs) - | assign_in_use (x::xs) idxs assign idx bool = - let val res = assign_in_use_aux x assign idx - in - if res then assign_in_use xs (append [idx] idxs) assign (idx+1) true - else assign_in_use xs idxs assign (idx+1) bool - end - - fun program_gen size = - let val num_of_insts = (int_gen(0, size) size ).raw - fun prog_gen_aux env p s 0 = (p, s, env) - | prog_gen_aux env p s i = - let val stmt = stmt_gen env size - val newEnv = if stmt.raw.0 = "assign" then (append [stmt.raw.1] env) else env - in - prog_gen_aux newEnv (append p [stmt.raw]) (append s [stmt.shrinker]) (i-1) - end - val (prog_stmts, shrinkers_interim, last_env) = prog_gen_aux [] [] [] num_of_insts - val last_exp = exp_gen last_env 0 size - val prog = append prog_stmts [last_exp.raw] - val shrinkers = append shrinkers_interim [last_exp.shrinker] - fun shrinker inst = - case inst.state of - "init" => - let val shrunk = shrink_list shrinkers inst - in - shrunk - end - | "cont_size" => - let val next_elem = nth inst.curr (length inst.curr) - in - if next_elem.0 = "assign" then - if (assign_in_use inst.curr [] (next_elem.1) 0 false).0 then - print "testing"; - {inst with idx = inst.idx-1} - else if (next_elem.0 = "var") orelse (next_elem.0 = "num") orelse (next_elem.0 = "add") orelse (next_elem.0 = "sub") orelse - (next_elem.0 = "mul") orelse (next_elem.0 = "div") then - {inst with idx = inst.idx-1} - - else - shrink_list shrinkers inst - else - shrink_list shrinkers inst - end - | _ => - shrink_list shrinkers inst - in - {raw = prog, shrinker = shrinker} - end - - fun test_prog_opt prog = - (interpret prog) = (interpret (optimize_prog prog)) - val exp = exp_gen [] 0 3 - val stmt = stmt_gen [] 3 - val prog = program_gen 2 *) -in - -(* --------------------------------- -ALL TESTS - x --------------------------------- -*) -(* tc [integer()] (test_bad_half, (fn x => x >= 15)); *) -tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test -(* shrinking tests - x *) -(* tc [list(integer()), integer()] test_bad_insert; -tc [integer()] (test_bad_half, (fn x => x >= 15)); -tc [string(), string()] (append_always_longer, lengths_not_same); -tc [record ["theInteger", "theString"] [integer(), string()]] record_shrink_test; *) - -(* tc^2 tests *) -(* tc [] tc_sort_ordered_always_true; *) - -(* User guide tests *) -(* tc [list(integer()), integer()] cons_length_increase; -tc [list(integer())] my_sort_is_ordered; -tc [list(integer())] my_sort_keep_length; -tc [list(integer())] (my_sort_keep_length, no_duplicates); *) - -(* General functionality tests *) -(* tc [(record ["theInteger", "theString"][integer(), string()]), integer()] rec_test; -tc [] no_args; -tc [integer(), integer(), integer(), integer()] tup_test; -write "\nTesting on bools commutative:"; -tc [boolean(), boolean()] bool_commutative; -write "\nTesting on numbers commutative:"; -tc [integer(), integer()] number_commutative; -write "\nTesting on list reverse:"; -tc [list(integer())] list_reverse; -write "\nTesting on int_gen interval:"; -tc [integer()] (int_gen_stays_in_interval, pre_pos); -write "\nTesting on abs_value:"; -tc [one_of_two (integer(), float())] abs_value_is_always_pos; -write "\nTesting on my_floor:"; -tc [float()] my_floor_test; -write "\nTesting that my_count always return non-negative result:"; -tc_n [integer(), list(integer())] my_count_returns_non_negative_int 1000; -write "\nTesting my_length:"; -tc [list(integer())] my_length_test; -write "\nTesting make_list:"; -tc [pos_integer()] make_list_test; -write "Testing on my_ceil_1:"; -tc [float()] my_ceil_1_test; -write "Testing on my_ceil_2:"; -tc [float()] my_ceil_2_test; -write "Testing on both ceil functions:"; -tc [float()] both_ceil_test *) -end \ No newline at end of file diff --git a/troupecheck/tc.trp b/troupecheck/tc_archive/tc_ext_shrink.trp similarity index 100% rename from troupecheck/tc.trp rename to troupecheck/tc_archive/tc_ext_shrink.trp diff --git a/troupecheck/integrated_shrinking.trp b/troupecheck/tc_archive/tc_int_shrink.trp similarity index 100% rename from troupecheck/integrated_shrinking.trp rename to troupecheck/tc_archive/tc_int_shrink.trp diff --git a/troupecheck/general-testing.trp b/troupecheck/tc_tests/general-testing.trp similarity index 100% rename from troupecheck/general-testing.trp rename to troupecheck/tc_tests/general-testing.trp diff --git a/troupecheck/userguide-tests.trp b/troupecheck/tc_tests/userguide-tests.trp similarity index 100% rename from troupecheck/userguide-tests.trp rename to troupecheck/tc_tests/userguide-tests.trp From 2539437204b188cb76dea908a1dabad3e75a1255 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 7 May 2024 16:15:23 +0200 Subject: [PATCH 085/121] Created a makefile for running tc-tests --- troupecheck/Makefile | 5 +++++ 1 file changed, 5 insertions(+) create mode 100644 troupecheck/Makefile diff --git a/troupecheck/Makefile b/troupecheck/Makefile new file mode 100644 index 0000000..64d52b2 --- /dev/null +++ b/troupecheck/Makefile @@ -0,0 +1,5 @@ +TLOCAL=$(TROUPE)/local.sh + +tc-tests: + $(TLOCAL) ./tc_tests/general-testing.trp + $(TLOCAL) ./tc_tests/userguide-tests.trp \ No newline at end of file From 23e008d6c24df49f22f52c4228f64a1d4ee19cce Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 7 May 2024 22:59:46 +0200 Subject: [PATCH 086/121] Smalle change to "one_of" function in lib file - battleship-game update - can now test for IFC --- lib/troupecheck.trp | 6 +- troupecheck/battleship/battleship-game.trp | 189 ++++++++++++++++++++- 2 files changed, 189 insertions(+), 6 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 925b2bf..2dfc80b 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -571,10 +571,10 @@ These are functions that make it easier for the user to make use of the differen fun record ns ts = rec_gen ns ts - fun one_of ls = - let val idx = (int_gen (1, (length ls)) ((length ls))) + fun one_of ls tco size = + let val idx = (int_gen (1, (length ls)) tco size) in - (nth ls idx) + (nth ls idx) end in [ ("make_list", make_list) diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index f0df819..cc67ff1 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -1,5 +1,6 @@ import lists import timeout +import troupecheck let fun write x = fwrite ((getStdout authority), x) @@ -81,12 +82,194 @@ let fun write x = receive [hn ("JOINING", board, ships, senderid) => case count of 1 => - let val p2 = {board = board, id = senderid, ships = ships} + let val p2 = {board = (board raisedTo `{p2}`), id = senderid, ships = (ships raisedTo `{p2}`)} val _ = send (p1.id, ("STARTING", 1)) val _ = send (p2.id, ("STARTING", 2)) in game p1 p2 1 end |0 => - setup {board = board, id = senderid, ships = ships} (count+1)] -in setup {} 0 + setup {board = (board raisedTo `{p1}`), id = senderid, ships = (ships raisedTo `{p1}`)} (count+1)] + +(* +---------------------------- +Testing the game host using TroupeCheck +---------------------------- +*) + fun for_i body acc 0 = acc.0 + | for_i body acc to = for_i body (body acc) (to-1) + + fun write x = + fwrite ((getStdout authority), x) + + fun bound_from_ship ship = + case ship of + "C" => 5 + | "B" => 4 + | "S" => 3 + | "D" => 2 + + fun print_board b = + write "\n"; + foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b + + fun make_row (f, i) = + case i of + 0 => [] + | _ => append (make_row (f, i-1)) [f i] + + fun update_board_creation board_or_error coordinate = + case getType board_or_error of + "string" => board_or_error + | _ => + let fun place_horizontal (x, y) ship_type board = + let val y_ls = nth board y + val upperbound = x + (bound_from_ship ship_type) + val is_valid = (x >= 1) andalso (upperbound <= 11) + in if is_valid then + let val new_y = make_row ((fn i => if (i >= x) andalso (i < upperbound) then ship_type else (nth y_ls i)), 10) + val new_board = make_row ((fn i => if i = y then new_y else (nth board i)), 10) + in new_board + end + else + ("Invalid coordinates for ship of type: " ^ ship_type) + end + + fun place_vertical (x, y) ship_type board = + let val upperbound = y + (bound_from_ship ship_type) + val is_valid = (x >= 1) andalso (upperbound <= 11) + in if is_valid then + let val new_board = make_row ((fn i => + if i >= y andalso i < upperbound then + make_row ((fn j => if j = x then ship_type else nth (nth board i) j), 10) + else nth board i), 10) + in new_board + end + else + ("Invalid coordinates for ship of type: " ^ ship_type) + end + val ((x,y), direction, ship) = coordinate + in case direction of + "v" => place_vertical (x,y) ship board_or_error + | "h" => place_horizontal (x,y) ship board_or_error + end + + fun ship_coords_from_info info = + let val (org_x, org_y) = info.0 + val count = (bound_from_ship info.2)-1 + in case info.1 of + "h" => + let val coords = for_i (fn acc => (append acc.0 [((acc.1)+1, org_y)], (acc.1)+1)) ([info.0], org_x) count + in coords + end + |"v" => + let val coords = for_i (fn acc => (append acc.0 [(org_x, (acc.1)+1)], (acc.1)+1)) ([info.0], org_y) count + in coords + end + end + + fun make_board ls = + let val start_board = make_row ((fn _ => make_row ((fn _ => "-"), 10)), 10) + val (board, ships) = foldl (fn (x,(board_acc, ships_acc)) => (update_board_creation board_acc x, append ships_acc [ship_coords_from_info x])) (start_board, []) ls + in + (board, ships) + end + + + fun ship_gen taken_coords ship_type tco size = + let val dir = one_of ["h", "v"] tco size + val ship_size = bound_from_ship ship_type + fun ship_gen_aux direction = + case direction of + "h" => + let val x = integer(1, (ship_size+1)) tco size + val y = integer(1, 10) tco size + in if length taken_coords = 0 then + (x,y) + else + let val ship_coords = ship_coords_from_info ((x,y), dir, ship_type) + val ship_coords_not_used = foldl (fn (x,y) => if elem x taken_coords then false else (true andalso y)) true ship_coords + in + if ship_coords_not_used then + (x,y) + else + ship_gen_aux direction + end + end + + | "v" => + let val x = integer(1, 10) tco size + val y = integer(1, (ship_size+1)) tco size + in if length taken_coords = 0 then + (x,y) + else + let val ship_coords = ship_coords_from_info ((x,y), dir, ship_type) + val ship_coords_not_used = foldl (fn (x,y) => if elem x taken_coords then false else (true andalso y)) true ship_coords + in + if ship_coords_not_used then + (x,y) + else + ship_gen_aux direction + end + end + in (ship_gen_aux dir, dir, ship_type) + end + + fun board_gen tco size = + let val carrier = ship_gen [] "C" tco size + val fst_taken = ship_coords_from_info carrier + val battleshp = ship_gen fst_taken "B" tco size + val snd_taken = append fst_taken (ship_coords_from_info battleshp) + val sub1 = ship_gen snd_taken "S" tco size + val thrd_taken = append snd_taken (ship_coords_from_info sub1) + val sub2 = ship_gen thrd_taken "S" tco size + val frth_taken = append thrd_taken (ship_coords_from_info sub2) + val destroyer = ship_gen frth_taken "D" tco size + val ship_ls = [carrier, battleshp, sub1, sub2, destroyer] + val (board, ships) = make_board ship_ls + in (board, ships) + end + + (* fun init_tc auth rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in init_tc auth rng end, + + hn ("REQUEST_AUTH", senderid) => + let val _ = send (senderid, auth) + in init_tc auth rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + init_tc auth new_rng end] + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = random() + val _ = send (senderid, rnd) + in rec_rng (append ls [rnd]) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, ls) + in rec_rng [] + end] + + val rng_recorder = spawn (fn() => rec_rng []) + val tco = spawn (fn() => init_tc authority rng_recorder) *) + (* val (board, ships) = board_gen tco 10 *) + + fun labeled_value_gen labels value_gen tco size = + let val inst = value_gen tco size + val lab = one_of labels tco size + in inst raisedTo lab + end + + fun test_do_attack_no_leak (board, ships) = + let val auth = attenuate (authority, (levelOf board)) + val res = ((levelOf board) = (levelOf ships)) andalso ((levelOf board) = (levelOf (do_attack board ships (1,2)))) + val _ = blockdecl authority + in declassify (res, authority, `{}`) + end + + fun prop_do_att_test() = + for_all ([(labeled_value_gen[`{alice}`, `{bob}`] board_gen)], test_do_attack_no_leak) +in troupecheck[prop_do_att_test] authority end \ No newline at end of file From 8ef35ffc1cf7d85d01e738a76299c6fba8b3e9eb Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 7 May 2024 23:18:52 +0200 Subject: [PATCH 087/121] Updated suppport for IFC testing - troupecheck library now declassifies result of a test, that may be tainted by blocking labels --- lib/troupecheck.trp | 21 +++++++++++++++------ troupecheck/battleship/battleship-game.trp | 6 ++---- 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 2dfc80b..93db678 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -106,13 +106,22 @@ Different utility functions that are used across the library. (* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l tco = - case l of - [] => boolean_check (p()) tco; p() (* this case is only reached if there are no generators to begin with *) - | (x::xs) => - let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l in - boolean_check res tco; - res + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + in case l of + [] => (* this case is only reached if there are no generators to begin with *) + let val _ = boolean_check (p()) tco + val res = p() + val _ = blockdecl auth + in declassify (res, auth, `{}`) end + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l + val _ = boolean_check res tco + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + end fun string_to_list s = let fun aux "" acc = acc diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index cc67ff1..ec45433 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -263,10 +263,8 @@ Testing the game host using TroupeCheck end fun test_do_attack_no_leak (board, ships) = - let val auth = attenuate (authority, (levelOf board)) - val res = ((levelOf board) = (levelOf ships)) andalso ((levelOf board) = (levelOf (do_attack board ships (1,2)))) - val _ = blockdecl authority - in declassify (res, authority, `{}`) + let val res = ((levelOf board) = (levelOf ships)) andalso ((levelOf board) = (levelOf (do_attack board ships (1,2)))) + in res end fun prop_do_att_test() = From 904ffc53f5da18116e9ae04141dc3ea506f6a0a6 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 8 May 2024 10:28:49 +0200 Subject: [PATCH 088/121] labeled value generator added to tc library Co-authored-by: Selma --- lib/troupecheck.trp | 26 +++++++++++++++------- troupecheck/battleship/battleship-game.trp | 15 ++++++------- 2 files changed, 25 insertions(+), 16 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 93db678..a78fb2f 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -363,7 +363,8 @@ for random decisions (i.e. a call to float_gen/float() or int_gen/integer()), in However, it can be done if the users wishes to and understands what is going on. -------------------------------- -*) +*) + fun float_gen (low, high) tco size = let val _ = send (tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] @@ -393,6 +394,12 @@ However, it can be done if the users wishes to and understands what is going on. let val res = floor (float_gen (low, high+1) tco size) in res end + + fun one_of ls tco size = + let val idx = (int_gen (1, (length ls)) tco size) + in + (nth ls idx) + end fun bool_gen tco size = let val rnd = int_gen (0,1) tco size @@ -443,6 +450,12 @@ However, it can be done if the users wishes to and understands what is going on. val res = build_record ns ts_vals in res end + + fun labeled_value_gen labels value_gen tco size = + let val inst = value_gen tco size + val lab = one_of labels tco size + in inst raisedTo lab + end (* TODO: needs to be completed... *) fun generator_gen tco size = @@ -578,17 +591,14 @@ These are functions that make it easier for the user to make use of the differen fun tuple ts = tuple_gen ts - fun record ns ts = rec_gen ns ts + fun labeled_value ls gen = labeled_value_gen ls gen - fun one_of ls tco size = - let val idx = (int_gen (1, (length ls)) tco size) - in - (nth ls idx) - end + fun record ns ts = rec_gen ns ts in [ ("make_list", make_list) , ("build_record", build_record) , ("build_tuple", build_tuple) + , ("one_of", one_of) , ("for_all", for_all) , ("for_all_noshrink", for_all_noshrink) , ("troupecheck", troupecheck) @@ -605,7 +615,7 @@ in , ("char", char) , ("generator", generator) , ("tuple", tuple) + , ("labeled_value", labeled_value) , ("record", record) - , ("one_of", one_of) ] end diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index ec45433..f7e0461 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -256,18 +256,17 @@ Testing the game host using TroupeCheck val tco = spawn (fn() => init_tc authority rng_recorder) *) (* val (board, ships) = board_gen tco 10 *) - fun labeled_value_gen labels value_gen tco size = - let val inst = value_gen tco size - val lab = one_of labels tco size - in inst raisedTo lab - end + + + fun attack_gen tco size = + (integer(1, 10) tco size, integer(1,10) tco size) - fun test_do_attack_no_leak (board, ships) = - let val res = ((levelOf board) = (levelOf ships)) andalso ((levelOf board) = (levelOf (do_attack board ships (1,2)))) + fun test_do_attack_no_leak (board, ships) attack = + let val res = ((levelOf board) = (levelOf ships)) andalso ((levelOf board) = (levelOf (do_attack board ships attack))) in res end fun prop_do_att_test() = - for_all ([(labeled_value_gen[`{alice}`, `{bob}`] board_gen)], test_do_attack_no_leak) + for_all ([(labeled_value [`{alice}`, `{bob}`] board_gen), attack_gen], test_do_attack_no_leak) in troupecheck[prop_do_att_test] authority end \ No newline at end of file From 2735183498bc7d5b5a09ef0e730000ea3fb0a2fc Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 8 May 2024 17:06:05 +0200 Subject: [PATCH 089/121] boards and ship coordinates are now labeled and declassified when needed to be --- troupecheck/battleship/battleship-game.trp | 88 ++++++++++++++++------ 1 file changed, 64 insertions(+), 24 deletions(-) diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index f7e0461..e184cc9 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -46,11 +46,30 @@ let fun write x = fun do_attack board ships (x,y) = case check_attack board (x,y) of "Illegal coordinate" => ("Illegal coordinate", board, ships) - | "Miss" => ("Miss", (update_board board (x,y) "O"), ships) - | "Hit" => ("Hit", (update_board board (x,y) "X"), (update_ships ships (x,y))) + | "Miss" => + let val updated_board = (update_board board (x,y) "O") + in ("Miss", updated_board, ships) + end + | "Hit" => + let val updated_board = (update_board board (x,y) "X") + val updated_ships = (update_ships ships (x,y)) + in ("Hit", updated_board, updated_ships) + end fun switch_turn turn = if turn = 1 then 2 else 1 + + fun declassify_board board = + let val _ = blockdecl authority + val board_decl = (declassify(board, authority, `{}`)) + val res = map (fn x => + let val x_decl = (declassify(x, authority, `{}`)) + in map (fn y => + declassify(y, authority, `{}`)) x_decl + end) board_decl + in res + end + fun game p1 p2 turn = let val player_in = if turn = 1 then p1 else p2 @@ -59,16 +78,20 @@ let fun write x = in receive [hn (("ATTACK", x), senderid) => let val (msg, new_board, new_ships) = do_attack player_out.board player_out.ships x - val next_turn = if msg = "Illegal coordinate" then turn else switch_turn turn - in if length new_ships = 0 then + val _ = blockdecl authority + val msg_decl = declassify (msg, authority, `{}`) + val ships_decl = declassify (new_ships, authority, `{}`) + val board_decl = declassify_board new_board (* (new_board, authority, `{}`) *) + val next_turn = if msg_decl = "Illegal coordinate" then turn else switch_turn turn + in if length ships_decl = 0 then let val _ = send (senderid, "YOUWON") - val _ = send (player_out.id, ("YOULOST", new_board, x)) + val _ = send (player_out.id, ("YOULOST", board_decl, x)) in exitAfterTimeout authority 10 0 "Game has ended." end else - let val _ = send (senderid, (("ATTACK_RESP", msg), self())) - val _ = send (player_out.id, ("UPDATE_MSG", x, msg, new_board)) - in if next_turn = 1 + let val _ = send (senderid, (("ATTACK_RESP", msg_decl), self())) + val _ = send (player_out.id, ("UPDATE_MSG", x, msg_decl, board_decl)) + in if turn = 2 then game {p1 with board = new_board, ships = new_ships} p2 next_turn else game p1 {p2 with board = new_board, ships = new_ships} next_turn end @@ -214,7 +237,7 @@ Testing the game host using TroupeCheck in (ship_gen_aux dir, dir, ship_type) end - fun board_gen tco size = + fun board_ships_gen tco size = let val carrier = ship_gen [] "C" tco size val fst_taken = ship_coords_from_info carrier val battleshp = ship_gen fst_taken "B" tco size @@ -229,7 +252,20 @@ Testing the game host using TroupeCheck in (board, ships) end - (* fun init_tc auth rng = + fun attack_gen tco size = + (integer(1, 10) tco size, integer(1,10) tco size) + + fun test_do_attack_no_leak (board, ships) attack = + let val interim_res1 = ((levelOf board) = (levelOf ships)) + val interim_res2 = ((levelOf board) = (levelOf (do_attack board ships attack))) + in (interim_res1 andalso interim_res2) + end + + fun prop_do_att_test() = + for_all ([(labeled_value [`{alice}`, `{bob}`] board_ships_gen), attack_gen], test_do_attack_no_leak) + + + fun init_tc auth rng = receive [hn ("REQUEST_RNG", senderid) => let val _ = send (senderid, rng) in init_tc auth rng end, @@ -253,20 +289,24 @@ Testing the game host using TroupeCheck end] val rng_recorder = spawn (fn() => rec_rng []) - val tco = spawn (fn() => init_tc authority rng_recorder) *) - (* val (board, ships) = board_gen tco 10 *) - - - - fun attack_gen tco size = - (integer(1, 10) tco size, integer(1,10) tco size) - - fun test_do_attack_no_leak (board, ships) attack = - let val res = ((levelOf board) = (levelOf ships)) andalso ((levelOf board) = (levelOf (do_attack board ships attack))) - in res - end + val tco = spawn (fn() => init_tc authority rng_recorder) + val (board, ships) = board_ships_gen tco 10 + (*fun playerfun() = + receive [hn ("YOURTURN", senderid) => let val _ = print "YOURTURN" + val _ = send(senderid, (("ATTACK", (1,2)), self())) + in playerfun() end, + hn x => let val _ = print x in playerfun() end] + val p1_id = spawn (fn() => playerfun()) + val p2_id = spawn (fn() => playerfun()) + val p1 = + let val (board, ships) = board_ships_gen tco 10 + in {board = (board raisedTo `{p1}`), id = p1_id, ships = (ships raisedTo `{p1}`)} + end + val p2 = + let val (board, ships) = board_ships_gen tco 10 + in {board = (board raisedTo `{p2}`), id = p2_id, ships = (ships raisedTo `{p2}`)} + end + val game = spawn(fn () => game p1 p2 1) *) - fun prop_do_att_test() = - for_all ([(labeled_value [`{alice}`, `{bob}`] board_gen), attack_gen], test_do_attack_no_leak) in troupecheck[prop_do_att_test] authority end \ No newline at end of file From 3fd45415a9d9beb226cce7467904b9565ef9ee63 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 13 May 2024 14:19:08 +0200 Subject: [PATCH 090/121] Updated ship_gen --- lib/troupecheck.trp | 11 +- troupecheck/battleship/battleship-game.trp | 171 +++++++++++++++------ 2 files changed, 133 insertions(+), 49 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index a78fb2f..8add25e 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -264,9 +264,12 @@ All of these functions are spawned and then requests or updates may be send to t fun shrink_aux seqs gens lengths prop pre size counter tco = let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] + val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] in case seqs of (x1::x2::x3::xs) => - let val seqs_of_curr = seqs_of_seq (x2()) lengths + let val _ = write "\nstart\n" auth + val seqs_of_curr = seqs_of_seq (x2()) lengths val args_and_leftovers = mapi (fn (i, x) => let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) val arg = x tco size @@ -274,7 +277,6 @@ All of these functions are spawned and then requests or updates may be send to t val left_overs = receive [hn x => x] in {arg = arg, left_overs = left_overs} end) gens - val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.arg], append left_overs [x.left_overs])) ([],[]) args_and_leftovers val ret_seqs = mapi (fn (i,x) => if (length x) = 0 then (nth seqs_of_curr (i+1)) @@ -306,7 +308,9 @@ All of these functions are spawned and then requests or updates may be send to t end and integrated_shrink sequences gens prop pre size counter tco = - let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] (* TODO: Delete this *) + val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences in if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then shrink_aux [seqs_comb] gens seq_lengths prop pre size counter tco @@ -315,6 +319,7 @@ All of these functions are spawned and then requests or updates may be send to t val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) tco in + write "\ntesting 2\n" auth; res end end diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index e184cc9..3312545 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -170,6 +170,7 @@ Testing the game host using TroupeCheck else ("Invalid coordinates for ship of type: " ^ ship_type) end + val _ = print coordinate val ((x,y), direction, ship) = coordinate in case direction of "v" => place_vertical (x,y) ship board_or_error @@ -197,62 +198,134 @@ Testing the game host using TroupeCheck (board, ships) end + fun remove_elem elem [] = [] + | remove_elem elem (x::xs) = + if elem = x then + xs + else + x :: (remove_elem elem xs) - fun ship_gen taken_coords ship_type tco size = - let val dir = one_of ["h", "v"] tco size - val ship_size = bound_from_ship ship_type - fun ship_gen_aux direction = - case direction of - "h" => - let val x = integer(1, (ship_size+1)) tco size - val y = integer(1, 10) tco size - in if length taken_coords = 0 then - (x,y) - else - let val ship_coords = ship_coords_from_info ((x,y), dir, ship_type) - val ship_coords_not_used = foldl (fn (x,y) => if elem x taken_coords then false else (true andalso y)) true ship_coords - in - if ship_coords_not_used then - (x,y) - else - ship_gen_aux direction - end + + fun remove_available_coords available_coords coords (x,y) dir length = + let val to_remove = + case dir of + "h" => + let val to_remove_interim = for_i (fn (ls, count) => (append ls [(count, y)], (count-1))) (coords, (x-1)) (length-1) + in foldl (fn (c, acc) => + let val interim_x = c.0 + val interim_y = c.1 + val new_ls = + for_i (fn (ls, count) => + (append ls [(interim_x, (interim_y-count))], (count+1))) ([], 1) (length-1) + in append acc new_ls end) to_remove_interim coords end + + | "v" => + let val to_remove_interim = for_i (fn (ls, count) => (append ls [(x, count)], (count-1))) (coords, (y-1)) (length-1) + in foldl (fn (c, acc) => + let val interim_x = c.0 + val interim_y = c.1 + val new_ls = + for_i (fn (ls, count) => + (append ls [((interim_x-count), interim_y)], (count+1))) ([], 1) (length-1) + in append acc new_ls end) to_remove_interim coords + end + val new_available = foldl (fn (x, y) => remove_elem x y) available_coords to_remove + in + new_available + end + fun ship_gen available_coords ship_type tco size = + let val dir = one_of ["h", "v"] tco size + val (coord, coords) = case dir of + "h" => + let val avail = + case ship_type of + "C" => + available_coords.c_h + | "B" => + available_coords.b_h + | "S" => + available_coords.s_h + | "D" => + available_coords.d_h + val coord = one_of avail tco size + val coords = ship_coords_from_info (coord, "h", ship_type) + in (coord, coords) + end | "v" => - let val x = integer(1, 10) tco size - val y = integer(1, (ship_size+1)) tco size - in if length taken_coords = 0 then - (x,y) - else - let val ship_coords = ship_coords_from_info ((x,y), dir, ship_type) - val ship_coords_not_used = foldl (fn (x,y) => if elem x taken_coords then false else (true andalso y)) true ship_coords - in - if ship_coords_not_used then - (x,y) - else - ship_gen_aux direction - end - end - in (ship_gen_aux dir, dir, ship_type) - end + let val avail = + case ship_type of + "C" => + available_coords.c_v + | "B" => + available_coords.b_v + | "S" => + available_coords.s_v + | "D" => + available_coords.d_v + val coord = one_of avail tco size + val coords = ship_coords_from_info (coord, "v", ship_type) + in (coord, coords) + end + + val newC_h = remove_available_coords available_coords.c_h coords coord dir 5 + val newC_v = remove_available_coords available_coords.c_v coords coord dir 5 + val newB_h = remove_available_coords available_coords.c_h coords coord dir 4 + val newB_v = remove_available_coords available_coords.c_v coords coord dir 4 + val newS_h = remove_available_coords available_coords.c_h coords coord dir 3 + val newS_v = remove_available_coords available_coords.c_v coords coord dir 3 + val newD_h = remove_available_coords available_coords.c_h coords coord dir 2 + val newD_v = remove_available_coords available_coords.c_v coords coord dir 2 + in ((coord, dir, ship_type), {c_h = newC_h, c_v = newC_v, b_h = newB_h, b_v = newB_v, d_h = newS_h, s_h = newS_h, s_v = newS_v, d_h = newD_h, d_v = newD_v}) + end + fun make_init_avail_rec () = + let fun remove_elem_xs elem [] = [] + | remove_elem_xs elem (x::xs) = + if (elem = (x.0)) then + remove_elem_xs elem xs + else + x :: (remove_elem_xs elem xs) + + fun remove_elem_ys elem [] = [] + | remove_elem_ys elem (x::xs) = + if (elem = (x.1)) then + remove_elem_ys elem xs + else + x :: (remove_elem_ys elem xs) + + val init = for_i (fn (acc, x_count) => + let val list = for_i (fn (acc, y_count) => (append acc [(x_count, y_count)], (y_count+1))) ([], 1) 10 + in (append acc list, (x_count+1)) + end) ([], 1) 10 + val c_h = foldl (fn(x,y) => remove_elem_xs x y) init [7, 8, 9, 10] + val c_v = foldl (fn(x,y) => remove_elem_ys x y) init [7, 8, 9, 10] + val b_h = foldl (fn(x,y) => remove_elem_xs x y) init [8, 9, 10] + val b_v = foldl (fn(x,y) => remove_elem_ys x y) init [8, 9, 10] + val s_h = foldl (fn(x,y) => remove_elem_xs x y) init [9, 10] + val s_v = foldl (fn(x,y) => remove_elem_ys x y) init [9, 10] + val d_h = foldl (fn(x,y) => remove_elem_xs x y) init [10] + val d_v = foldl (fn(x,y) => remove_elem_ys x y) init [10] + in {c_h, c_v, b_h, b_v, s_h, s_v, d_h, d_v} + end + + fun board_ships_gen tco size = - let val carrier = ship_gen [] "C" tco size - val fst_taken = ship_coords_from_info carrier - val battleshp = ship_gen fst_taken "B" tco size - val snd_taken = append fst_taken (ship_coords_from_info battleshp) - val sub1 = ship_gen snd_taken "S" tco size - val thrd_taken = append snd_taken (ship_coords_from_info sub1) - val sub2 = ship_gen thrd_taken "S" tco size - val frth_taken = append thrd_taken (ship_coords_from_info sub2) - val destroyer = ship_gen frth_taken "D" tco size + let val init_avail = make_init_avail_rec () + val (carrier, avail1) = ship_gen init_avail "C" tco size + val (battleshp, avail2) = ship_gen avail1 "B" tco size + val (sub1, avail3) = ship_gen avail2 "S" tco size + val (sub2, avail4) = ship_gen avail3 "S" tco size + val (destroyer, _) = ship_gen avail4 "D" tco size val ship_ls = [carrier, battleshp, sub1, sub2, destroyer] val (board, ships) = make_board ship_ls - in (board, ships) + in + (board, ships) end fun attack_gen tco size = + print "entering attack gen"; (integer(1, 10) tco size, integer(1,10) tco size) fun test_do_attack_no_leak (board, ships) attack = @@ -260,10 +333,16 @@ Testing the game host using TroupeCheck val interim_res2 = ((levelOf board) = (levelOf (do_attack board ships attack))) in (interim_res1 andalso interim_res2) end + + fun test_bad_do_attack (board, ships) attack = + (length (do_attack board ships attack).1) = 11 fun prop_do_att_test() = for_all ([(labeled_value [`{alice}`, `{bob}`] board_ships_gen), attack_gen], test_do_attack_no_leak) + fun prop_bad_do_att() = + for_all ([(labeled_value [`{alice}`, `{bob}`] board_ships_gen), attack_gen], test_bad_do_attack) + fun init_tc auth rng = receive [hn ("REQUEST_RNG", senderid) => @@ -308,5 +387,5 @@ Testing the game host using TroupeCheck end val game = spawn(fn () => game p1 p2 1) *) -in troupecheck[prop_do_att_test] authority +in print_board (board_ships_gen tco 10).0 (* troupecheck[prop_bad_do_att] authority *) end \ No newline at end of file From 19635d93e1d65b7c211acd26d811b53d52fbda49 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 13 May 2024 15:10:25 +0200 Subject: [PATCH 091/121] Fixed a small bug in the internal shrinking function + removed unnecessary prints --- lib/troupecheck.trp | 20 +++++++------------- troupecheck/battleship/battleship-game.trp | 9 +++++---- 2 files changed, 12 insertions(+), 17 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 8add25e..4ecd335 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -215,7 +215,7 @@ SHRINKING Works by first using random shrinking when a failing example has been found (shrink & random_shrink_aux). Random shrinking means simply generating new test cases with gradually smaller size, to find a case smaller than the original one. This rarely produces a minmal result. -The smallest randomly shrunk instance is then further shrunk using integrated shrinking. (integrated_shrink & shrink_aux) +The smallest randomly shrunk instance is then further shrunk using integrated shrinking. (internal_shrink & shrink_aux) Integrated shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (produce_rng, rc_rng & rep_rng). @@ -264,12 +264,9 @@ All of these functions are spawned and then requests or updates may be send to t fun shrink_aux seqs gens lengths prop pre size counter tco = let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] - val _ = send (tco, ("REQUEST_AUTH", self())) - val auth = receive [hn x => x] in case seqs of (x1::x2::x3::xs) => - let val _ = write "\nstart\n" auth - val seqs_of_curr = seqs_of_seq (x2()) lengths + let val seqs_of_curr = seqs_of_seq (x2()) lengths val args_and_leftovers = mapi (fn (i, x) => let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) val arg = x tco size @@ -285,7 +282,7 @@ All of these functions are spawned and then requests or updates may be send to t in case (apply_args prop test_args tco) orelse (precond_is_met = false) of true => shrink_aux (x1::x3()) gens lengths prop pre size counter tco - | false => integrated_shrink ret_seqs gens prop pre size (counter+1) tco + | false => internal_shrink ret_seqs gens prop pre size (counter+1) tco end | (x::xs) => let val seqs_of_curr = seqs_of_seq (x()) lengths @@ -307,19 +304,16 @@ All of these functions are spawned and then requests or updates may be send to t end end - and integrated_shrink sequences gens prop pre size counter tco = - let val _ = send (tco, ("REQUEST_AUTH", self())) - val auth = receive [hn x => x] (* TODO: Delete this *) - val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences + and internal_shrink sequences gens prop pre size counter tco = + let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences in if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then - shrink_aux [seqs_comb] gens seq_lengths prop pre size counter tco + shrink_aux [fn () => seqs_comb] gens seq_lengths prop pre size counter tco else let val decreased_seqs = dec_all seqs_comb val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) tco in - write "\ntesting 2\n" auth; res end end @@ -352,7 +346,7 @@ All of these functions are spawned and then requests or updates may be send to t val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) val _ = receive [hn x => ()] in - integrated_shrink (res.sequences) generators prop pre res.size (res.count) tco end + internal_shrink (res.sequences) generators prop pre res.size (res.count) tco end (* -------------------------------- GENERATORS diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index 3312545..fb9ce43 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -170,7 +170,6 @@ Testing the game host using TroupeCheck else ("Invalid coordinates for ship of type: " ^ ship_type) end - val _ = print coordinate val ((x,y), direction, ship) = coordinate in case direction of "v" => place_vertical (x,y) ship board_or_error @@ -325,8 +324,10 @@ Testing the game host using TroupeCheck end fun attack_gen tco size = - print "entering attack gen"; - (integer(1, 10) tco size, integer(1,10) tco size) + let val res = (integer(1, 10) tco size, integer(1,10) tco size) + in + res + end fun test_do_attack_no_leak (board, ships) attack = let val interim_res1 = ((levelOf board) = (levelOf ships)) @@ -387,5 +388,5 @@ Testing the game host using TroupeCheck end val game = spawn(fn () => game p1 p2 1) *) -in print_board (board_ships_gen tco 10).0 (* troupecheck[prop_bad_do_att] authority *) +in troupecheck[prop_bad_do_att] authority end \ No newline at end of file From 7e0c896d27ff9e33475e0901af9879321462e072 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 13 May 2024 15:11:14 +0200 Subject: [PATCH 092/121] Running both a positive and a negative test --- troupecheck/battleship/battleship-game.trp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index fb9ce43..7460ab3 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -388,5 +388,5 @@ Testing the game host using TroupeCheck end val game = spawn(fn () => game p1 p2 1) *) -in troupecheck[prop_bad_do_att] authority +in troupecheck[prop_do_att_test, prop_bad_do_att] authority end \ No newline at end of file From 4858ae6d52954288995f04711e3ba03fd4115e7a Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 13 May 2024 15:16:08 +0200 Subject: [PATCH 093/121] Removed unnecessary functions --- troupecheck/battleship/battleship-game.trp | 65 +--------------------- 1 file changed, 1 insertion(+), 64 deletions(-) diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index 7460ab3..a103355 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -1,13 +1,7 @@ import lists import timeout import troupecheck -let fun write x = - fwrite ((getStdout authority), x) - - fun print_board b = - foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b - - fun make_row (f, i) = +let fun make_row (f, i) = case i of 0 => [] | _ => append (make_row (f, i-1)) [f i] @@ -121,9 +115,6 @@ Testing the game host using TroupeCheck fun for_i body acc 0 = acc.0 | for_i body acc to = for_i body (body acc) (to-1) - fun write x = - fwrite ((getStdout authority), x) - fun bound_from_ship ship = case ship of "C" => 5 @@ -131,15 +122,6 @@ Testing the game host using TroupeCheck | "S" => 3 | "D" => 2 - fun print_board b = - write "\n"; - foldl (fn (x,_) => foldl (fn (y,_) => write (" "^y^" ")) () x; write "\n")() b - - fun make_row (f, i) = - case i of - 0 => [] - | _ => append (make_row (f, i-1)) [f i] - fun update_board_creation board_or_error coordinate = case getType board_or_error of "string" => board_or_error @@ -343,50 +325,5 @@ Testing the game host using TroupeCheck fun prop_bad_do_att() = for_all ([(labeled_value [`{alice}`, `{bob}`] board_ships_gen), attack_gen], test_bad_do_attack) - - - fun init_tc auth rng = - receive [hn ("REQUEST_RNG", senderid) => - let val _ = send (senderid, rng) - in init_tc auth rng end, - - hn ("REQUEST_AUTH", senderid) => - let val _ = send (senderid, auth) - in init_tc auth rng end, - - hn ("UPDATE_RNG", senderid, new_rng) => - let val _ = send(senderid, "done") in - init_tc auth new_rng end] - fun rec_rng ls = - receive [hn ("REQUEST_RND", senderid) => - let val rnd = random() - val _ = send (senderid, rnd) - in rec_rng (append ls [rnd]) - end, - hn ("REQUEST_SEQ", senderid) => - let val _ = send (senderid, ls) - in rec_rng [] - end] - - val rng_recorder = spawn (fn() => rec_rng []) - val tco = spawn (fn() => init_tc authority rng_recorder) - val (board, ships) = board_ships_gen tco 10 - (*fun playerfun() = - receive [hn ("YOURTURN", senderid) => let val _ = print "YOURTURN" - val _ = send(senderid, (("ATTACK", (1,2)), self())) - in playerfun() end, - hn x => let val _ = print x in playerfun() end] - val p1_id = spawn (fn() => playerfun()) - val p2_id = spawn (fn() => playerfun()) - val p1 = - let val (board, ships) = board_ships_gen tco 10 - in {board = (board raisedTo `{p1}`), id = p1_id, ships = (ships raisedTo `{p1}`)} - end - val p2 = - let val (board, ships) = board_ships_gen tco 10 - in {board = (board raisedTo `{p2}`), id = p2_id, ships = (ships raisedTo `{p2}`)} - end - val game = spawn(fn () => game p1 p2 1) *) - in troupecheck[prop_do_att_test, prop_bad_do_att] authority end \ No newline at end of file From 57b69dbd1e728ed7ec08d84f30b7939380d6df78 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Tue, 14 May 2024 11:07:00 +0200 Subject: [PATCH 094/121] fixed shrinking of lists to work more efficiently --- lib/troupecheck.trp | 29 ++++---- troupecheck/Makefile | 5 +- troupecheck/tc_tests/general-testing.trp | 2 +- troupecheck/tc_tests/shrinking-tests.trp | 86 ++++++++++++++++++++++++ 4 files changed, 106 insertions(+), 16 deletions(-) create mode 100644 troupecheck/tc_tests/shrinking-tests.trp diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 4ecd335..7628465 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -183,13 +183,14 @@ Different utility functions that are used across the library. dec_nth_aux list [] 0 end fun dec_all seq = - let fun dec_all_aux [] i = [] + let val rev_seq = reverse seq + fun dec_all_aux [] i = [] | dec_all_aux (x::xs) i = if x = 0 then dec_all_aux xs (i+1) else - append [(fn () => (dec_nth seq i))] [fn () => dec_all_aux xs (i+1)] in - dec_all_aux seq 0 end + append [(fn () => reverse (dec_nth rev_seq i))] [fn () => dec_all_aux xs (i+1)] in + dec_all_aux rev_seq 0 end fun seqs_of_seq sequence lengths = let fun aux seq acc 0 = (acc, seq) @@ -213,9 +214,9 @@ Different utility functions that are used across the library. -------------------------------- SHRINKING -Works by first using random shrinking when a failing example has been found (shrink & random_shrink_aux). +Works by first using random shrinking when a failing example has been found (shrink & random_internal_shrink_aux). Random shrinking means simply generating new test cases with gradually smaller size, to find a case smaller than the original one. This rarely produces a minmal result. -The smallest randomly shrunk instance is then further shrunk using integrated shrinking. (internal_shrink & shrink_aux) +The smallest randomly shrunk instance is then further shrunk using integrated shrinking. (internal_shrink & internal_shrink_aux) Integrated shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (produce_rng, rc_rng & rep_rng). @@ -261,7 +262,7 @@ All of these functions are spawned and then requests or updates may be send to t hn ("UPDATE_LS", new_ls) => rep_rng new_ls] - fun shrink_aux seqs gens lengths prop pre size counter tco = + fun internal_shrink_aux seqs gens lengths prop pre size counter tco = let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] in case seqs of @@ -281,7 +282,7 @@ All of these functions are spawned and then requests or updates may be send to t val precond_is_met = if (pre <> ()) then (apply_args pre test_args tco) else true in case (apply_args prop test_args tco) orelse (precond_is_met = false) of - true => shrink_aux (x1::x3()) gens lengths prop pre size counter tco + true => internal_shrink_aux (x1::x3()) gens lengths prop pre size counter tco | false => internal_shrink ret_seqs gens prop pre size (counter+1) tco end | (x::xs) => @@ -299,7 +300,7 @@ All of these functions are spawned and then requests or updates may be send to t val arg = y tco (size+1) in arg end) gens in {shrunk_ctx = res, count = counter} end - | false => shrink_aux [x] gens lengths prop pre (size-1) counter tco + | false => internal_shrink_aux [x] gens lengths prop pre (size-1) counter tco end end @@ -308,16 +309,16 @@ All of these functions are spawned and then requests or updates may be send to t let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences in if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then - shrink_aux [fn () => seqs_comb] gens seq_lengths prop pre size counter tco + internal_shrink_aux [fn () => seqs_comb] gens seq_lengths prop pre size counter tco else let val decreased_seqs = dec_all seqs_comb val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs - val res = shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) tco + val res = internal_shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) tco in res end end - fun random_shrink_aux sequences generators prop pre success size counter divi tco = + fun random_internal_shrink_aux sequences generators prop pre success size counter divi tco = if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] @@ -332,16 +333,16 @@ All of these functions are spawned and then requests or updates may be send to t val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true in case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of - true => random_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco + true => random_internal_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco | false => - random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco + random_internal_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco end fun shrink sequence generators prop pre size counter tco = let val rng_recorder = spawn (fn() => rec_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) val _ = receive [hn x => ()] - val res = random_shrink_aux sequence generators prop pre 0 size counter 2 tco + val res = random_internal_shrink_aux sequence generators prop pre 0 size counter 2 tco val rng_replayer = spawn (fn() => rep_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) val _ = receive [hn x => ()] diff --git a/troupecheck/Makefile b/troupecheck/Makefile index 64d52b2..b38299f 100644 --- a/troupecheck/Makefile +++ b/troupecheck/Makefile @@ -2,4 +2,7 @@ TLOCAL=$(TROUPE)/local.sh tc-tests: $(TLOCAL) ./tc_tests/general-testing.trp - $(TLOCAL) ./tc_tests/userguide-tests.trp \ No newline at end of file + $(TLOCAL) ./tc_tests/userguide-tests.trp + +tc-shrink-tests: + $(TLOCAL) ./tc_tests/shrinking-tests.trp \ No newline at end of file diff --git a/troupecheck/tc_tests/general-testing.trp b/troupecheck/tc_tests/general-testing.trp index e91261f..b0628c6 100644 --- a/troupecheck/tc_tests/general-testing.trp +++ b/troupecheck/tc_tests/general-testing.trp @@ -162,7 +162,7 @@ see 'FUNCTIONS FOR TESTING'. fun prop_abs_value() = for_all ([(one_of_two (integer(), float()))], abs_value_is_always_pos) fun prop_floor() = for_all ([float()], my_floor_test) fun prop_my_length() = for_all ([list(integer())], my_length_test) - fun prop_make_list_test() = for_all ([generator(), pos_integer()], make_list_test) + fun prop_make_list_test() = for_all ([generator(), integer(0, 10)], make_list_test) fun prop_my_ceil1() = for_all ([float()], my_ceil1_test) fun prop_my_ceil2() = for_all ([float()], my_ceil2_test) fun prop_both_ceil() = for_all ([float()], both_ceil_test) diff --git a/troupecheck/tc_tests/shrinking-tests.trp b/troupecheck/tc_tests/shrinking-tests.trp new file mode 100644 index 0000000..512e9a1 --- /dev/null +++ b/troupecheck/tc_tests/shrinking-tests.trp @@ -0,0 +1,86 @@ +(* + This file is purely for testing different aspects of how well TroupeCheck handles shrinking. + If any changes are made to the shrinking part of the TC library, it is a good idea to run all of these, and + check that the shrinks look as one would expect. + They can be run with the command 'make tc-shrink-tests' from the troupecheck folder. +*) +import troupecheck +import lists +(* +-------------------------------- +UTILITY FUNCTIONS FOR +BOOLEAN STATEMENTS. + +-------------------------------- +*) +let fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs + + fun bad_half n = + if n > 10 then n else n/2 +(* +-------------------------------- +BOOLEAN STATEMENTS FOR TESTING. + +-------------------------------- +*) + fun shrink_test x y z w = x+y+z+w < 100 + + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + + fun test_bad_half n = + n > (bad_half n) + + fun record_shrink_test r = + r.theInteger < 50 + + fun append_always_longer s1 s2 = + let fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) + in aux xs (append acc [x]) + end + in aux s [] + end + fun string_length s = + length (string_to_list s) + in string_length s1 < string_length (s1 ^ s2) + end + + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + +(* +-------------------------------- +PROPERTIES TO RUN WITH TROUPECHECK. + +-------------------------------- +*) + fun prop_append_always_longer() = for_all ([string(), string()], append_always_longer) + fun prop_bad_insert() = for_all ([list(integer()), integer()], test_bad_insert) + fun prop_bad_half() = for_all ([integer()], (test_bad_half, (fn x => x >= 15))) + fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) + fun prop_shrink_test() = for_all ([integer(), integer(), integer(), integer()], shrink_test) + fun prop_keep_length() = for_all ([list(integer())], my_sort_keep_length) + val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, prop_shrink_test, prop_keep_length] +in troupecheck prop_list authority +end \ No newline at end of file From c4c42fde64e7a4cb2fc37b47de1387c619523e28 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 15 May 2024 10:58:00 +0200 Subject: [PATCH 095/121] removed unnecessary function spawing in troupecheckfunction --- lib/troupecheck.trp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 7628465..7d93f60 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -548,9 +548,7 @@ Handles running the tests (core_forall), shrinking, preparing the recorder RNG a fun troupecheck_aux [] i = exit (auth, 0) | troupecheck_aux (x::xs) i = let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") auth - val self_id = self() - val _ = spawn (fn () => let val _ = (x() auth) in send(self_id, "done") end ) - val _ = receive [hn x => ()] + val _ = x() auth in troupecheck_aux xs (i+1) end in troupecheck_aux props 1 end From b477fc4947048c2654609741fcfab5a78601b802 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 15 May 2024 10:58:20 +0200 Subject: [PATCH 096/121] prog_gen testing --- .../language-interpreter/test-language.trp | 181 ++++++++++++++++++ 1 file changed, 181 insertions(+) create mode 100644 troupecheck/language-interpreter/test-language.trp diff --git a/troupecheck/language-interpreter/test-language.trp b/troupecheck/language-interpreter/test-language.trp new file mode 100644 index 0000000..5b2f9cc --- /dev/null +++ b/troupecheck/language-interpreter/test-language.trp @@ -0,0 +1,181 @@ +import troupecheck +import lists +(* +-------------------------------- +CUSTOM TYPE PROGRAM + +Used for testing the creation of complex custom generators. +Here we defined an interpreter and generator for simple programs consisting of: +expr := ("num", number) |("var", string) |("add", expr, expr) |("sub", expr, expr) |("mul", expr, expr) |("div", expr, expr) +stmt := ("assign", string, expr) |("print", expr) +prog := [[stmt], expr] + +-------------------------------- +*) +let fun eval exp env = + case exp of + ("num", n) => n + | ("var", n) => lookup env n ("unknown variable " ^ n) + | ("add", e1, e2) => (eval e1 env) + (eval e2 env) + | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) + | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) + | ("div", e1, e2) => (eval e1 env) / (eval e2 env) + | _ => print ("Error: ill defined expression"); exit (authority, 1) + + fun execute stmt env = + case stmt of + ("assign", var, exp) => + let val value = eval exp env + in + append [(var, value)] env + end + | ("print", exp) => (()(* print ("from prog: " ^ (toString (eval exp env)) *); env) + + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun interpret prog = + let fun interpretHelper [] env = env + | interpretHelper (stmt :: rest) env = + let val newEnv = execute stmt env + in + interpretHelper rest newEnv + end + val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + val last_env = (interpretHelper stmts []) + in + eval exp last_env + end + + fun optimize_prog prog = + let val stmts = remove_nth ((length prog)-1) prog 0 + val exp = nth prog (length prog) + fun optimize_exp exp = + case exp of + ("num", n) => ("num", n) + | ("var", x) => ("var", x) + | ("add", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1+n2)) + |_ => ("add", (optimize_exp e1), (optimize_exp e2))) + | _ => ("add", (optimize_exp e1), (optimize_exp e2))) + | ("sub", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1-n2)) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2))) + | ("mul", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1*n2)) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2))) + | ("div", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => if ((n1 = 0) andalso (n2 = 0)) then ("div", e1, e2) else ("num", (n1/n2)) + |_ => ("div", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("div", (optimize_exp e1), (optimize_exp e2))) + + fun optimize_stmt stmt = + case stmt of + ("assign", var, exp) => ("assign", var, (optimize_exp exp)) + | ("print", exp) => ("print", (optimize_exp exp)) + in + append (map optimize_stmt stmts) [optimize_exp exp] + end + + fun exp_gen ls nesting_level tco size = + let val exp_ts = + if nesting_level = 2 then ["num"] + else (if length ls = 0 then ["num", "add", "sub", "mul", "div"] + else ["var", "num", "add", "sub", "mul", "div"]) + val exp_type = one_of exp_ts tco size + in + case exp_type of + "num" => + let val value = integer(1, inf) tco size in + ("num", value) end + | "var" => + let val value = one_of ls tco size in + ("var", value) end + |"add" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("add", e1, e2) + end + |"sub" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("sub", e1, e2) + end + |"mul" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("mul", e1, e2) + end + |"div" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("div", e1, e2) + end + end + + fun assign_stmt_gen ls tco size = + let val n = string() tco size + val exp = exp_gen ls 0 tco size + in + ("assign", n, exp) + end + + fun print_stmt_gen ls tco size = + let val exp = exp_gen ls 0 tco size + in + ("print", exp) + end + + fun stmt_gen ls tco size = + let val stmt = one_of ["print", "assign"] tco size + in + case stmt of + "assign" => + let val res = assign_stmt_gen ls tco size in + res end + |"print" => + let val res = print_stmt_gen ls tco size in + res end + end + + fun program_gen tco size = + let val num_of_insts = (integer(0, size) tco size) + fun prog_gen_aux env p 0 = (p, env) + | prog_gen_aux env p i = + let val stmt = stmt_gen env tco size + val newEnv = if stmt.0 = "assign" then (append [stmt.1] env) else env + in + prog_gen_aux newEnv (append p [stmt]) (i-1) + end + val (prog_stmts, last_env) = prog_gen_aux [] [] num_of_insts + val last_exp = exp_gen last_env 0 tco size + val prog = append prog_stmts [last_exp] + in + prog + end + + fun test_prog_opt prog = + (interpret prog) = (interpret (optimize_prog prog)) + fun test_prog_shrink prog = + (interpret prog) < 100 + fun prop_program_shrink() = for_all ([program_gen], test_prog_shrink) + fun prop_program_opt() = for_all ([program_gen], test_prog_opt) +in troupecheck [prop_program_opt, prop_program_shrink] authority +end \ No newline at end of file From 937f1e84f0eea2aaf6d73bd0e2eaa2d594082f73 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 15 May 2024 11:31:48 +0200 Subject: [PATCH 097/121] Removed unecesary function from library --- lib/troupecheck.trp | 9 --------- 1 file changed, 9 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 7d93f60..f507ac2 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -224,15 +224,6 @@ All of these functions are spawned and then requests or updates may be send to t -------------------------------- *) - fun produce_rng rng = - receive [hn ("REQUEST_RNG", senderid) => - let val _ = send (senderid, rng) - in produce_rng rng end, - - hn ("UPDATE_RNG", senderid, new_rng) => - let val _ = send(senderid, "done") in - produce_rng new_rng end] - fun rec_rng ls = receive [hn ("REQUEST_RND", senderid) => let val rnd = random() From a0a05783a867c5d5395809cadd2aba8b332c0553 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 16 May 2024 12:20:26 +0200 Subject: [PATCH 098/121] Updated internal shrinking to be both faster, and producer better results --- lib/troupecheck.trp | 47 +++++++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 19 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index f507ac2..97a3dfb 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -172,25 +172,34 @@ Different utility functions that are used across the library. |_ => (2, 3, 4, 5) fun dec_nth list idx = - let fun dec_nth_aux [] acc i = acc - | dec_nth_aux (x::xs) acc i = - case i = idx of - true => - let val dec_val = if x <= 1/1000000 then 0 else x/2 in - dec_nth_aux xs (append acc [dec_val]) (i+1) end - | false => dec_nth_aux xs (append acc [x]) (i+1) + let fun dec_nth_aux [] acc i = acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => + let val dec_val = if x <= 1/100 then 0 else x/2 in + append (append acc [dec_val]) xs end + | false => dec_nth_aux xs (append acc [x]) (i+1) in dec_nth_aux list [] 0 end + + fun zero_nth list idx = + let fun zero_nth_aux [] acc i = acc + | zero_nth_aux (x::xs) acc i = + case i = idx of + true => + append (append acc [0]) xs + | false => zero_nth_aux xs (append acc [x]) (i+1) + in + zero_nth_aux list [] 0 end fun dec_all seq = - let val rev_seq = reverse seq - fun dec_all_aux [] i = [] + let fun dec_all_aux [] i = [] | dec_all_aux (x::xs) i = if x = 0 then dec_all_aux xs (i+1) else - append [(fn () => reverse (dec_nth rev_seq i))] [fn () => dec_all_aux xs (i+1)] in - dec_all_aux rev_seq 0 end + [(fn () => (zero_nth seq i)), (fn() => [fn () => (dec_nth seq i), fn () => dec_all_aux xs (i+1)])] in + dec_all_aux seq 0 end fun seqs_of_seq sequence lengths = let fun aux seq acc 0 = (acc, seq) @@ -214,12 +223,12 @@ Different utility functions that are used across the library. -------------------------------- SHRINKING -Works by first using random shrinking when a failing example has been found (shrink & random_internal_shrink_aux). +Works by first using random shrinking when a failing example has been found (shrink & random_shrink_aux). Random shrinking means simply generating new test cases with gradually smaller size, to find a case smaller than the original one. This rarely produces a minmal result. -The smallest randomly shrunk instance is then further shrunk using integrated shrinking. (internal_shrink & internal_shrink_aux) -Integrated shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. +The smallest randomly shrunk instance is then further shrunk using internal shrinking. (internal_shrink & internal_shrink_aux) +Internal shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. -This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (produce_rng, rc_rng & rep_rng). +This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (rec_rng & rep_rng). All of these functions are spawned and then requests or updates may be send to them, so that the correct RNG's are used at different points in the code. -------------------------------- @@ -309,7 +318,7 @@ All of these functions are spawned and then requests or updates may be send to t res end end - fun random_internal_shrink_aux sequences generators prop pre success size counter divi tco = + fun random_shrink_aux sequences generators prop pre success size counter divi tco = if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] @@ -324,16 +333,16 @@ All of these functions are spawned and then requests or updates may be send to t val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true in case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of - true => random_internal_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco + true => random_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco | false => - random_internal_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco end fun shrink sequence generators prop pre size counter tco = let val rng_recorder = spawn (fn() => rec_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) val _ = receive [hn x => ()] - val res = random_internal_shrink_aux sequence generators prop pre 0 size counter 2 tco + val res = random_shrink_aux sequence generators prop pre 0 size counter 2 tco val rng_replayer = spawn (fn() => rep_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) val _ = receive [hn x => ()] From ae8f669a8d7bfc23bcd6da51a11b272dcef2a0de Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Thu, 16 May 2024 12:30:58 +0200 Subject: [PATCH 099/121] Updated shrinking tests --- troupecheck/tc_tests/shrinking-tests.trp | 27 ++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/troupecheck/tc_tests/shrinking-tests.trp b/troupecheck/tc_tests/shrinking-tests.trp index 512e9a1..9f31cec 100644 --- a/troupecheck/tc_tests/shrinking-tests.trp +++ b/troupecheck/tc_tests/shrinking-tests.trp @@ -19,7 +19,7 @@ let fun filter_less ([], _) = [] fun filter_greater ([], _) = [] | filter_greater ((x::xs), p) = - if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) fun my_quicksort [] = [] @@ -28,12 +28,31 @@ let fun filter_less ([], _) = [] val greater = my_quicksort(filter_greater(xs, x)) in append (append smaller [x]) (greater) end + fun filter_less2 ([], _) = [] + | filter_less2 ((x::xs), p) = + if (x < p) andalso (x<>0) then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater2 ([], _) = [] + | filter_greater2 ((x::xs), p) = + if (x > p) orelse (x = 0) then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + fun my_quicksort2 [] = [] + | my_quicksort2 (x::xs) = + let val smaller = my_quicksort2(filter_less2(xs, x)) + val greater = my_quicksort2(filter_greater2(xs, x)) in + append (append smaller [x]) (greater) end + fun bad_insert xs x = if length xs < 10 then append [x] xs else xs fun bad_half n = if n > 10 then n else n/2 + + fun ordered [] = true + | ordered (x::[]) = true + | ordered (x::y::ys) = + if x <= y then ordered (y::ys) else false (* -------------------------------- BOOLEAN STATEMENTS FOR TESTING. @@ -69,6 +88,9 @@ BOOLEAN STATEMENTS FOR TESTING. fun my_sort_keep_length xs = length xs = length (my_quicksort(xs)) + fun mysort2_is_ordered xs = + ordered (my_quicksort2 xs) + (* -------------------------------- PROPERTIES TO RUN WITH TROUPECHECK. @@ -81,6 +103,7 @@ PROPERTIES TO RUN WITH TROUPECHECK. fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) fun prop_shrink_test() = for_all ([integer(), integer(), integer(), integer()], shrink_test) fun prop_keep_length() = for_all ([list(integer())], my_sort_keep_length) - val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, prop_shrink_test, prop_keep_length] + fun prop_mysort2_ordered() = for_all ([list(integer())], mysort2_is_ordered) + val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, prop_shrink_test, prop_keep_length, prop_mysort2_ordered] in troupecheck prop_list authority end \ No newline at end of file From 46860a7993510c52ad2207042dc2aa736a814ec4 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 17 May 2024 11:21:09 +0200 Subject: [PATCH 100/121] Updated make_list to not spawn several functions, since this ruined the shrinking abit --- lib/troupecheck.trp | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 97a3dfb..7543fd5 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -97,7 +97,7 @@ Different utility functions that are used across the library. | _ => append [f_aux()] (make_ls_aux (f_aux, n-1)) val self_id = self() fun func (l) = let val res = make_ls_aux (f, l) in send (self_id, (res)) end - val res = divide_list_work func i 4 + val res = divide_list_work func i 1 in res end @@ -176,7 +176,7 @@ Different utility functions that are used across the library. | dec_nth_aux (x::xs) acc i = case i = idx of true => - let val dec_val = if x <= 1/100 then 0 else x/2 in + let val dec_val = if x <= 1/10000 then 0 else x/(5/4) in append (append acc [dec_val]) xs end | false => dec_nth_aux xs (append acc [x]) (i+1) in @@ -198,7 +198,7 @@ Different utility functions that are used across the library. if x = 0 then dec_all_aux xs (i+1) else - [(fn () => (zero_nth seq i)), (fn() => [fn () => (dec_nth seq i), fn () => dec_all_aux xs (i+1)])] in + [(fn () => (zero_nth seq i)), (fn() => [fn () => (dec_nth seq i), fn () => dec_all_aux xs (i+1)])] in dec_all_aux seq 0 end fun seqs_of_seq sequence lengths = @@ -265,6 +265,8 @@ All of these functions are spawned and then requests or updates may be send to t fun internal_shrink_aux seqs gens lengths prop pre size counter tco = let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] in case seqs of (x1::x2::x3::xs) => let val seqs_of_curr = seqs_of_seq (x2()) lengths @@ -280,6 +282,9 @@ All of these functions are spawned and then requests or updates may be send to t if (length x) = 0 then (nth seqs_of_curr (i+1)) else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs val precond_is_met = if (pre <> ()) then (apply_args pre test_args tco) else true + val _ = write ("\norg seq= " ^ (toString seqs_of_curr) ^ "\n") auth + val _ = write ("\nseq= " ^ (toString ret_seqs) ^ "\n") auth + val _ = write ("\nargs= " ^ (toString test_args) ^ "\n") auth in case (apply_args prop test_args tco) orelse (precond_is_met = false) of true => internal_shrink_aux (x1::x3()) gens lengths prop pre size counter tco @@ -474,7 +479,7 @@ However, it can be done if the users wishes to and understands what is going on. -------------------------------- CORE FUNCTIONALITY -Handles running the tests (core_forall), shrinking, preparing the recorder RNG and reporting the results to the user (tc). +Handles preparing the recorder RNG, running the tests, calling the shrinker, and reporting the results to the user. -------------------------------- *) From 81a1e5cbd50934ba01913e85a2e796ddc1429bdb Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 17 May 2024 11:21:55 +0200 Subject: [PATCH 101/121] Updated shrinking tests --- troupecheck/tc_tests/shrinking-tests.trp | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/troupecheck/tc_tests/shrinking-tests.trp b/troupecheck/tc_tests/shrinking-tests.trp index 9f31cec..d276b88 100644 --- a/troupecheck/tc_tests/shrinking-tests.trp +++ b/troupecheck/tc_tests/shrinking-tests.trp @@ -30,11 +30,11 @@ let fun filter_less ([], _) = [] fun filter_less2 ([], _) = [] | filter_less2 ((x::xs), p) = - if (x < p) andalso (x<>0) then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + if ((x < p) andalso (x<>0)) orelse (p = 0) then append [x] (filter_less2 (xs, p)) else (filter_less2 (xs, p)) fun filter_greater2 ([], _) = [] | filter_greater2 ((x::xs), p) = - if (x > p) orelse (x = 0) then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + if ((x > p) andalso (p<>0)) orelse (x = 0) then append [x] (filter_greater2 (xs, p)) else (filter_greater2 (xs, p)) fun my_quicksort2 [] = [] | my_quicksort2 (x::xs) = @@ -104,6 +104,7 @@ PROPERTIES TO RUN WITH TROUPECHECK. fun prop_shrink_test() = for_all ([integer(), integer(), integer(), integer()], shrink_test) fun prop_keep_length() = for_all ([list(integer())], my_sort_keep_length) fun prop_mysort2_ordered() = for_all ([list(integer())], mysort2_is_ordered) - val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, prop_shrink_test, prop_keep_length, prop_mysort2_ordered] + val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, + prop_shrink_test, prop_keep_length, prop_mysort2_ordered] in troupecheck prop_list authority -end \ No newline at end of file +end \ No newline at end of file From 4f10b472afc76220d58f4a3a5d12cdb44491da51 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sat, 18 May 2024 16:04:06 +0200 Subject: [PATCH 102/121] Shrinking lists now works!! + added some testing to shrinking --- lib/troupecheck.trp | 82 +++++++++++++++++------- troupecheck/tc_tests/shrinking-tests.trp | 30 +++++++-- 2 files changed, 85 insertions(+), 27 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 7543fd5..8a59648 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -217,8 +217,8 @@ Different utility functions that are used across the library. aux xs (append acc [x]) (i-1) in aux list [] idx end - fun for_i body 0 = body() - | for_i body to = body(); for_i body (to-1) + fun for_i f y 0 = y + | for_i f y i = for_i f (f (i,y)) (i-1) (* -------------------------------- SHRINKING @@ -261,6 +261,40 @@ All of these functions are spawned and then requests or updates may be send to t end, hn ("UPDATE_LS", new_ls) => rep_rng new_ls] + + fun shrink_sized_sequence seqs gens prop pre size left_over_len idx_of_sized tco = + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + (* val _ = write ("\nseq length: " ^ (toString (length (nth seqs (idx_of_sized+1)))) ^ "\n") auth + val _ = write ("\nleft over length: " ^ (toString left_over_len) ^ "\n") auth *) + val cap = ceil (((length (nth seqs (idx_of_sized+1)))-2)/left_over_len )(* number of elements in the generated list *) + val size_ls = for_i (fn (x,y) => append y [x]) [] (left_over_len-1) + fun aux i = + let val to_remove = foldl (fn (x,y) => append y [(i*left_over_len)-x])[i*left_over_len] size_ls + val new_seq = foldl (fn (x,y) => remove_nth x y 0) (nth seqs (idx_of_sized+1)) to_remove + val new_seqs = mapi (fn (i, x) => if i = idx_of_sized then new_seq else x) seqs + val new_args = mapi (fn (i, x) => + let val _ = send (pid, ("UPDATE_LS", (nth new_seqs (i+1)))) + val arg = x tco size + in arg + end) gens + in case i = (cap) of + true => + (new_seqs, new_args) + | false => + let val precond_is_met = if (pre <> ()) then (apply_args pre new_args tco) else true + in case (apply_args prop new_args tco) orelse (precond_is_met = false) of + true => aux (i+1) + | false => (new_seqs, new_args) (* shrink_sized_sequence new_seqs gens prop pre size idx_of_sized tco *) + end + end + (* val _ = write ("\ncap: " ^ (toString cap) ^ "\n") auth *) + in aux 1 + end + + fun internal_shrink_aux seqs gens lengths prop pre size counter tco = let val _ = send(tco, ("REQUEST_RNG", self())) @@ -278,18 +312,22 @@ All of these functions are spawned and then requests or updates may be send to t in {arg = arg, left_overs = left_overs} end) gens val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.arg], append left_overs [x.left_overs])) ([],[]) args_and_leftovers - val ret_seqs = mapi (fn (i,x) => + (* val ret_seqs = mapi (fn (i,x) => if (length x) = 0 then (nth seqs_of_curr (i+1)) - else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs - val precond_is_met = if (pre <> ()) then (apply_args pre test_args tco) else true - val _ = write ("\norg seq= " ^ (toString seqs_of_curr) ^ "\n") auth - val _ = write ("\nseq= " ^ (toString ret_seqs) ^ "\n") auth - val _ = write ("\nargs= " ^ (toString test_args) ^ "\n") auth - in - case (apply_args prop test_args tco) orelse (precond_is_met = false) of - true => internal_shrink_aux (x1::x3()) gens lengths prop pre size counter tco - | false => internal_shrink ret_seqs gens prop pre size (counter+1) tco - end + else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs *) + val (is_sized_sequence, idx_of_sized, left_over_size, _) = foldl (fn (x,(bool, idx, len, count)) => if (length x > 0) + then (true, count, (length x), (count+1)) + else (bool, idx, len, (count+1))) (false, -1, 0, 0) left_over_seqs + + val (ret_seqs, args) = if is_sized_sequence + then shrink_sized_sequence seqs_of_curr gens prop pre size left_over_size idx_of_sized tco + else (seqs_of_curr, test_args) + val precond_is_met = if (pre <> ()) then (apply_args pre args tco) else true + in + case (apply_args prop args tco) orelse (precond_is_met = false) of + true => internal_shrink_aux (x1::x3()) gens lengths prop pre size counter tco + | false => internal_shrink ret_seqs gens prop pre size (counter+1) tco + end | (x::xs) => let val seqs_of_curr = seqs_of_seq (x()) lengths val test_args = mapi (fn (i, y) => @@ -351,6 +389,8 @@ All of these functions are spawned and then requests or updates may be send to t val rng_replayer = spawn (fn() => rep_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) val _ = receive [hn x => ()] + val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] in internal_shrink (res.sequences) generators prop pre res.size (res.count) tco end (* @@ -464,16 +504,12 @@ However, it can be done if the users wishes to and understands what is going on. (* TODO: needs to be completed... *) fun generator_gen tco size = - let val rnd = int_gen (1,7) size - val inf = 1/0 - val res = if rnd = 1 then ((fn i => int_gen (inf, inf) tco i)) else - if rnd = 2 then ((fn i => bool_gen tco i)) else - if rnd = 3 then ((fn i => float_gen (inf, inf) tco i)) else - if rnd = 4 then ((fn i => string_gen tco i)) else - if rnd = 5 then ((fn i => char_gen tco i)) else - if rnd = 6 then ((fn i => tuple_gen (make_list ((fn () => int_gen(inf, inf) tco i), i)) tco i)) else - ((fn i => list_gen (int_gen(inf, inf)) tco i)) in - res end + let val inf = 1/0 + val gens_ls = [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, (list_gen(generator_gen tco size)), char_gen, string_gen, + (tuple_gen (list_gen(generator_gen tco size))), (rec_gen (list_gen(string_gen)) ((generator_gen tco size))), + (labeled_value_gen (list_gen(string_gen)) (generator_gen tco size))] + val gen = one_of gens_ls + in gen end (* -------------------------------- diff --git a/troupecheck/tc_tests/shrinking-tests.trp b/troupecheck/tc_tests/shrinking-tests.trp index d276b88..641d8c4 100644 --- a/troupecheck/tc_tests/shrinking-tests.trp +++ b/troupecheck/tc_tests/shrinking-tests.trp @@ -30,7 +30,7 @@ let fun filter_less ([], _) = [] fun filter_less2 ([], _) = [] | filter_less2 ((x::xs), p) = - if ((x < p) andalso (x<>0)) orelse (p = 0) then append [x] (filter_less2 (xs, p)) else (filter_less2 (xs, p)) + if ((x <= p) andalso (x<>0)) orelse (p = 0) then append [x] (filter_less2 (xs, p)) else (filter_less2 (xs, p)) fun filter_greater2 ([], _) = [] | filter_greater2 ((x::xs), p) = @@ -42,9 +42,27 @@ let fun filter_less ([], _) = [] val greater = my_quicksort2(filter_greater2(xs, x)) in append (append smaller [x]) (greater) end + fun filter_less3 ([], _) = [] + | filter_less3((x::xs), p) = + if (x < p)andalso (x<>15) then append [x] (filter_less3 (xs, p)) else (filter_less3 (xs, p)) + + fun filter_greater3 ([], _) = [] + | filter_greater3 ((x::xs), p) = + if (x >= p) andalso (x<>15) then append [x] (filter_greater3 (xs, p)) else (filter_greater3 (xs, p)) + + fun my_quicksort3 [] = [] + | my_quicksort3 (x::xs) = + let val smaller = my_quicksort3(filter_less3(xs, x)) + val greater = my_quicksort3(filter_greater3(xs, x)) in + append (append smaller [x]) (greater) end + + + + + fun bad_insert xs x = - if length xs < 10 then append [x] xs else - xs + if length xs < 10 then append [x] xs else + xs fun bad_half n = if n > 10 then n else n/2 @@ -91,6 +109,9 @@ BOOLEAN STATEMENTS FOR TESTING. fun mysort2_is_ordered xs = ordered (my_quicksort2 xs) + fun mysort3_keep_length xs = + length xs = length (my_quicksort3(xs)) + (* -------------------------------- PROPERTIES TO RUN WITH TROUPECHECK. @@ -104,7 +125,8 @@ PROPERTIES TO RUN WITH TROUPECHECK. fun prop_shrink_test() = for_all ([integer(), integer(), integer(), integer()], shrink_test) fun prop_keep_length() = for_all ([list(integer())], my_sort_keep_length) fun prop_mysort2_ordered() = for_all ([list(integer())], mysort2_is_ordered) + fun prop_mysort3_keep_length() = for_all ([list(integer())], mysort3_keep_length) val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, - prop_shrink_test, prop_keep_length, prop_mysort2_ordered] + prop_shrink_test, prop_keep_length, prop_mysort2_ordered, prop_mysort3_keep_length] in troupecheck prop_list authority end \ No newline at end of file From 79afe116d3f1d01ba408e7cea588da5109a4ab27 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sat, 18 May 2024 16:11:37 +0200 Subject: [PATCH 103/121] Only comments changed --- lib/troupecheck.trp | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 8a59648..2a231eb 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -267,9 +267,7 @@ All of these functions are spawned and then requests or updates may be send to t val pid = receive [hn x => x] val _ = send(tco, ("REQUEST_AUTH", self())) val auth = receive [hn x => x] - (* val _ = write ("\nseq length: " ^ (toString (length (nth seqs (idx_of_sized+1)))) ^ "\n") auth - val _ = write ("\nleft over length: " ^ (toString left_over_len) ^ "\n") auth *) - val cap = ceil (((length (nth seqs (idx_of_sized+1)))-2)/left_over_len )(* number of elements in the generated list *) + val cap = ceil (((length (nth seqs (idx_of_sized+1)))-2)/left_over_len )(* number of to remove parts of the sequence *) val size_ls = for_i (fn (x,y) => append y [x]) [] (left_over_len-1) fun aux i = let val to_remove = foldl (fn (x,y) => append y [(i*left_over_len)-x])[i*left_over_len] size_ls @@ -287,10 +285,9 @@ All of these functions are spawned and then requests or updates may be send to t let val precond_is_met = if (pre <> ()) then (apply_args pre new_args tco) else true in case (apply_args prop new_args tco) orelse (precond_is_met = false) of true => aux (i+1) - | false => (new_seqs, new_args) (* shrink_sized_sequence new_seqs gens prop pre size idx_of_sized tco *) + | false => (new_seqs, new_args) end end - (* val _ = write ("\ncap: " ^ (toString cap) ^ "\n") auth *) in aux 1 end From 2e4573bee91982ee63c23cc1a35f3a4133668fef Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sat, 18 May 2024 16:21:36 +0200 Subject: [PATCH 104/121] Changed the divisor for decreasing choices in sequences --- lib/troupecheck.trp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 2a231eb..67f6f54 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -176,7 +176,7 @@ Different utility functions that are used across the library. | dec_nth_aux (x::xs) acc i = case i = idx of true => - let val dec_val = if x <= 1/10000 then 0 else x/(5/4) in + let val dec_val = if x <= 1/10000 then 0 else x/(3/2) in append (append acc [dec_val]) xs end | false => dec_nth_aux xs (append acc [x]) (i+1) in From 953e0d9f414d9b38cd2355ead52b754b1b82700c Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 19 May 2024 15:45:15 +0200 Subject: [PATCH 105/121] Tested two internal vs. external shrinking --- troupecheck/tc_archive/tc_ext_shrink.trp | 35 +- troupecheck/tc_tests/general-testing.trp | 11 +- troupecheck/tc_tests/shrink_comparisons.trp | 594 ++++++++++++++++++++ troupecheck/tc_tests/shrinking-tests.trp | 2 +- 4 files changed, 624 insertions(+), 18 deletions(-) create mode 100644 troupecheck/tc_tests/shrink_comparisons.trp diff --git a/troupecheck/tc_archive/tc_ext_shrink.trp b/troupecheck/tc_archive/tc_ext_shrink.trp index 08b05a8..315d47b 100644 --- a/troupecheck/tc_archive/tc_ext_shrink.trp +++ b/troupecheck/tc_archive/tc_ext_shrink.trp @@ -124,7 +124,7 @@ SHRINKING - r |"done" => rec_checked | _ => - let val new_raw_val = if (abs_value curr_val)-1 <= 0 then 0 else curr_val/2 + let val new_raw_val = if (abs_value curr_val)-1 <= 0 then 0 else curr_val-1 in {state = "cont", curr = new_raw_val, prev = rec_checked.curr} end @@ -458,7 +458,7 @@ CORE FUNCTIONALITY - a else core_forall (generator, prop, i, size+1, pre, cap)) end - fun tc_n generators p noOfTests = + fun run_tests generators p noOfTests = let val (prop, pre) = case p of (x,y) => (x,y) @@ -477,10 +477,18 @@ CORE FUNCTIONALITY - a end end - fun tc generator p = tc_n generator p 100 - - fun troupecheck generator p noOfTests = spawn (fn() => tc_n generator p noOfTests) - | troupecheck generator p = spawn (fn() => tc generator p) + fun for_all (generators, p) = run_tests generators p 100 + | for_all (generators, p, noOfTests) = run_tests generators p noOfTests + + fun troupecheck props = + let val n = toString (length props) + fun troupecheck_aux [] i = exit (authority, 0) + | troupecheck_aux (x::xs) i = + let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") + val _ = x() + in troupecheck_aux xs (i+1) end + in troupecheck_aux props 1 + end (* -------------------------------- @@ -684,10 +692,10 @@ TC^2 - z -------------------------------- *) fun tc_sort_length_always_fails () = - tc [list(integer())] my_sort_keep_length = false + for_all [list(integer())] my_sort_keep_length = false fun tc_sort_ordered_always_true () = - tc [list(integer())] my_sort_is_ordered = true + for_all [list(integer())] my_sort_is_ordered = true (* -------------------------------- @@ -940,9 +948,12 @@ CUSTOM TYPE PROGRAM fun test_prog_opt prog = (interpret prog) = (interpret (optimize_prog prog)) - val exp = exp_gen [] 0 3 - val stmt = stmt_gen [] 3 - val prog = program_gen 2 + fun test_prog_shrink prog = + (interpret prog) < 100 + fun record_shrink_test r = + r.theInteger < 50 + fun prop_program_shrink() = for_all ([program_gen], test_prog_shrink) + fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) in (* @@ -951,7 +962,7 @@ ALL TESTS - x -------------------------------- *) -tc [list(integer())] my_sort_keep_length +troupecheck[prop_record_shrink] (* tc [program_gen] test_prog_opt *) (* shrinking tests - x *) diff --git a/troupecheck/tc_tests/general-testing.trp b/troupecheck/tc_tests/general-testing.trp index b0628c6..ba35042 100644 --- a/troupecheck/tc_tests/general-testing.trp +++ b/troupecheck/tc_tests/general-testing.trp @@ -98,10 +98,11 @@ See 'FUNCTIONS FOR TESTING'. fun my_length_test xs = my_length xs = length xs - fun make_list_test generator i = - let fun f() = generator i +(* fun make_list_test generator i = + let fun dummy_tco_func() = receive [hn ("REQUEST_RND",sender) => let val _ = send (sender, random()) in dummy_tco_func end] + fun f() = generator (spawn (fn() => dummy_tco_func())) i val ls = (make_list (f, i)) in - (length ls) = i end + (length ls) = i end *) fun my_count_returns_non_negative_int x xs = (my_count x xs) >= 0 @@ -162,13 +163,13 @@ see 'FUNCTIONS FOR TESTING'. fun prop_abs_value() = for_all ([(one_of_two (integer(), float()))], abs_value_is_always_pos) fun prop_floor() = for_all ([float()], my_floor_test) fun prop_my_length() = for_all ([list(integer())], my_length_test) - fun prop_make_list_test() = for_all ([generator(), integer(0, 10)], make_list_test) + (* fun prop_make_list_test() = for_all ([generator(), integer(0, 10)], make_list_test) *) (* Doesn't work... *) fun prop_my_ceil1() = for_all ([float()], my_ceil1_test) fun prop_my_ceil2() = for_all ([float()], my_ceil2_test) fun prop_both_ceil() = for_all ([float()], both_ceil_test) val test_list = [prop_bad_insert, prop_bad_half, prop_record_shrink, prop_bool_commutative, prop_count_non_negative, prop_rec_test, prop_no_args, prop_shrink_test, prop_number_commutative, prop_list_reverse, prop_integer_interval_works, prop_abs_value, - prop_floor, prop_my_length, prop_make_list_test, prop_my_ceil1, prop_my_ceil2, prop_both_ceil] + prop_floor, prop_my_length, prop_my_ceil1, prop_my_ceil2, prop_both_ceil] in troupecheck test_list authority end \ No newline at end of file diff --git a/troupecheck/tc_tests/shrink_comparisons.trp b/troupecheck/tc_tests/shrink_comparisons.trp new file mode 100644 index 0000000..0dc2f4e --- /dev/null +++ b/troupecheck/tc_tests/shrink_comparisons.trp @@ -0,0 +1,594 @@ +import troupecheck +import lists +(* NOTE: for this program to work, troupecheck library file needs to modified to return a tuple on the form: + (<>, <>, <>, <>) + when a failing a test. + The test that is run must always fail at some point. + This program was only made to test internal vs. external shrinking, and not meant for further usage.*) +let fun record_shrink_test r = + r.theInteger < 50 + fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) + +(* +------------------------------ +INTERNAL SHRINKING + +------------------------------ +*) + fun report_error tup = + print tup.0; + exit (authority, 0) + + fun boolean_check x tco = + () + + fun function_not_done_check p tco = + () +(* +-------------------------------- +UTILS + +Different utility functions that are used across the library. + +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun divide_list_work f length num_workers = + let fun make_infols acc 1 = append acc [(length - (floor(length/num_workers) * (num_workers-1)))] + | make_infols acc i = + make_infols (append acc [floor(length/num_workers)]) (i-1) + val infols = make_infols [] num_workers + val _ = map (fn x => spawn(fn()=> f x)) infols + val res = foldl (fn (_,y) => let val res = receive[hn x => x] in append res y end)[] infols in + res end + + fun make_list (f, i) = + let fun make_ls_aux (f_aux, n)= + case n of + 0 => [] + | _ => append [f_aux()] (make_ls_aux (f_aux, n-1)) + val self_id = self() + fun func (l) = let val res = make_ls_aux (f, l) in send (self_id, (res)) end + val res = divide_list_work func i 1 + in res + end + + fun abs_value x = + if x < 0 then -x else x + +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l tco = + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + in case l of + [] => (* this case is only reached if there are no generators to begin with *) + let val _ = boolean_check (p()) tco + val res = p() + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l + val _ = boolean_check res tco + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + end + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + (* Combines a list of individual strings to a single string *) + fun list_to_string ls tco = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) tco else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + (* Hardcoded until a tuple from list function is implemented in Troupe - an issue has been raised on GH.*) + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) + + fun dec_nth list idx = + let fun dec_nth_aux [] acc i = acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => + let val dec_val = if x <= 1/10000 then 0 else x/(3/2) in + append (append acc [dec_val]) xs end + | false => dec_nth_aux xs (append acc [x]) (i+1) + in + dec_nth_aux list [] 0 end + + fun zero_nth list idx = + let fun zero_nth_aux [] acc i = acc + | zero_nth_aux (x::xs) acc i = + case i = idx of + true => + append (append acc [0]) xs + | false => zero_nth_aux xs (append acc [x]) (i+1) + in + zero_nth_aux list [] 0 end + + fun dec_all seq = + let fun dec_all_aux [] i = [] + | dec_all_aux (x::xs) i = + if x = 0 then + dec_all_aux xs (i+1) + else + [(fn () => (zero_nth seq i)), (fn() => [fn () => (dec_nth seq i), fn () => dec_all_aux xs (i+1)])] in + dec_all_aux seq 0 end + + fun seqs_of_seq sequence lengths = + let fun aux seq acc 0 = (acc, seq) + | aux (x::xs) acc n = + aux xs (append acc [x]) (n-1) + val (res, _) = (foldl (fn (x,(acc, s)) => + let val (curr_acc, curr_seq) = aux s [] x in + (append acc [curr_acc], curr_seq) end)([], sequence) lengths) + in res + end + + fun cutoff_at list idx = + let fun aux ls acc 0 = acc + | aux (x::xs) acc i = + aux xs (append acc [x]) (i-1) in + aux list [] idx end + + fun for_i f y 0 = y + | for_i f y i = for_i f (f (i,y)) (i-1) + + + + + fun init_tc auth rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in init_tc auth rng end, + + hn ("REQUEST_AUTH", senderid) => + let val _ = send (senderid, auth) + in init_tc auth rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + init_tc auth new_rng end] + + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = random() + val _ = send (senderid, rnd) + in rec_rng (append ls [rnd]) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, ls) + in rec_rng [] + end] + + fun rep_rng ls = + receive [hn ("REQUEST_RND", senderid) => + case ls of + (x::xs) => + let val _ = send (senderid, x) + in rep_rng xs + end + | [] => + let val _ = send (senderid, 0) + in rep_rng ls + end, + hn ("REQUEST_LEFT", senderid) => + let val _ = send (senderid, ls) + in rep_rng [] + end, + hn ("UPDATE_LS", new_ls) => + rep_rng new_ls] + + fun shrink_sized_sequence seqs gens prop pre size left_over_len idx_of_sized tco = + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + val cap = ceil (((length (nth seqs (idx_of_sized+1)))-2)/left_over_len )(* number of to remove parts of the sequence *) + val size_ls = for_i (fn (x,y) => append y [x]) [] (left_over_len-1) + fun aux i = + let val to_remove = foldl (fn (x,y) => append y [(i*left_over_len)-x])[i*left_over_len] size_ls + val new_seq = foldl (fn (x,y) => remove_nth x y 0) (nth seqs (idx_of_sized+1)) to_remove + val new_seqs = mapi (fn (i, x) => if i = idx_of_sized then new_seq else x) seqs + val new_args = mapi (fn (i, x) => + let val _ = send (pid, ("UPDATE_LS", (nth new_seqs (i+1)))) + val arg = x tco size + in arg + end) gens + in case i = (cap) of + true => + (new_seqs, new_args) + | false => + let val precond_is_met = if (pre <> ()) then (apply_args pre new_args tco) else true + in case (apply_args prop new_args tco) orelse (precond_is_met = false) of + true => aux (i+1) + | false => (new_seqs, new_args) + end + end + in aux 1 + end + + + + fun internal_shrink_aux seqs gens lengths prop pre size counter tco = + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + in case seqs of + (x1::x2::x3::xs) => + let val seqs_of_curr = seqs_of_seq (x2()) lengths + val args_and_leftovers = mapi (fn (i, x) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = x tco size + val _ = send (pid, ("REQUEST_LEFT", self())) + val left_overs = receive [hn x => x] + in {arg = arg, left_overs = left_overs} + end) gens + val (test_args, left_over_seqs) = foldl (fn (x, (raws, left_overs)) => (append raws [x.arg], append left_overs [x.left_overs])) ([],[]) args_and_leftovers + (* val ret_seqs = mapi (fn (i,x) => + if (length x) = 0 then (nth seqs_of_curr (i+1)) + else cutoff_at (nth seqs_of_curr (i+1)) ((nth lengths (i+1))-(length x))) left_over_seqs *) + val (is_sized_sequence, idx_of_sized, left_over_size, _) = foldl (fn (x,(bool, idx, len, count)) => if (length x > 0) + then (true, count, (length x), (count+1)) + else (bool, idx, len, (count+1))) (false, -1, 0, 0) left_over_seqs + + val (ret_seqs, args) = if is_sized_sequence + then shrink_sized_sequence seqs_of_curr gens prop pre size left_over_size idx_of_sized tco + else (seqs_of_curr, test_args) + val precond_is_met = if (pre <> ()) then (apply_args pre args tco) else true + in + case (apply_args prop args tco) orelse (precond_is_met = false) of + true => internal_shrink_aux (x1::x3()) gens lengths prop pre size counter tco + | false => internal_shrink ret_seqs gens prop pre size (counter+1) tco + end + | (x::xs) => + let val seqs_of_curr = seqs_of_seq (x()) lengths + val test_args = mapi (fn (i, y) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y tco size + in arg end) gens + val precond_is_met = if (pre <> ()) then (apply_args pre test_args tco) else true + in + case (apply_args prop test_args tco) orelse (precond_is_met = false) orelse (size < 0) of + true => + let val res = mapi (fn (i, y) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y tco (size+1) + in arg end) gens in + {shrunk_ctx = res, count = counter} end + | false => internal_shrink_aux [x] gens lengths prop pre (size-1) counter tco + + end + end + + and internal_shrink sequences gens prop pre size counter tco = + let val (seqs_comb, seq_lengths) = foldl (fn (x, (seq, lengths)) => ((append seq x), (append lengths [(length x)]))) ([], []) sequences + in + if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then + internal_shrink_aux [fn () => seqs_comb] gens seq_lengths prop pre size counter tco + else + let val decreased_seqs = dec_all seqs_comb + val dec_seqs_w_root = append [fn() => seqs_comb] decreased_seqs + val res = internal_shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) tco + in + res end + end + + fun random_shrink_aux sequences generators prop pre success size counter divi tco = + if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val new_size = floor (size/divi) + val (shrunk_args, shrunk_sequences) = + foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x tco new_size + val _ = send (pid, ("REQUEST_SEQ", self())) + val seq = receive [hn x => x] + in (append arg_acc [arg], append seq_acc [seq]) + end) ([],[]) generators + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true + in + case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of + true => random_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco + | false => + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco + end + + fun internal_shrinker sequence generators prop pre size counter tco = + let val start_time = getTime() + val rng_recorder = spawn (fn() => rec_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) + val _ = receive [hn x => ()] + val res = random_shrink_aux sequence generators prop pre 0 size counter 2 tco + val rng_replayer = spawn (fn() => rep_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) + val _ = receive [hn x => ()] + val res = internal_shrink (res.sequences) generators prop pre res.size (res.count) tco + val end_time = getTime() + in + (res, (end_time - start_time)) end + +(* +------------------------------ +EXTERNAL SHRINKING + +------------------------------ +*) + fun list_to_string ls = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls + + fun apply_args p l = + case l of + [] => boolean_check (p()); p() (* this case is only reached if there are no generators to beign with*) + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y; y x) p l in + boolean_check res; + res + end + + fun shrink_sized_aggregate vals builder rec = + case rec.state of + "init" => + let val init_shrink_idx = 0 + val new_vals = mapi (fn (i, x) => + if i = init_shrink_idx then (x.shrinker {state = "init", curr = x.raw, prev = x.raw}) + else {state = "init", curr = x.raw, prev = x.raw}) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} + end + | "cont" => + let val init_shrink_idx = rec.shrink_idx + val new_vals = mapi (fn (i, x) => + if i = init_shrink_idx then x.shrinker (nth rec.next_shrink_info (i+1)) + else (nth rec.next_shrink_info (i+1))) vals + val new_raw_vals = map (fn x => x.curr) new_vals + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true new_vals) then "done" else "cont" + val shrink_idx = if (nth new_vals (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = new_vals, shrink_idx = shrink_idx} + end + | "done" => + rec + | "rollback" => + let val init_shrink_idx = rec.shrink_idx + fun rollback_aux (i, x) = + if i = init_shrink_idx then + (let val val_to_shrink = {(nth rec.next_shrink_info (i+1)) with state = "rollback"} + in + x.shrinker val_to_shrink + end ) + else (nth rec.next_shrink_info (i+1)) + val rollback_args = mapi rollback_aux vals + val new_raw_vals = map (fn x => x.curr) rollback_args + val new_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true rollback_args) then "done" else "cont" + val shrink_idx = if (nth rollback_args (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = new_state, curr = (builder new_raw_vals), prev = rec.curr, next_shrink_info = rollback_args, shrink_idx = shrink_idx} + end + + fun shrink_float rec = + let val rec_checked = if rec.curr = 0 then {rec with state = "done"} else rec + val curr_val = rec_checked.curr + in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec_checked.prev, prev = rec_checked.curr} + |"done" => + rec_checked + | _ => + let val new_raw_val = if (abs_value curr_val)-1 <= 0 then 0 else curr_val-1 + in + {state = "cont", curr = new_raw_val, prev = rec_checked.curr} + end + end + + fun shrink_int rec = + let val interim = shrink_float rec + in + {interim with curr = floor(interim.curr)} + end + + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun shrink_list shrinkers rec = + if (rec.curr = []) andalso (rec.state <> "rollback") then {rec with state = "done", prev = rec.curr, idx = 0} + else + case rec.state of + "init" => + let val removeIdx = (length (rec.curr)) - 1 + val newList = remove_nth removeIdx rec.curr 0 + val new_shrinkers = remove_nth removeIdx shrinkers 0 + val next_state = if length newList = 0 then "cont_elem" else "cont_size" + in + {state = next_state, curr = newList, prev = rec.curr, idx = removeIdx, shrinkers = new_shrinkers, prev_shrinkers = shrinkers} + end + | "cont_size" => + let val remove_idx = (rec.idx - 1) + val next_state = if remove_idx <= 0 then "cont_elem" else "cont_size" + val new_list = remove_nth remove_idx rec.curr 0 + val new_shrinkers = remove_nth remove_idx rec.shrinkers 0 + in + {state = next_state, curr = new_list, prev = rec.curr, idx = remove_idx, shrinkers = new_shrinkers, prev_shrinkers = rec.shrinkers} + end + | "cont_elem" => + let val interim_list = mapi (fn (i, x) => (nth rec.shrinkers (i+1)){state = "init", curr = x, prev = x}) rec.curr + val next_state = if (foldl (fn (x,y) => (x.state = "done") andalso y) true interim_list) then "done" else "cont_elem" + val new_list = map (fn x => x.curr) interim_list + in + {state = next_state, curr = new_list, prev = rec.curr, idx = rec.idx, shrinkers = rec.shrinkers, prev_shrinkers = rec.prev_shrinkers} + end + | "rollback" => + if (length rec.curr) = (length rec.prev) then + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} (* TODO: this loops an unecesary amount of times *) + else + {state = "cont_size", curr = rec.prev, prev = rec.curr, idx = rec.idx, shrinkers = rec.prev_shrinkers, prev_shrinkers = rec.shrinkers} + | "done" => + rec + + fun shrink_char rec = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val rec_checked = if rec.curr = "a" then {rec with state = "done"} else rec + val curr_val = rec_checked.curr in + case rec_checked.state of + "rollback" => + {state = "done", curr = rec.prev, prev = rec.curr, idx = rec.idx} + | "done" => + rec_checked + | "init" => + let val index_of_new = (lookup chars rec.curr 2) - 1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + | _ => + let val index_of_new = rec.idx-1 + val new_char = nth chars index_of_new + in + {state = "cont", curr = new_char, prev = rec.curr, idx = index_of_new} + end + end + + fun shrink_string rec = + let val rec_checked = if rec.state = "init" then {rec with next_shrink_info = 0} else rec in + case rec_checked.state of + "cont_elem" => + {rec_checked with state = "done"} (* TODO: Should actually shrink characters *) + | _ => + let val ls_curr = string_to_list rec_checked.curr + val ls_prev = string_to_list rec_checked.prev + val shrinkers = map (fn _ => shrink_char) ls_curr + val interim_res = + shrink_list shrinkers {state = rec_checked.state, + curr = ls_curr, + prev = ls_prev, + idx = rec_checked.next_shrink_info, + shrinkers = shrinkers, + prev_shrinkers = shrinkers} + val new_curr = list_to_string interim_res.curr + val new_prev = list_to_string interim_res.prev + + val res = {state = interim_res.state, curr = new_curr, prev = new_prev, next_shrink_info = interim_res.idx} + in + res + end + end + + fun args_shrink args = + case args.state of + "rollback" => + let val init_shrink_idx = args.shrink_idx + val rollbackReadyArgs = mapi (fn (i, x) => if (x.state = "done") orelse (i<>init_shrink_idx) then x else {x with state = "rollback"}) args.args + val argsRolledBack = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) rollbackReadyArgs + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true argsRolledBack) then "done" else "cont" + val shrink_idx = if (nth argsRolledBack (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + in + {state = nextState, args = argsRolledBack, shrinkers = args.shrinkers, shrink_idx = shrink_idx} + end + | "done" => + args + | _ => + let val init_shrink_idx = args.shrink_idx + val newArgs = mapi (fn (i, x) => if i = init_shrink_idx then ((nth args.shrinkers (i+1)) x) else x) args.args + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" + val shrink_idx = if (nth newArgs (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx + + in + {state = nextState, args = newArgs, shrinkers = args.shrinkers, shrink_idx = shrink_idx} + end + + fun shrink_aux args prop pre counter = + if counter = 100 then report_error ("shrinking_looped", 0) else + let val shrunk_args = args_shrink args + val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true + + in case (apply_args prop shrunk_args_raw) orelse (precond_is_met = false) of + true => shrink_aux (args_shrink {state = "rollback", args = shrunk_args.args, shrinkers = args.shrinkers, shrink_idx = args.shrink_idx}) prop pre (counter) + | false => + if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end + + fun external_shrinker args prop pre = + let val start_time = getTime() + val shrinkers = map (fn x => x.shrinker) args + val args_shrink_ready = map (fn x => {state = "init", curr = x.raw, prev = x.raw}) args + val args_rec = {state = "init", args = args_shrink_ready, shrinkers = shrinkers, shrink_idx = 0} + val res = shrink_aux args_rec prop pre 0 + val end_time = getTime() + in (res, (end_time - start_time)) end + + + + fun test_shrinking n = + let fun aux acc 0 = acc + | aux acc i = + let val (_, ctx_seq, size, ctx) = troupecheck [prop_record_shrink] authority + val ctx_n = nth ctx 1 + val ts_vals = [{raw = ctx_n.theInteger, shrinker = shrink_int}, {raw = ctx_n.theString, shrinker = shrink_string} ] + val ext_shrink_val = [{raw = ctx_n, shrinker = shrink_sized_aggregate ts_vals (build_record ["theInteger", "theString"])}] + val inter_shrink_tco = spawn (fn() => init_tc authority ()) + val pre = () + val ext_val = (external_shrinker ext_shrink_val record_shrink_test pre).1 + val int_val = (internal_shrinker ctx_seq [(record ["theInteger", "theString"] [integer(), string()])] record_shrink_test pre size 0 inter_shrink_tco).1 + + val ext = append acc.ext [ext_val] + val inter = append acc.inter [int_val] + in aux {ext, inter} (i-1) + end + in + aux {ext = [], inter = []} n + end + val test = test_shrinking 100 + val ext_sum = foldl (fn (x,y) => x+y) 0 test.ext + val inter_sum = foldl (fn (x,y) => x+y) 0 test.inter + val ext_mean = ext_sum/100 + val inter_mean = inter_sum/100 +in + print ("external timings: " ^ (toString test.ext)); + print ("mean: " ^ (toString ext_mean)); + print ("internal timings: " ^ (toString test.inter)); + print ("mean: " ^ (toString inter_mean)) +end \ No newline at end of file diff --git a/troupecheck/tc_tests/shrinking-tests.trp b/troupecheck/tc_tests/shrinking-tests.trp index 641d8c4..cb0d159 100644 --- a/troupecheck/tc_tests/shrinking-tests.trp +++ b/troupecheck/tc_tests/shrinking-tests.trp @@ -128,5 +128,5 @@ PROPERTIES TO RUN WITH TROUPECHECK. fun prop_mysort3_keep_length() = for_all ([list(integer())], mysort3_keep_length) val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, prop_shrink_test, prop_keep_length, prop_mysort2_ordered, prop_mysort3_keep_length] -in troupecheck prop_list authority +in troupecheck [prop_record_shrink] authority end \ No newline at end of file From 7ad0ed3be975c3f0945e9c2cacfebec3eed1db03 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sat, 25 May 2024 19:29:25 +0200 Subject: [PATCH 106/121] Added some generators + trying to make it work better for random generator --- lib/troupecheck.trp | 118 ++++++++++++++++++++++++-------------------- 1 file changed, 64 insertions(+), 54 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 67f6f54..272feec 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -80,26 +80,11 @@ Different utility functions that are used across the library. | remove_nth n (x::xs) i = if n = i then xs else x :: (remove_nth n xs (i + 1)) - - fun divide_list_work f length num_workers = - let fun make_infols acc 1 = append acc [(length - (floor(length/num_workers) * (num_workers-1)))] - | make_infols acc i = - make_infols (append acc [floor(length/num_workers)]) (i-1) - val infols = make_infols [] num_workers - val _ = map (fn x => spawn(fn()=> f x)) infols - val res = foldl (fn (_,y) => let val res = receive[hn x => x] in append res y end)[] infols in - res end fun make_list (f, i) = - let fun make_ls_aux (f_aux, n)= - case n of - 0 => [] - | _ => append [f_aux()] (make_ls_aux (f_aux, n-1)) - val self_id = self() - fun func (l) = let val res = make_ls_aux (f, l) in send (self_id, (res)) end - val res = divide_list_work func i 1 - in res - end + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) fun abs_value x = if x < 0 then -x else x @@ -119,7 +104,7 @@ Different utility functions that are used across the library. let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l val _ = boolean_check res tco val _ = blockdecl auth - in declassify (res, auth, `{}`) + in declassify (res, auth, `{}`) end end @@ -386,10 +371,10 @@ All of these functions are spawned and then requests or updates may be send to t val rng_replayer = spawn (fn() => rep_rng []) val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) val _ = receive [hn x => ()] - val _ = send (tco, ("REQUEST_AUTH", self())) - val auth = receive [hn x => x] + val res = internal_shrink (res.sequences) generators prop pre res.size (res.count) tco in - internal_shrink (res.sequences) generators prop pre res.size (res.count) tco end + res + end (* -------------------------------- GENERATORS @@ -418,7 +403,6 @@ However, it can be done if the users wishes to and understands what is going on. val bool_int = receive [hn x => x] val bool = bool_int < (1/2) - (* val float_of_x = x/1000000 *) val lInf = low = 1/0 (* check for inf *) val hInf = high = 1/0 @@ -439,8 +423,7 @@ However, it can be done if the users wishes to and understands what is going on. fun one_of ls tco size = let val idx = (int_gen (1, (length ls)) tco size) - in - (nth ls idx) + in (nth ls idx) end fun bool_gen tco size = @@ -450,12 +433,6 @@ However, it can be done if the users wishes to and understands what is going on. in res end - fun list_gen (generator) tco size = - let val length = (int_gen (0, size) tco size) - val res = make_list ((fn () => generator tco size), length) - in res - end - (* NOTE: Generates only letters (upper and lower case) and numbers. *) fun char_gen tco size = let val chars = @@ -468,13 +445,9 @@ However, it can be done if the users wishes to and understands what is going on. in nth chars x end - (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) - fun string_gen tco size = - let val char_ls = list_gen (char_gen) tco size - val string = list_to_string char_ls tco - in string - end - + fun label_gen tco size = + newlabel() + (* ts: list of generators - used to generate values for fields *) (* NOTE: Hardcoded for tuple of up to 10 elements - see build_tuple in 'UTILS' *) fun tuple_gen ts tco size = @@ -498,14 +471,42 @@ However, it can be done if the users wishes to and understands what is going on. val lab = one_of labels tco size in inst raisedTo lab end + + fun combined_labeled_gen labels gen tco size = + let val labels_to_use = foldl(fn (x,y) => if (bool_gen tco size) then append y [x] else y)[`{}`] labels + val value = gen tco size + val res = foldl (fn (x,y) => y raisedTo x) value labels_to_use + in res + end + + (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + fun string_gen tco size = + let val char_ls = list_gen (char_gen) tco size + val string = list_to_string char_ls tco + in string + end - (* TODO: needs to be completed... *) - fun generator_gen tco size = + and list_gen () tco size = + let val len = (int_gen (0, size) tco size) + val gen = generator_gen tco size + val res = make_list ((fn () => gen tco size), len) + in res + end + | list_gen (generator) tco size = + let val len = (int_gen (0, size) tco size) + val res = make_list ((fn () => generator tco size), len) + in res + end + + and generator_gen tco size = let val inf = 1/0 - val gens_ls = [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, (list_gen(generator_gen tco size)), char_gen, string_gen, - (tuple_gen (list_gen(generator_gen tco size))), (rec_gen (list_gen(string_gen)) ((generator_gen tco size))), - (labeled_value_gen (list_gen(string_gen)) (generator_gen tco size))] - val gen = one_of gens_ls + val gens_ls = + case (size mod 3) of + 0 => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, char_gen, string_gen] + | _ => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, (list_gen(generator_gen tco (size-1))), char_gen, string_gen, + (tuple_gen (list_gen(generator_gen tco (size-1)))), (rec_gen (list_gen(string_gen)) ((generator_gen tco (size-1)))), + (labeled_value_gen (list_gen(string_gen)) (generator_gen tco (size-1)))] + val gen = one_of gens_ls tco size in gen end (* @@ -530,8 +531,11 @@ Handles preparing the recorder RNG, running the tests, calling the shrinker, and end) ([],[])generators in case pre of - () => - if (apply_args prop args tco) then (write "." auth; core_forall (generators, prop, i-1, size+1, pre, cap, tco)) + () => + if (apply_args prop args tco) then + let val _ = write "." auth + in core_forall (generators, prop, i-1, size+1, pre, cap, tco) + end else let val _ = write "!" auth in {failReason = "false_prop", ctx = args, ctx_seq = sequences, remTests = i, size = size} @@ -583,10 +587,10 @@ Handles preparing the recorder RNG, running the tests, calling the shrinker, and fun troupecheck props auth = let val n = toString (length props) - fun troupecheck_aux [] i = exit (auth, 0) + fun troupecheck_aux [] i = exit(auth, 0) | troupecheck_aux (x::xs) i = let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") auth - val _ = x() auth + val res = x() auth in troupecheck_aux xs (i+1) end in troupecheck_aux props 1 end @@ -601,7 +605,7 @@ These are functions that make it easier for the user to make use of the differen *) val inf = 1 / 0 fun integer () = int_gen(inf, inf) - | integer (h, l) = int_gen(h, l) + | integer (l, h) = int_gen(l, h) fun pos_integer () = integer(0, inf) @@ -616,8 +620,8 @@ These are functions that make it easier for the user to make use of the differen fun boolean () = bool_gen - fun list () = list_gen(generator_gen()) - |list (type) = list_gen(type) + fun list () = list_gen () + |list (type) = list_gen (type) fun string () = string_gen @@ -625,11 +629,15 @@ These are functions that make it easier for the user to make use of the differen fun generator() = generator_gen - fun tuple ts = tuple_gen ts + fun tuple (ts) = tuple_gen ts - fun labeled_value ls gen = labeled_value_gen ls gen + fun labeled_value (ls, gen) = labeled_value_gen ls gen + + fun combined_labeled_value (ls, gen) = combined_labeled_gen ls gen + + fun label() = label_gen - fun record ns ts = rec_gen ns ts + fun record (ns, ts) = rec_gen ns ts in [ ("make_list", make_list) , ("build_record", build_record) @@ -652,6 +660,8 @@ in , ("generator", generator) , ("tuple", tuple) , ("labeled_value", labeled_value) + , ("combined_labeled_value", combined_labeled_value) + , ("label", label) , ("record", record) ] end From 0d3743b523e7e4ba689562066f6f385a46c08455 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 27 May 2024 17:00:57 +0200 Subject: [PATCH 107/121] Updated troupecheck lib file to be a bit faster - added a lot of timing tests --- lib/troupecheck.trp | 14 +- troupecheck/timing-experiments/booltest.trp | 35 +++ .../gen-and-apply-timings.trp | 170 +++++++++++++ troupecheck/timing-experiments/generators.trp | 237 ++++++++++++++++++ troupecheck/timing-experiments/inttest.trp | 35 +++ troupecheck/timing-experiments/tupletest.trp | 35 +++ 6 files changed, 518 insertions(+), 8 deletions(-) create mode 100644 troupecheck/timing-experiments/booltest.trp create mode 100644 troupecheck/timing-experiments/gen-and-apply-timings.trp create mode 100644 troupecheck/timing-experiments/generators.trp create mode 100644 troupecheck/timing-experiments/inttest.trp create mode 100644 troupecheck/timing-experiments/tupletest.trp diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 272feec..97fc3d4 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -82,12 +82,10 @@ Different utility functions that are used across the library. else x :: (remove_nth n xs (i + 1)) fun make_list (f, i) = - case i of - 0 => [] - | _ => append [f()] (make_list (f, i-1)) + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) - fun abs_value x = - if x < 0 then -x else x (* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l tco = @@ -222,10 +220,10 @@ All of these functions are spawned and then requests or updates may be send to t receive [hn ("REQUEST_RND", senderid) => let val rnd = random() val _ = send (senderid, rnd) - in rec_rng (append ls [rnd]) + in rec_rng (rnd :: ls) end, hn ("REQUEST_SEQ", senderid) => - let val _ = send (senderid, ls) + let val _ = send (senderid, (reverse ls)) in rec_rng [] end] @@ -587,7 +585,7 @@ Handles preparing the recorder RNG, running the tests, calling the shrinker, and fun troupecheck props auth = let val n = toString (length props) - fun troupecheck_aux [] i = exit(auth, 0) + fun troupecheck_aux [] i = exit(auth, 0) | troupecheck_aux (x::xs) i = let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") auth val res = x() auth diff --git a/troupecheck/timing-experiments/booltest.trp b/troupecheck/timing-experiments/booltest.trp new file mode 100644 index 0000000..9a91b39 --- /dev/null +++ b/troupecheck/timing-experiments/booltest.trp @@ -0,0 +1,35 @@ +import troupecheck +import lists +(* NOTE: In order run this the 'troupecheck.trp' library file must be modified, + so that the troupecheck function does not exit the runtime - i.e. replace the call to 'exit(authority, 0)' + with '()', and run make libs, from Troupe directory. + Remember to change back! *) +(* This file times how long it takes takes troupecheck to test a property on tuples, that is always true. + It times this process 100 times and returns the average *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun bool_commutative x y = + (x andalso y) = (y andalso x) + + fun prop_bool_test() = for_all ([boolean(), boolean()], bool_commutative) + + fun test_troupecheck(ls, 0) = ls + | test_troupecheck(ls, n) = + let val startT = getTime() + val _ = troupecheck [prop_bool_test] authority + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newList = append ls [elapsedMilliseconds] + val newN = (n-1) + in test_troupecheck(newList, newN) + end +in average (test_troupecheck([], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/gen-and-apply-timings.trp b/troupecheck/timing-experiments/gen-and-apply-timings.trp new file mode 100644 index 0000000..c1d7a2f --- /dev/null +++ b/troupecheck/timing-experiments/gen-and-apply-timings.trp @@ -0,0 +1,170 @@ +import lists +import troupecheck +(* This file is for testing what causes TroupeChecks slow overhead, + by timing the apply args function, and the foldl call that generates the arguments. *) +let fun bool_commutative x y = + (x andalso y) = (y andalso x) + val bool_test_gens = [boolean(), boolean()] + + fun tuple_test (number, string) = + getType number = "number" + + val tup_test_gens = [tuple([integer(), string()])] + + val gens_to_use = bool_test_gens + val test_to_use = bool_commutative + fun init_tc auth rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in init_tc auth rng end, + + hn ("REQUEST_AUTH", senderid) => + let val _ = send (senderid, auth) + in init_tc auth rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + init_tc auth new_rng end] + + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = random() + val _ = send (senderid, rnd) + in rec_rng (rnd :: ls) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, (reverse ls)) + in rec_rng [] + end] + val recorder = spawn(fn() => rec_rng []) + val tcp = spawn(fn() => init_tc authority recorder) + + fun boolean_check x tco = + if (getType x)<>"boolean" then () else () + + fun function_not_done_check p tco = + if (getType p)<>"function" then () else () + + fun apply_args p l tco = + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + in case l of + [] => (* this case is only reached if there are no generators to begin with *) + let val _ = boolean_check (p()) tco + val res = p() + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l + val _ = boolean_check res tco + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + end + + fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun handle_inner_timings timings = + let val (arg, rec, ap_ac, ap_seq) = timings + val arg_avrg = average arg + val rec_avrg = average rec + val ap_ac_avrg = average ap_ac + val ap_seq_avrg = average ap_seq + in (arg_avrg, rec_avrg, ap_ac_avrg, ap_seq_avrg) + end + + fun append_inner_timings to_append to = + let val (a1, b1, c1, d1) = to + val (a2, b2, c2, d2) = to_append + val a3 = append a1 [a2] + val b3 = append b1 [b2] + val c3 = append c1 [c2] + val d3 = append d1 [d2] + in (a3, b3, c3, d3) + end + + fun sum_inner_timings timings = + let val (a1, b1, c1, d1) = timings + val a2 = sum a1 + val b2 = sum b1 + val c2 = sum c1 + val d2 = sum d1 + in (a2, b2, c2, d2) + end + + fun test_troupecheck_inner(gen_ts, app_ts, inner_timings, 101) = (gen_ts, app_ts, inner_timings) + | test_troupecheck_inner (gen_ts, app_ts, inner_timings, n) = + let val generators = gens_to_use + val start_gen = getTime() + val (args, sequences, times) = foldl (fn (x, (arg_acc, seq_acc, (arg_t, rec_t, ap_ac_t, ap_seq_t))) => + let val arg_start = getTime() + val arg = x tcp n + val arg_end = getTime() + val _ = send (recorder, ("REQUEST_SEQ", self())) + val rec_start = getTime() + val seq = receive [hn x => x] + val rec_end = getTime() + val ap_ac_start = getTime() + val new_args = append arg_acc [arg] + val ap_ac_end = getTime() + val ap_seq_start = getTime() + val new_seqs = append seq_acc [seq] + val ap_seq_end = getTime() + val new_arg_t = append arg_t [arg_end - arg_start] + val new_rec_t = append rec_t [rec_end - rec_start] + val new_ap_ac_t = append ap_ac_t [ap_ac_end - ap_ac_start] + val new_ap_seq_t = append ap_seq_t [ap_seq_end - ap_seq_start] + in (new_args, new_seqs, (new_arg_t, new_rec_t, new_ap_ac_t, new_ap_seq_t)) + end) ([],[], ([], [], [], [])) generators + val end_gen = getTime() + val inner_timings_avrg = handle_inner_timings times + val new_inner_timings = append_inner_timings inner_timings_avrg inner_timings + val start_app = getTime() + val _ = apply_args test_to_use args tcp + val end_app = getTime() + in test_troupecheck_inner(append gen_ts [end_gen-start_gen], append app_ts [end_app - start_app], new_inner_timings, (n+1)) + end + + fun print_inners inners = + let val (a1, b1, c1, d1) = inners + val _ = print "arg generation:" + val _ = print a1 + val _ = print "recive seq:" + val _ = print b1 + val _ = print "append arg:" + val _ = print c1 + val _ = print "append sequence:" + val _ = print d1 + in () + end + + fun test_troupecheck(ls1,ls2, inners, 0) = (ls1,ls2, inners) + | test_troupecheck(ls1,ls2, inners, n) = + let val (gens, apps, timings) = test_troupecheck_inner([], [], ([], [], [], []), 0) + val gen_sum = sum gens 0 + val apps_sum = sum apps 0 + val avrg_inners = handle_inner_timings timings + val new_inners = append_inner_timings avrg_inners inners + in test_troupecheck(append ls1 [gen_sum], append ls2 [apps_sum], new_inners, (n-1)) + end + val (gens, apps, inner_timings) = test_troupecheck([], [],([], [], [], []), 100) + val avrg_timings = handle_inner_timings inner_timings +in + print "generating total:"; + print (average gens); + print "applying args:"; + print (average apps); + print_inners avrg_timings +end + + + diff --git a/troupecheck/timing-experiments/generators.trp b/troupecheck/timing-experiments/generators.trp new file mode 100644 index 0000000..749c26c --- /dev/null +++ b/troupecheck/timing-experiments/generators.trp @@ -0,0 +1,237 @@ +import lists +let fun write x auth = + fwrite ((getStdout auth), x) + + fun init_tc auth rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in init_tc auth rng end, + + hn ("REQUEST_AUTH", senderid) => + let val _ = send (senderid, auth) + in init_tc auth rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + init_tc auth new_rng end] + + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = random() + val _ = send (senderid, rnd) + in rec_rng (rnd :: ls) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, (reverse ls)) + in rec_rng [] + end] + val recorder = spawn(fn() => rec_rng []) + val tcp = spawn(fn() => init_tc authority recorder) + + fun report_error error_reason tco = + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + | ("shrinking_looped", _) => "Shrinking looped.\n" + | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" + in + write "\u001B[31m \nError: " auth; (* Changing the print color to red *) + write (err_string ^ "\u001B[0m") auth; (* Changing the color back *) + exit (auth, 0) end + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + (* Hardcoded until a tuple from list function is implemented in Troupe - an issue has been raised on GH.*) + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) + + (* Combines a list of individual strings to a single string *) + fun list_to_string ls tco = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) tco else y ^ x) "" ls + + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + + fun float_gen (low, high) tco size = + let val _ = send (tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + + val _ = send (pid, ("REQUEST_RND", self())) + val x = receive [hn x => x] + + val _ = send (pid, ("REQUEST_RND", self())) + val bool_int = receive [hn x => x] + + val bool = bool_int < (1/2) + + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + + val res = + case (lInf, hInf) of + (true, true) => if bool then x * size else -x * size + | (true, false) => high - (x * size) + | (false, true) => low + (x * size) + | (false, false) => low + (x * (high-low)) + in res + end + + fun int_gen (low, high) tco size = + let val res = floor (float_gen (low, high+1) tco size) + in res + end + + fun one_of ls tco size = + let val idx = (int_gen (1, (length ls)) tco size) + in (nth ls idx) + end + + fun bool_gen tco size = + let val rnd = int_gen (0,1) tco size + val res = if rnd = 0 then false + else true + in res + end + + (* NOTE: Generates only letters (upper and lower case) and numbers. *) + fun char_gen tco size = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + val x = (int_gen (1, ((length chars)-1)) tco size) + in nth chars x + end + + fun label_gen tco size = + newlabel() + + (* returns: (res, time to generate elements in tuple, time to convert from list to tuple) *) + fun tuple_gen ts tco size = + let val start_gen = getTime() + val ts_vals = map (fn x => x tco size) ts + val end_gen = getTime() + val start_build = getTime() + val res = build_tuple ts_vals + val end_build = getTime() + in (res, end_gen - start_gen, end_build - start_build) + end + + (* ns: list of strings - will be used as fieldnames *) + (* ts: list of generators - used to generate values for fields *) + fun rec_gen ns ts tco size = + if (length ns) <> (length ts) then + report_error ("record_mismatch", 0) tco + else + let val ts_vals = map (fn x => x tco size) ts + val res = build_record ns ts_vals + in res + end + + fun labeled_value_gen labels value_gen tco size = + let val inst = value_gen tco size + val lab = one_of labels tco size + in inst raisedTo lab + end + + fun combined_labeled_gen labels gen tco size = + let val labels_to_use = foldl(fn (x,y) => if (bool_gen tco size) then append y [x] else y)[`{}`] labels + val value = gen tco size + val res = foldl (fn (x,y) => y raisedTo x) value labels_to_use + in res + end + + (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + fun string_gen tco size = + let val char_ls = list_gen (char_gen) tco size + val string = list_to_string char_ls tco + in string + end + + and list_gen () tco size = + let val len = (int_gen (0, size) tco size) + val gen = generator_gen tco size + val res = make_list ((fn () => gen tco size), len) + in res + end + | list_gen (generator) tco size = + let val len = (int_gen (0, size) tco size) + val res = make_list ((fn () => generator tco size), len) + in res + end + + and generator_gen tco size = + let val inf = 1/0 + val gens_ls = + case (size mod 3) of + 0 => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, char_gen, string_gen] + | _ => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, (list_gen(generator_gen tco (size-1))), char_gen, string_gen, + (tuple_gen (list_gen(generator_gen tco (size-1)))), (rec_gen (list_gen(string_gen)) ((generator_gen tco (size-1)))), + (labeled_value_gen (list_gen(string_gen)) (generator_gen tco (size-1)))] + val gen = one_of gens_ls tco size + in gen end + + fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + val inf = 1/0 + fun test_troupecheck_inner ls1 ls2 101 = (ls1, ls2) + | test_troupecheck_inner ls1 ls2 n = + let val (_, gen, build) = tuple_gen [int_gen(inf, inf)] tcp n + val _ = print n + in test_troupecheck_inner (append ls1 [gen]) (append ls2 [build]) (n+1) + end + + fun test_troupecheck ls1 ls2 0 = (ls1, ls2) + | test_troupecheck ls1 ls2 n = + let val (gens, builds) = test_troupecheck_inner [] [] 0 + val avrg_gens = average gens + val avrg_builds = average builds + in test_troupecheck (append ls1 [avrg_gens]) (append ls2 [avrg_builds]) (n-1) + end + + val (gens, builds) = test_troupecheck [] [] 100 + val avrg_gens = average gens + val avrg_builds = average builds +in + print "generating time:"; + print avrg_gens; + print "building time:"; + print avrg_builds +end + + \ No newline at end of file diff --git a/troupecheck/timing-experiments/inttest.trp b/troupecheck/timing-experiments/inttest.trp new file mode 100644 index 0000000..cf96d47 --- /dev/null +++ b/troupecheck/timing-experiments/inttest.trp @@ -0,0 +1,35 @@ +import troupecheck +import lists +(* NOTE: In order run this the 'troupecheck.trp' library file must be modified, + so that the troupecheck function does not exit the runtime - i.e. replace the call to 'exit(authority, 0)' + with '()', and run make libs, from Troupe directory. + Remember to change back! *) +(* This file times how long it takes takes troupecheck to test a property on tuples, that is always true. + It times this process 100 times and returns the average *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun int_commutative x y = + (x + y) = (y + x) + + fun prop_int_test() = for_all ([integer(), integer()], int_commutative) + + fun test_troupecheck(ls, 0) = ls + | test_troupecheck(ls, n) = + let val startT = getTime() + val _ = troupecheck [prop_int_test] authority + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newList = append ls [elapsedMilliseconds] + val newN = (n-1) + in test_troupecheck(newList, newN) + end +in average (test_troupecheck([], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/tupletest.trp b/troupecheck/timing-experiments/tupletest.trp new file mode 100644 index 0000000..7829769 --- /dev/null +++ b/troupecheck/timing-experiments/tupletest.trp @@ -0,0 +1,35 @@ +import troupecheck +import lists +(* NOTE: In order run this the 'troupecheck.trp' library file must be modified, + so that the troupecheck function does not exit the runtime - i.e. replace the call to 'exit(authority, 0)' + with '()', and run make libs, from Troupe directory. + Remember to change back! *) +(* This file times how long it takes takes troupecheck to test a property on tuples, that is always true. + It times this process 100 times and returns the average *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun tuple_test (number, string) = + getType number = "number" + + fun prop_tuple_test() = for_all ([tuple([integer(), string()])], tuple_test) + + fun test_troupecheck(ls, 0) = ls + | test_troupecheck(ls, n) = + let val startT = getTime() + val _ = troupecheck [prop_tuple_test] authority + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newList = append ls [elapsedMilliseconds] + val newN = (n-1) + in test_troupecheck(newList, newN) + end +in average (test_troupecheck([], 100)) +end \ No newline at end of file From 64bc8d6a780ec7fda9eda2c65da5a07870075f77 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 27 May 2024 17:04:11 +0200 Subject: [PATCH 108/121] updated som testing files --- troupecheck/tc_tests/calculator.trp | 43 +++++++++++++++++++++ troupecheck/tc_tests/general-testing.trp | 4 +- troupecheck/tc_tests/shrink_comparisons.trp | 4 +- troupecheck/tc_tests/shrinking-tests.trp | 12 ++++-- 4 files changed, 55 insertions(+), 8 deletions(-) create mode 100644 troupecheck/tc_tests/calculator.trp diff --git a/troupecheck/tc_tests/calculator.trp b/troupecheck/tc_tests/calculator.trp new file mode 100644 index 0000000..055e7ff --- /dev/null +++ b/troupecheck/tc_tests/calculator.trp @@ -0,0 +1,43 @@ +import troupecheck +let fun calc expr = + case expr of + ("a", x, y) => + let val cx = (calc x) + val cy = (calc y) + in + if (cx = "nothing") orelse (cy = "nothing") then "nothing" else cx + cy + end + | ("d", x, y) => + (case calc y of + 0 => "nothing" + | r => + let val cx = (calc x) + in if (cx = "nothing") orelse (r = "nothing") then "nothing" else cx / r end) + | n => n + + fun divSubTerms expr = + case expr of + ("d", _, 0) => false + | (_, x, y) => (divSubTerms x) andalso (divSubTerms y) + | _ => true + + fun expr_gen tco tco 0 = integer() tco 0 + | expr_gen tco size = + let val res = + one_of [(integer() tco (size)), ("a", (expr_gen tco (size-1)), (expr_gen tco (size-1))), + ("d", (expr_gen tco (size-1)), (expr_gen tco (size-1)))] tco size + in + res + end + + fun expr() = expr_gen 4 + + fun prop_calculator() = + for_all([expr()], ((fn x => (getType (calc x)) <> "string"), divSubTerms)) +in troupecheck[prop_calculator] authority +end + + + + + diff --git a/troupecheck/tc_tests/general-testing.trp b/troupecheck/tc_tests/general-testing.trp index ba35042..b3d8ddf 100644 --- a/troupecheck/tc_tests/general-testing.trp +++ b/troupecheck/tc_tests/general-testing.trp @@ -151,10 +151,10 @@ see 'FUNCTIONS FOR TESTING'. *) fun prop_bad_insert() = for_all ([list(integer()), integer()], test_bad_insert) fun prop_bad_half() = for_all_noshrink ([integer()], (test_bad_half, (fn x => x >= 15))) - fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) + fun prop_record_shrink() = for_all ([(record (["theInteger", "theString"], [integer(), string()]))], record_shrink_test) fun prop_bool_commutative() = for_all ([boolean(), boolean()], bool_commutative) fun prop_count_non_negative() = for_all ([integer(), list(integer())], my_count_returns_non_negative_int) (* 1000 *) - fun prop_rec_test() = for_all ([(record ["theInteger", "theString"][integer(), string()]), integer()], rec_test) + fun prop_rec_test() = for_all ([(record (["theInteger", "theString"], [integer(), string()])), integer()], rec_test) fun prop_no_args() = for_all ([], no_args) fun prop_shrink_test() = for_all ([integer(), integer(), integer(), integer()], shrink_test) fun prop_number_commutative() = for_all ([integer(), integer()], number_commutative) diff --git a/troupecheck/tc_tests/shrink_comparisons.trp b/troupecheck/tc_tests/shrink_comparisons.trp index 0dc2f4e..013465a 100644 --- a/troupecheck/tc_tests/shrink_comparisons.trp +++ b/troupecheck/tc_tests/shrink_comparisons.trp @@ -7,7 +7,7 @@ import lists This program was only made to test internal vs. external shrinking, and not meant for further usage.*) let fun record_shrink_test r = r.theInteger < 50 - fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) + fun prop_record_shrink() = for_all ([(record (["theInteger", "theString"], [integer(), string()]))], record_shrink_test) (* ------------------------------ @@ -572,7 +572,7 @@ EXTERNAL SHRINKING val inter_shrink_tco = spawn (fn() => init_tc authority ()) val pre = () val ext_val = (external_shrinker ext_shrink_val record_shrink_test pre).1 - val int_val = (internal_shrinker ctx_seq [(record ["theInteger", "theString"] [integer(), string()])] record_shrink_test pre size 0 inter_shrink_tco).1 + val int_val = (internal_shrinker ctx_seq [(record (["theInteger", "theString"], [integer(), string()]))] record_shrink_test pre size 0 inter_shrink_tco).1 val ext = append acc.ext [ext_val] val inter = append acc.inter [int_val] diff --git a/troupecheck/tc_tests/shrinking-tests.trp b/troupecheck/tc_tests/shrinking-tests.trp index cb0d159..e37025d 100644 --- a/troupecheck/tc_tests/shrinking-tests.trp +++ b/troupecheck/tc_tests/shrinking-tests.trp @@ -86,7 +86,7 @@ BOOLEAN STATEMENTS FOR TESTING. n > (bad_half n) fun record_shrink_test r = - r.theInteger < 50 + r.theInteger < 50 fun append_always_longer s1 s2 = let fun string_to_list s = @@ -111,6 +111,9 @@ BOOLEAN STATEMENTS FOR TESTING. fun mysort3_keep_length xs = length xs = length (my_quicksort3(xs)) + + fun tuple_shrink_test (number, string) = + number < 50 (* -------------------------------- @@ -121,12 +124,13 @@ PROPERTIES TO RUN WITH TROUPECHECK. fun prop_append_always_longer() = for_all ([string(), string()], append_always_longer) fun prop_bad_insert() = for_all ([list(integer()), integer()], test_bad_insert) fun prop_bad_half() = for_all ([integer()], (test_bad_half, (fn x => x >= 15))) - fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) + fun prop_record_shrink() = for_all ([(record (["theInteger", "theString"], [integer(), string()]))], record_shrink_test) fun prop_shrink_test() = for_all ([integer(), integer(), integer(), integer()], shrink_test) fun prop_keep_length() = for_all ([list(integer())], my_sort_keep_length) fun prop_mysort2_ordered() = for_all ([list(integer())], mysort2_is_ordered) fun prop_mysort3_keep_length() = for_all ([list(integer())], mysort3_keep_length) + fun prop_tuple_shrink() = for_all ([tuple([integer(), string()])], tuple_shrink_test) val prop_list = [prop_append_always_longer, prop_bad_insert, prop_bad_half, prop_record_shrink, - prop_shrink_test, prop_keep_length, prop_mysort2_ordered, prop_mysort3_keep_length] -in troupecheck [prop_record_shrink] authority + prop_shrink_test, prop_keep_length, prop_mysort2_ordered, prop_mysort3_keep_length, prop_tuple_shrink] +in troupecheck prop_list authority end \ No newline at end of file From 874fda535a1bb7783deded3073be0cf6ccb96145 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 27 May 2024 17:04:57 +0200 Subject: [PATCH 109/121] updated git ignore file --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 0d13f63..a69870a 100644 --- a/.gitignore +++ b/.gitignore @@ -34,4 +34,4 @@ bin/troupe bin/understudy trp-rt/out/ troupecheck/test.trp -troupecheck/test.py \ No newline at end of file +troupecheck/*.py \ No newline at end of file From c6e81f95f8999d1d49deb252992951523b09dd69 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Mon, 27 May 2024 17:10:16 +0200 Subject: [PATCH 110/121] Updated the battlesship game to fit with updted tc library --- troupecheck/battleship/battleship-game.trp | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index a103355..b8f9365 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -317,13 +317,20 @@ Testing the game host using TroupeCheck in (interim_res1 andalso interim_res2) end + fun random_labels_gen val_gen tco size = + let val labels = list(label()) tco size + val res = combined_labeled_value (labels, val_gen) tco size + in res + end + fun test_bad_do_attack (board, ships) attack = (length (do_attack board ships attack).1) = 11 fun prop_do_att_test() = - for_all ([(labeled_value [`{alice}`, `{bob}`] board_ships_gen), attack_gen], test_do_attack_no_leak) + for_all ([(random_labels_gen board_ships_gen), attack_gen], test_do_attack_no_leak) fun prop_bad_do_att() = - for_all ([(labeled_value [`{alice}`, `{bob}`] board_ships_gen), attack_gen], test_bad_do_attack) -in troupecheck[prop_do_att_test, prop_bad_do_att] authority + for_all ([(labeled_value ([`{alice}`, `{bob}`], board_ships_gen)), attack_gen], test_bad_do_attack) + +in troupecheck[prop_bad_do_att] authority end \ No newline at end of file From 7655d3742bec224cd4ba6cc7bfd993eb4ac999b2 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Wed, 29 May 2024 11:51:03 +0200 Subject: [PATCH 111/121] updated timing experiments --- troupecheck/timing-experiments/generators.trp | 58 ++++++++++++++----- 1 file changed, 45 insertions(+), 13 deletions(-) diff --git a/troupecheck/timing-experiments/generators.trp b/troupecheck/timing-experiments/generators.trp index 749c26c..31d711c 100644 --- a/troupecheck/timing-experiments/generators.trp +++ b/troupecheck/timing-experiments/generators.trp @@ -28,6 +28,34 @@ let fun write x auth = val recorder = spawn(fn() => rec_rng []) val tcp = spawn(fn() => init_tc authority recorder) + fun save_times ls1 ls2 ls3 ls4= + receive [hn ("ls1", x) => + save_times (x :: ls1) ls2 ls3 ls4, + hn ("ls2", x) => + save_times ls1 (x::ls2) ls3 ls4, + hn ("ls3", x) => + save_times ls1 ls2 (x::ls3) ls4, + hn ("ls4", x) => + save_times ls1 ls2 ls3 (x::ls4), + hn ("get_ls1", sender) => + let val _ = send (sender, ls1) + in save_times [] ls2 ls3 ls4 + end, + hn ("get_ls2", sender) => + let val _ = send (sender, ls2) + in save_times ls1 [] ls3 ls4 + end, + hn ("get_ls3", sender) => + let val _ = send (sender, ls3) + in save_times ls1 ls2 [] ls4 + end, + hn ("get_ls4", sender) => + let val _ = send (sender, ls4) + in save_times ls1 ls2 ls3 [] + end + ] + val state = spawn (fn() => save_times [] [] [] []) + fun report_error error_reason tco = let val _ = send (tco, ("REQUEST_AUTH", self())) val auth = receive [hn x => x] @@ -76,7 +104,7 @@ let fun write x auth = fun make_list (f, i) = case i of 0 => [] - | _ => append [f()] (make_list (f, i-1)) + | _ => (f()) :: (make_list (f, i-1)) fun float_gen (low, high) tco size = let val _ = send (tco, ("REQUEST_RNG", self())) @@ -133,16 +161,17 @@ let fun write x auth = fun label_gen tco size = newlabel() - - (* returns: (res, time to generate elements in tuple, time to convert from list to tuple) *) + fun tuple_gen ts tco size = let val start_gen = getTime() val ts_vals = map (fn x => x tco size) ts val end_gen = getTime() + val _ = send (state, ("ls1", end_gen - start_gen)) val start_build = getTime() val res = build_tuple ts_vals val end_build = getTime() - in (res, end_gen - start_gen, end_build - start_build) + val _ = send (state, ("ls2", end_build - start_build)) + in res end (* ns: list of strings - will be used as fieldnames *) @@ -209,19 +238,22 @@ let fun write x auth = in (sum_ls/len) end val inf = 1/0 - fun test_troupecheck_inner ls1 ls2 101 = (ls1, ls2) - | test_troupecheck_inner ls1 ls2 n = - let val (_, gen, build) = tuple_gen [int_gen(inf, inf)] tcp n - val _ = print n - in test_troupecheck_inner (append ls1 [gen]) (append ls2 [build]) (n+1) + fun test_troupecheck_inner 101 = () + | test_troupecheck_inner n = + let val _ = tuple_gen [int_gen(inf, inf), string_gen] tcp n + in test_troupecheck_inner (n+1) end fun test_troupecheck ls1 ls2 0 = (ls1, ls2) | test_troupecheck ls1 ls2 n = - let val (gens, builds) = test_troupecheck_inner [] [] 0 - val avrg_gens = average gens - val avrg_builds = average builds - in test_troupecheck (append ls1 [avrg_gens]) (append ls2 [avrg_builds]) (n-1) + let val _ = test_troupecheck_inner 0 + val _ = send(state, ("get_ls1", self())) + val gens = receive [hn x => x] + val _ = send(state, ("get_ls2", self())) + val builds = receive [hn x => x] + val sum_gens = sum gens 0 + val sum_builds = sum builds 0 + in test_troupecheck (append ls1 [sum_gens]) (append ls2 [sum_builds]) (n-1) end val (gens, builds) = test_troupecheck [] [] 100 From db8f116d330b8d39c92be8a8df4b04cfc8538615 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 31 May 2024 12:55:45 +0200 Subject: [PATCH 112/121] Now timing tests --- troupecheck/timing-experiments/constest.trp | 24 + .../{inttest.trp => inttest1.trp} | 2 +- troupecheck/timing-experiments/inttest2.trp | 35 ++ troupecheck/timing-experiments/inttest3.trp | 50 ++ .../timing-experiments/reversetest.trp | 25 + .../timing-experiments/send-receivetest.trp | 41 ++ .../timing-experiments/strjointest.trp | 24 + .../timing-experiments/tc-nosendreceive.trp | 515 ++++++++++++++++++ 8 files changed, 715 insertions(+), 1 deletion(-) create mode 100644 troupecheck/timing-experiments/constest.trp rename troupecheck/timing-experiments/{inttest.trp => inttest1.trp} (96%) create mode 100644 troupecheck/timing-experiments/inttest2.trp create mode 100644 troupecheck/timing-experiments/inttest3.trp create mode 100644 troupecheck/timing-experiments/reversetest.trp create mode 100644 troupecheck/timing-experiments/send-receivetest.trp create mode 100644 troupecheck/timing-experiments/strjointest.trp create mode 100644 troupecheck/timing-experiments/tc-nosendreceive.trp diff --git a/troupecheck/timing-experiments/constest.trp b/troupecheck/timing-experiments/constest.trp new file mode 100644 index 0000000..41d6f5b --- /dev/null +++ b/troupecheck/timing-experiments/constest.trp @@ -0,0 +1,24 @@ +import lists +(* This file times how long it takes takes troupe to cons an element in front of a list. *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun test_cons(ls, timings, 0) = timings + | test_cons(ls, timings, n) = + let val startT = getTime() + val newList = n :: ls + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_cons(newList, newTimings, newN) + end +in average (test_cons([], [], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/inttest.trp b/troupecheck/timing-experiments/inttest1.trp similarity index 96% rename from troupecheck/timing-experiments/inttest.trp rename to troupecheck/timing-experiments/inttest1.trp index cf96d47..40c58fc 100644 --- a/troupecheck/timing-experiments/inttest.trp +++ b/troupecheck/timing-experiments/inttest1.trp @@ -4,7 +4,7 @@ import lists so that the troupecheck function does not exit the runtime - i.e. replace the call to 'exit(authority, 0)' with '()', and run make libs, from Troupe directory. Remember to change back! *) -(* This file times how long it takes takes troupecheck to test a property on tuples, that is always true. +(* This file times how long it takes takes troupecheck to test a property on two integers, that is always true. It times this process 100 times and returns the average *) let fun sum [] acc = acc | sum (x::xs) acc = diff --git a/troupecheck/timing-experiments/inttest2.trp b/troupecheck/timing-experiments/inttest2.trp new file mode 100644 index 0000000..1a216ca --- /dev/null +++ b/troupecheck/timing-experiments/inttest2.trp @@ -0,0 +1,35 @@ +import troupecheck +import lists +(* NOTE: In order run this the 'troupecheck.trp' library file must be modified, + so that the troupecheck function does not exit the runtime - i.e. replace the call to 'exit(authority, 0)' + with '()', and run make libs, from Troupe directory. + Remember to change back! *) +(* This file times how long it takes takes troupecheck to test a property on an integer, that is always true. + It times this process 100 times and returns the average *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun int_test x = + (getType x) = "number" + + fun prop_int_test() = for_all ([integer()], int_test) + + fun test_troupecheck(ls, 0) = ls + | test_troupecheck(ls, n) = + let val startT = getTime() + val _ = troupecheck [prop_int_test] authority + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newList = append ls [elapsedMilliseconds] + val newN = (n-1) + in test_troupecheck(newList, newN) + end +in average (test_troupecheck([], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/inttest3.trp b/troupecheck/timing-experiments/inttest3.trp new file mode 100644 index 0000000..1a9e351 --- /dev/null +++ b/troupecheck/timing-experiments/inttest3.trp @@ -0,0 +1,50 @@ +import lists +(* This file times how long it takes takes troupe to cons an element in front of a list. *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun float_gen (low, high) tco size = + let val x = random() + + val bool_int = random () + + val bool = bool_int < (1/2) + + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + + val res = + case (lInf, hInf) of + (true, true) => if bool then x * size else -x * size + | (true, false) => high - (x * size) + | (false, true) => low + (x * size) + | (false, false) => low + (x * (high-low)) + in res + end + + fun int_gen (low, high) tco size = + let val res = floor (float_gen (low, high+1) tco size) + in res + end + + val inf = 1/0 + + fun test_int(timings, 0) = timings + | test_int(timings, n) = + let val startT = getTime() + val n = int_gen(inf, inf) () n + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_int(newTimings, newN) + end +in sum (test_int([], 100)) 0 +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/reversetest.trp b/troupecheck/timing-experiments/reversetest.trp new file mode 100644 index 0000000..98aa46c --- /dev/null +++ b/troupecheck/timing-experiments/reversetest.trp @@ -0,0 +1,25 @@ +import lists +(* This file times how long it takes takes trouep to reverse a list of two elements (the choice sequence in TC has length 2 after generating an integer). + It times this done 100 times and returns the average *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun test_cons(ls, timings, 0) = timings + | test_cons(ls, timings, n) = + let val startT = getTime() + val _ = reverse ls + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_cons(ls, newTimings, newN) + end +in average (test_cons([random(), random()], [], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/send-receivetest.trp b/troupecheck/timing-experiments/send-receivetest.trp new file mode 100644 index 0000000..70f082b --- /dev/null +++ b/troupecheck/timing-experiments/send-receivetest.trp @@ -0,0 +1,41 @@ +import lists +(* This file times how long it takes takes troupe to send and receive elements between processes. + Average time ~0.10 milliseconds *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = random() + val _ = send (senderid, rnd) + in rec_rng (rnd :: ls) + end] + val recorder = spawn(fn() => rec_rng []) + + fun test () = + let val _ = send(recorder, ("REQUEST_RND", self())) + val x = receive [hn x => x] + in x + end + + fun test_cons(timings, 0) = timings + | test_cons(timings, n) = + let val startT = getTime() + val res = test() + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_cons(newTimings, newN) + end +in + print (average (test_cons([], 1000))); + exit(authority, 0) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/strjointest.trp b/troupecheck/timing-experiments/strjointest.trp new file mode 100644 index 0000000..4961dfb --- /dev/null +++ b/troupecheck/timing-experiments/strjointest.trp @@ -0,0 +1,24 @@ +import lists +(* This file times how long it takes takes troupe to cons an element in front of a list. *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun test_strjoin(str, timings, 0) = timings + | test_strjoin(str, timings, n) = + let val startT = getTime() + val newStr = str ^ "d" + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_strjoin(newStr, newTimings, newN) + end +in average (test_strjoin("", [], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/tc-nosendreceive.trp b/troupecheck/timing-experiments/tc-nosendreceive.trp new file mode 100644 index 0000000..140e5ec --- /dev/null +++ b/troupecheck/timing-experiments/tc-nosendreceive.trp @@ -0,0 +1,515 @@ +import lists + +(* +-------------------------------- +INIT FUNCTION + +To be called when starting out testing + +-------------------------------- +*) + +(* +-------------------------------- +PRINTING TO CONSOLE + +Simple functions for more convenient printing to console. + +-------------------------------- +*) +let fun write x auth = + fwrite ((getStdout auth), x) + + fun args_toString args = + let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) + | aux_toString acc (x::xs) = acc ^ (toString x) in + aux_toString "" args end + +(* +-------------------------------- +ERROR HANDLING + +Handles the printing of appropriate error messages for errors that may occur in the use of TroupeCheck. + +-------------------------------- +*) + fun report_error error_reason tco = + let val auth = authority + val err_string = case error_reason of + ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " + ^ (toString tries) ^ " tries.\n" + | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" + | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" + | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" + | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" + | ("shrinking_looped", _) => "Shrinking looped.\n" + | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" + in + write "\u001B[31m \nError: " auth; (* Changing the print color to red *) + write (err_string ^ "\u001B[0m") auth; (* Changing the color back *) + exit (auth, 0) end + + fun boolean_check x tco = + if (getType x)<>"boolean" then report_error ("non_boolean_result", 0) tco else () + + fun function_not_done_check p tco = + if (getType p)<>"function" then report_error ("type_mismatch", 0) tco else () +(* +-------------------------------- +UTILS + +Different utility functions that are used across the library. + +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun make_list (f, i) = + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) + + +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l tco = + let val auth = authority + in case l of + [] => (* this case is only reached if there are no generators to begin with *) + let val _ = boolean_check (p()) tco + val res = p() + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l + val _ = boolean_check res tco + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + end + + fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (append acc [x]) end in + aux s [] end + + (* Combines a list of individual strings to a single string *) + fun list_to_string ls tco = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) tco else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) + + fun report_fail_reason rec noOfTests tco = + let val auth = authority in + case rec.failReason of + "false_prop" => + write "\nFailure at input: " auth; + write (args_toString rec.ctx) auth; + write ("\nAfter running: " ^ (toString (noOfTests - rec.remTests + 1)) ^ " test(s)\n") auth + end + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + (* Hardcoded until a tuple from list function is implemented in Troupe - an issue has been raised on GH.*) + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) + + fun dec_nth list idx = + let fun dec_nth_aux [] acc i = acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => + let val dec_val = if x <= 1/10000 then 0 else x/(3/2) in + append (append acc [dec_val]) xs end + | false => dec_nth_aux xs (append acc [x]) (i+1) + in + dec_nth_aux list [] 0 end + + fun zero_nth list idx = + let fun zero_nth_aux [] acc i = acc + | zero_nth_aux (x::xs) acc i = + case i = idx of + true => + append (append acc [0]) xs + | false => zero_nth_aux xs (append acc [x]) (i+1) + in + zero_nth_aux list [] 0 end + + fun dec_all seq = + let fun dec_all_aux [] i = [] + | dec_all_aux (x::xs) i = + if x = 0 then + dec_all_aux xs (i+1) + else + [(fn () => (zero_nth seq i)), (fn() => [fn () => (dec_nth seq i), fn () => dec_all_aux xs (i+1)])] in + dec_all_aux seq 0 end + + fun seqs_of_seq sequence lengths = + let fun aux seq acc 0 = (acc, seq) + | aux (x::xs) acc n = + aux xs (append acc [x]) (n-1) + val (res, _) = (foldl (fn (x,(acc, s)) => + let val (curr_acc, curr_seq) = aux s [] x in + (append acc [curr_acc], curr_seq) end)([], sequence) lengths) + in res + end + + fun cutoff_at list idx = + let fun aux ls acc 0 = acc + | aux (x::xs) acc i = + aux xs (append acc [x]) (i-1) in + aux list [] idx end + + fun for_i f y 0 = y + | for_i f y i = for_i f (f (i,y)) (i-1) +(* +-------------------------------- +SHRINKING + +Works by first using random shrinking when a failing example has been found (shrink & random_shrink_aux). +Random shrinking means simply generating new test cases with gradually smaller size, to find a case smaller than the original one. This rarely produces a minmal result. +The smallest randomly shrunk instance is then further shrunk using internal shrinking. (internal_shrink & internal_shrink_aux) +Internal shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. + +This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (rec_rng & rep_rng). +All of these functions are spawned and then requests or updates may be send to them, so that the correct RNG's are used at different points in the code. + +-------------------------------- +*) + fun random_shrink_aux generators prop pre success size counter divi tco = + if (counter = 1000) orelse (size = 0) then {count = success, size = size} else + let val new_size = floor (size/divi) + val (shrunk_args) = + foldl (fn (x, (arg_acc)) => + let val arg = x tco new_size + in (append arg_acc [arg]) + end) ([]) generators + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true + in + case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of + true => random_shrink_aux generators prop pre success size (counter+1) (divi+2) tco + | false => + random_shrink_aux generators prop pre (success+1) new_size (0) 2 tco + end + + fun shrink generators prop pre size counter tco = + let val res = random_shrink_aux generators prop pre 0 size counter 2 tco + in + res + end +(* +-------------------------------- +GENERATORS + +Contains generators for Troupe's built-in types. All generators must return a single instance of the type they generate, +and take a 'size' argument as the very last argument. +This size will be given to all generators in the generation of test cases (and shrinking). +Generators that take more arguments, will need to have these passed along to them before passing the generator to the testing facilities +(convenience functions for this are supplied later). + +It is recommended that all user defined generators only make use of pre-defined generators or their matching convenience functions +for random decisions (i.e. a call to float_gen/float() or int_gen/integer()), instead of having to send and receive the correct messages to the RNG threads. +However, it can be done if the users wishes to and understands what is going on. + +-------------------------------- +*) + + fun float_gen (low, high) tco size = + let val x = random() + + val bool_int = random () + + val bool = bool_int < (1/2) + + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + + val res = + case (lInf, hInf) of + (true, true) => if bool then x * size else -x * size + | (true, false) => high - (x * size) + | (false, true) => low + (x * size) + | (false, false) => low + (x * (high-low)) + in res + end + + fun int_gen (low, high) tco size = + let val res = floor (float_gen (low, high+1) tco size) + in res + end + + fun one_of ls tco size = + let val idx = (int_gen (1, (length ls)) tco size) + in (nth ls idx) + end + + fun bool_gen tco size = + let val rnd = int_gen (0,1) tco size + val res = if rnd = 0 then false + else true + in res + end + + (* NOTE: Generates only letters (upper and lower case) and numbers. *) + fun char_gen tco size = + let val chars = + ["a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", + "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", + "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", + "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] (* length: 62 *) + val x = (int_gen (1, (62-1)) tco size) + in nth chars x + end + + fun label_gen tco size = + newlabel() + + (* ts: list of generators - used to generate values for fields *) + (* NOTE: Hardcoded for tuple of up to 10 elements - see build_tuple in 'UTILS' *) + fun tuple_gen ts tco size = + let val ts_vals = map (fn x => x tco size) ts + in build_tuple ts_vals + end + + (* ns: list of strings - will be used as fieldnames *) + (* ts: list of generators - used to generate values for fields *) + fun rec_gen ns ts tco size = + if (length ns) <> (length ts) then + report_error ("record_mismatch", 0) tco + else + let val ts_vals = map (fn x => x tco size) ts + val res = build_record ns ts_vals + in res + end + + fun labeled_value_gen labels value_gen tco size = + let val inst = value_gen tco size + val lab = one_of labels tco size + in inst raisedTo lab + end + + fun combined_labeled_gen labels gen tco size = + let val labels_to_use = foldl(fn (x,y) => if (bool_gen tco size) then append y [x] else y)[`{}`] labels + val value = gen tco size + val res = foldl (fn (x,y) => y raisedTo x) value labels_to_use + in res + end + + (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + fun string_gen tco size = + let val length = (int_gen (0, size) tco size) + fun string_aux acc 0 = acc + | string_aux acc i = string_aux ((char_gen tco size) ^ acc) (i-1) + val string = (string_aux "" length) + in string + end + + and list_gen () tco size = + let val len = (int_gen (0, size) tco size) + val gen = generator_gen tco size + val res = make_list ((fn () => gen tco size), len) + in res + end + | list_gen (generator) tco size = + let val len = (int_gen (0, size) tco size) + val res = make_list ((fn () => generator tco size), len) + in res + end + + and generator_gen tco size = + let val inf = 1/0 + val gens_ls = + case (size mod 3) of + 0 => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, char_gen, string_gen] + | _ => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, (list_gen(generator_gen tco (size-1))), char_gen, string_gen, + (tuple_gen (list_gen(generator_gen tco (size-1)))), (rec_gen (list_gen(string_gen)) ((generator_gen tco (size-1)))), + (labeled_value_gen (list_gen(string_gen)) (generator_gen tco (size-1)))] + val gen = one_of gens_ls tco size + in gen end + +(* +-------------------------------- +CORE FUNCTIONALITY + +Handles preparing the recorder RNG, running the tests, calling the shrinker, and reporting the results to the user. + +-------------------------------- +*) + fun core_forall (generators, prop, 0, size, pre, cap, tco) = {failReason = (), ctx = (), remTests = 0, size = size} + |core_forall (generators, prop, i, size, pre, cap, tco) = + let val auth = authority + val (args) = foldl (fn (x, (arg_acc)) => + let val arg = x tco size + in (append arg_acc [arg]) + end) ([]) generators + in + case pre of + () => + if (apply_args prop args tco) then + let val _ = write "." auth + in core_forall (generators, prop, i-1, size+1, pre, cap, tco) + end + else + let val _ = write "!" auth + in {failReason = "false_prop", ctx = args, remTests = i, size = size} + end + | _ => + if (apply_args pre args tco) then + if (apply_args prop args tco) then (write "." auth; core_forall (generators, prop, i-1, size+1, pre, cap, tco)) + else + let val _ = write "!" auth + in {failReason = "false_prop", ctx = args, remTests = i, size = size} + end + else + let val _ = write "x" auth + in if (size = cap) andalso (i*5 = cap) then report_error ("cant_satisfy", size) tco + else if size = cap then {failReason = (), ctx = (), remTests = i, size = size} + else core_forall (generators, prop, i, size+1, pre, cap, tco) + end + end + + fun run_tests (generators, p, to_shrink, noOfTests) auth = + let val (prop, pre) = + case p of + (x,y) => (x,y) + | x => (x, ()) + val tco = () + val res = core_forall (generators, prop, noOfTests, 0, pre, (noOfTests*5), tco) in + case res.failReason of + () => write ("\u001B[1m \u001B[32m \nSuccess: \u001B[0mPassed all " ^ (toString noOfTests) ^ " test(s).\n") auth; true + |_ => + report_fail_reason res noOfTests tco; + if to_shrink then + (write ("\u001B[1m\u001B[34mShrinking\u001B[0m:") auth; + let val shrink_res = shrink generators prop pre res.size 0 tco in + write "\nFailing test case was shrunk to:\n" auth; + write (args_toString shrink_res.shrunk_ctx) auth; + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n") auth; + false + end) + else + false + end + + fun for_all (generators, p) auth = run_tests (generators, p, true, 100) auth + | for_all (generators, p, noOfTests) auth = run_tests (generators, p, true, noOfTests) auth + + fun for_all_noshrink (generators, p) auth = run_tests (generators, p, false, 100) auth + | for_all_noshrink (generators, p, noOfTests) auth = run_tests (generators, p, false, noOfTests) auth + + fun troupecheck props auth = + let val n = toString (length props) + fun troupecheck_aux [] i = ()(* exit(auth, 0) *) + | troupecheck_aux (x::xs) i = + let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") auth + val res = x() auth + in troupecheck_aux xs (i+1) end + in troupecheck_aux props 1 + end + +(* +-------------------------------- +CONVENIENCE FUNCTIONS + +These are functions that make it easier for the user to make use of the different generators, and define their own generators. + +-------------------------------- +*) + val inf = 1 / 0 + fun integer () = int_gen(inf, inf) + | integer (l, h) = int_gen(l, h) + + fun pos_integer () = integer(0, inf) + + fun neg_integer () = integer(inf, -1) + + fun float () = float_gen(inf, inf) + | float (h, l) = float_gen(h, l) + + fun pos_float () = float(0, inf) + + fun neg_float () = float(inf, 0) + + fun boolean () = bool_gen + + fun list () = list_gen () + |list (type) = list_gen (type) + + fun string () = string_gen + + fun char () = char_gen + + fun generator() = generator_gen + + fun tuple (ts) = tuple_gen ts + + fun labeled_value (ls, gen) = labeled_value_gen ls gen + + fun combined_labeled_value (ls, gen) = combined_labeled_gen ls gen + + fun label() = label_gen + + fun record (ns, ts) = rec_gen ns ts + + + + + fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun tuple_test (number, string) = + getType number = "number" + + fun prop_tuple_test() = for_all ([tuple([integer(), string()])], tuple_test) + + fun int_test x = + (getType x) = "number" + + fun prop_int_test() = for_all ([integer()], int_test) + + fun test_troupecheck(ls, 0) = ls + | test_troupecheck(ls, n) = + let val startT = getTime() + val _ = troupecheck [prop_tuple_test] authority + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newList = append ls [elapsedMilliseconds] + val newN = (n-1) + in test_troupecheck(newList, newN) + end +in + average (test_troupecheck([], 100)) +end From ffb7a21628e6adca6a30d3a41900d73292a15331 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 31 May 2024 15:13:26 +0200 Subject: [PATCH 113/121] More timing experiments --- troupecheck/timing-experiments/floattest.trp | 45 ++++++++++++++ troupecheck/timing-experiments/floortest.trp | 51 ++++++++++++++++ troupecheck/timing-experiments/inttest3.trp | 4 +- .../timing-experiments/patterntest.trp | 59 +++++++++++++++++++ 4 files changed, 157 insertions(+), 2 deletions(-) create mode 100644 troupecheck/timing-experiments/floattest.trp create mode 100644 troupecheck/timing-experiments/floortest.trp create mode 100644 troupecheck/timing-experiments/patterntest.trp diff --git a/troupecheck/timing-experiments/floattest.trp b/troupecheck/timing-experiments/floattest.trp new file mode 100644 index 0000000..c131c98 --- /dev/null +++ b/troupecheck/timing-experiments/floattest.trp @@ -0,0 +1,45 @@ +import lists +(* This file times how long it takes takes troupe to cons an element in front of a list. *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun float_gen (low, high) tco size = + let val x = random() + + val bool_int = random () + + val bool = bool_int < (1/2) + + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + + val res = + case (lInf, hInf) of + (true, true) => if bool then x * size else -x * size + | (true, false) => high - (x * size) + | (false, true) => low + (x * size) + | (false, false) => low + (x * (high-low)) + in res + end + + val inf = 1/0 + + fun test_float(timings, 0) = timings + | test_float(timings, n) = + let val startT = getTime() + val _ = float_gen(inf, inf) () n + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_float(newTimings, newN) + end +in average (test_float([], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/floortest.trp b/troupecheck/timing-experiments/floortest.trp new file mode 100644 index 0000000..b50844d --- /dev/null +++ b/troupecheck/timing-experiments/floortest.trp @@ -0,0 +1,51 @@ +import lists +(* This file times how long it takes takes troupe to cons an element in front of a list. *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun float_gen (low, high) tco size = + let val x = random() + + val bool_int = random () + + val bool = bool_int < (1/2) + + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + + val res = + case (lInf, hInf) of + (true, true) => if bool then x * size else -x * size + | (true, false) => high - (x * size) + | (false, true) => low + (x * size) + | (false, false) => low + (x * (high-low)) + in res + end + + fun int_gen (low, high) tco size = + let val res = floor (float_gen (low, high+1) tco size) + in res + end + + val inf = 1/0 + + fun test_floor(timings, 0) = timings + | test_floor(timings, n) = + let val float = float_gen(inf, inf) () n + val startT = getTime() + val _ = floor float + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_floor(newTimings, newN) + end +in average (test_floor([], 100)) +end \ No newline at end of file diff --git a/troupecheck/timing-experiments/inttest3.trp b/troupecheck/timing-experiments/inttest3.trp index 1a9e351..5732fa2 100644 --- a/troupecheck/timing-experiments/inttest3.trp +++ b/troupecheck/timing-experiments/inttest3.trp @@ -39,12 +39,12 @@ let fun sum [] acc = acc fun test_int(timings, 0) = timings | test_int(timings, n) = let val startT = getTime() - val n = int_gen(inf, inf) () n + val _ = int_gen(inf, inf) () n val endT = getTime() val elapsedMilliseconds = endT - startT val newTimings = append timings [elapsedMilliseconds] val newN = (n-1) in test_int(newTimings, newN) end -in sum (test_int([], 100)) 0 +in average (test_int([], 100)) end \ No newline at end of file diff --git a/troupecheck/timing-experiments/patterntest.trp b/troupecheck/timing-experiments/patterntest.trp new file mode 100644 index 0000000..9a7ade6 --- /dev/null +++ b/troupecheck/timing-experiments/patterntest.trp @@ -0,0 +1,59 @@ +import lists +(* This file times how long it takes takes troupe to cons an element in front of a list. *) +let fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end + + fun float_gen (low, high) tco size = + let val x = random() + + val bool_int = random () + + val bool = bool_int < (1/2) + + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + + val res = + case (lInf, hInf) of + (true, true) => if bool then x * size else -x * size + | (true, false) => high - (x * size) + | (false, true) => low + (x * size) + | (false, false) => low + (x * (high-low)) + in res + end + + val inf = 1/0 + val low = inf + val high = inf + + fun test_pattern(timings, 0) = timings + | test_pattern(timings, n) = + let val x = random() + + val bool_int = random () + + val bool = bool_int < (1/2) + val lInf = low = 1/0 (* check for inf *) + val hInf = high = 1/0 + val startT = getTime() + val res = + case (lInf, hInf) of + (true, true) => if bool then x * n else -x * n + | (true, false) => high - (x * n) + | (false, true) => low + (x * n) + | (false, false) => low + (x * (high-low)) + val endT = getTime() + val elapsedMilliseconds = endT - startT + val newTimings = append timings [elapsedMilliseconds] + val newN = (n-1) + in test_pattern(newTimings, newN) + end +in average (test_pattern([], 100)) +end \ No newline at end of file From 442d6f04f38a05a6a719df4b9291606121445ed5 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 7 Jun 2024 18:31:11 +0200 Subject: [PATCH 114/121] Small changes - that optimize time a little bit --- lib/troupecheck.trp | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index 97fc3d4..de2c3c4 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -438,8 +438,8 @@ However, it can be done if the users wishes to and understands what is going on. "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", - "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - val x = (int_gen (1, ((length chars)-1)) tco size) + "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] (* length: 62 *) + val x = (int_gen (1, (62-1)) tco size) in nth chars x end @@ -477,14 +477,16 @@ However, it can be done if the users wishes to and understands what is going on. in res end - (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) + (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) fun string_gen tco size = - let val char_ls = list_gen (char_gen) tco size - val string = list_to_string char_ls tco + let val length = (int_gen (0, size) tco size) + fun string_aux acc 0 = acc + | string_aux acc i = string_aux ((char_gen tco size) ^ acc) (i-1) + val string = (string_aux "" length) in string end - and list_gen () tco size = + fun list_gen () tco size = let val len = (int_gen (0, size) tco size) val gen = generator_gen tco size val res = make_list ((fn () => gen tco size), len) @@ -585,7 +587,7 @@ Handles preparing the recorder RNG, running the tests, calling the shrinker, and fun troupecheck props auth = let val n = toString (length props) - fun troupecheck_aux [] i = exit(auth, 0) + fun troupecheck_aux [] i = exit(auth, 0) | troupecheck_aux (x::xs) i = let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") auth val res = x() auth From 3cb1e7ee1a52c845b4838cd65ce48ce10716fc8c Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Fri, 7 Jun 2024 18:31:42 +0200 Subject: [PATCH 115/121] Different small changes that were made during evaluation --- .../language-interpreter/test-language.trp | 10 +- troupecheck/tc_archive/tc_ext_shrink.trp | 171 ++++- .../internal-shrink-timings.trp | 607 ++++++++++++++++++ .../shrink_comparisons.trp | 0 4 files changed, 753 insertions(+), 35 deletions(-) create mode 100644 troupecheck/timing-experiments/internal-shrink-timings.trp rename troupecheck/{tc_tests => timing-experiments}/shrink_comparisons.trp (100%) diff --git a/troupecheck/language-interpreter/test-language.trp b/troupecheck/language-interpreter/test-language.trp index 5b2f9cc..64991f8 100644 --- a/troupecheck/language-interpreter/test-language.trp +++ b/troupecheck/language-interpreter/test-language.trp @@ -43,16 +43,14 @@ let fun eval exp env = in interpretHelper rest newEnv end - val stmts = remove_nth ((length prog)-1) prog 0 - val exp = nth prog (length prog) + val (stmts, exp) = prog val last_env = (interpretHelper stmts []) in eval exp last_env end fun optimize_prog prog = - let val stmts = remove_nth ((length prog)-1) prog 0 - val exp = nth prog (length prog) + let val (stmts, exp) = prog fun optimize_exp exp = case exp of ("num", n) => ("num", n) @@ -87,7 +85,7 @@ let fun eval exp env = ("assign", var, exp) => ("assign", var, (optimize_exp exp)) | ("print", exp) => ("print", (optimize_exp exp)) in - append (map optimize_stmt stmts) [optimize_exp exp] + ((map optimize_stmt stmts), optimize_exp exp) end fun exp_gen ls nesting_level tco size = @@ -166,7 +164,7 @@ let fun eval exp env = end val (prog_stmts, last_env) = prog_gen_aux [] [] num_of_insts val last_exp = exp_gen last_env 0 tco size - val prog = append prog_stmts [last_exp] + val prog = (prog_stmts, last_exp) in prog end diff --git a/troupecheck/tc_archive/tc_ext_shrink.trp b/troupecheck/tc_archive/tc_ext_shrink.trp index 315d47b..85d00e4 100644 --- a/troupecheck/tc_archive/tc_ext_shrink.trp +++ b/troupecheck/tc_archive/tc_ext_shrink.trp @@ -11,6 +11,10 @@ let val out = getStdout authority let fun aux_toString acc (x0::x1::xs) = aux_toString (acc ^ (toString x0) ^ ", ") (x1::xs) | aux_toString acc (x::xs) = acc ^ (toString x) in aux_toString "" args end + + fun nth (x::l) 1 = x + | nth (x::l) n = nth l (n - 1) + | nth x y = print x; print y; exit (authority, 0) (* -------------------------------- ERROR HANDLING - w @@ -299,7 +303,7 @@ SHRINKING - r | _ => let val init_shrink_idx = args.shrink_idx val newArgs = mapi (fn (i, x) => if i = init_shrink_idx then (nth args.shrinkers (i+1)) x else x) args.args - val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" + val nextState = if (foldl (fn (x,y) => (x.state = "done") andalso y) true newArgs) then "done" else "cont" val shrink_idx = if (nth newArgs (init_shrink_idx+1)).state = "done" then init_shrink_idx+1 else init_shrink_idx in @@ -307,7 +311,7 @@ SHRINKING - r end fun shrink_aux args prop pre counter = - if counter = 100 then report_error ("shrinking_looped", 0) else + if counter = 1000 then report_error ("shrinking_looped", 0) else let val shrunk_args = args_shrink args val shrunk_args_raw = map (fn x => x.curr) shrunk_args.args val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args_raw) else true in @@ -317,11 +321,13 @@ SHRINKING - r if shrunk_args.state = "done" then {shrunk_ctx = shrunk_args_raw, count = counter} else shrink_aux shrunk_args prop pre (counter+1) end fun shrink args prop pre = - let val shrinkers = map (fn x => x.shrinker) args + let val start_time = getTime() + val shrinkers = map (fn x => x.shrinker) args val args_shrink_ready = map (fn x => {state = "init", curr = x.raw, prev = x.raw}) args val args_rec = {state = "init", args = args_shrink_ready, shrinkers = shrinkers, shrink_idx = 0} val res = shrink_aux args_rec prop pre 0 - in res end + val end_time = getTime() + in (res, (end_time - start_time)) end (* -------------------------------- GENERATORS - t @@ -469,12 +475,12 @@ CORE FUNCTIONALITY - a |_ => report_fail_reason res noOfTests; write ("\u001B[1m\u001B[34mShrinking\u001B[0m:"); - let val shrink_res = shrink res.cEx prop pre in + (* let val shrink_res = shrink res.cEx prop pre in write "\nFailing test case was shrunk to:\n"; write (args_toString shrink_res.shrunk_ctx); - write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); - false - end + write ("\nAfter " ^ (toString shrink_res.count) ^ " iterations.\n"); *) + (false, res.cEx) + (* end *) end fun for_all (generators, p) = run_tests generators p 100 @@ -482,12 +488,12 @@ CORE FUNCTIONALITY - a fun troupecheck props = let val n = toString (length props) - fun troupecheck_aux [] i = exit (authority, 0) - | troupecheck_aux (x::xs) i = + fun troupecheck_aux [] acc i = acc + | troupecheck_aux (x::xs) acc i = let val _ = write ("\nRunning test " ^ (toString i) ^ " of " ^ n ^ ":\n") - val _ = x() - in troupecheck_aux xs (i+1) end - in troupecheck_aux props 1 + val res = x() + in troupecheck_aux xs res (i+1) end + in troupecheck_aux props () 1 end (* @@ -523,10 +529,31 @@ CONVENIENCE FUNCTIONS - s fun record ns ts = rec_gen ns ts - fun one_of ls = - let val idx = (int_gen (1, (length ls)) ((length ls))).raw + fun one_of ls size = + let val {raw, shrinker} = (int_gen (1, (length ls)) ((length ls))) + val raw_res = nth ls raw + fun oneOf_shrinker inst = + case inst.state of + "init" => + let val interim = shrinker {state = inst.state, curr = raw, prev = raw} + val new_idx = if interim.curr < 1 then 1 else interim.curr + val _ = print new_idx + val _ = print ls + val new_pick = nth ls new_idx + in {state = interim.state, curr = new_pick, prev = inst.curr, idx = new_idx, prev_idx = raw} + end + | _ => + if inst.idx = 1 then {inst with state = "done"} + else + let val interim = shrinker {state = inst.state, curr = inst.idx, prev = inst.prev_idx} + val new_idx = if interim.curr < 1 then 1 else interim.curr + val _ = print new_idx + val _ = print ls + val new_pick = nth ls new_idx + in {state = interim.state, curr = new_pick, prev = inst.curr, idx = new_idx, prev_idx = inst.idx} + end in - nth ls idx + {raw = raw_res, shrinker = oneOf_shrinker} end (* -------------------------------- @@ -728,8 +755,7 @@ CUSTOM TYPE PROGRAM in interpretHelper rest newEnv end - val stmts = remove_nth ((length prog)-1) prog 0 - val exp = nth prog (length prog) + val (stmts, exp) = prog val last_env = (interpretHelper stmts []) in eval exp last_env @@ -913,14 +939,14 @@ CUSTOM TYPE PROGRAM in prog_gen_aux newEnv (append p [stmt.raw]) (append s [stmt.shrinker]) (i-1) end - val (prog_stmts, shrinkers_interim, last_env) = prog_gen_aux [] [] [] num_of_insts + val (prog_stmts, stmts_shrinkers, last_env) = prog_gen_aux [] [] [] num_of_insts val last_exp = exp_gen last_env 0 size - val prog = append prog_stmts [last_exp.raw] - val shrinkers = append shrinkers_interim [last_exp.shrinker] - fun shrinker inst = + val prog = (prog_stmts, last_exp.raw) + fun stmts_shrinker inst = case inst.state of "init" => - let val shrunk = shrink_list shrinkers inst + let + val shrunk = shrink_list stmts_shrinkers inst in shrunk end @@ -929,21 +955,21 @@ CUSTOM TYPE PROGRAM in if next_elem.0 = "assign" then if (assign_in_use inst.curr [] (next_elem.1) 0 false).0 then - print "testing"; {inst with idx = inst.idx-1} else if (next_elem.0 = "var") orelse (next_elem.0 = "num") orelse (next_elem.0 = "add") orelse (next_elem.0 = "sub") orelse (next_elem.0 = "mul") orelse (next_elem.0 = "div") then {inst with idx = inst.idx-1} else - shrink_list shrinkers inst + shrink_list stmts_shrinkers inst else - shrink_list shrinkers inst + shrink_list stmts_shrinkers inst end | _ => - shrink_list shrinkers inst + shrink_list stmts_shrinkers inst + val stmts_val = {raw = prog_stmts, shrinker = stmts_shrinker} in - {raw = prog, shrinker = shrinker} + {raw = prog, shrinker = shrink_sized_aggregate [stmts_val, last_exp] build_tuple} end fun test_prog_opt prog = @@ -954,6 +980,93 @@ CUSTOM TYPE PROGRAM r.theInteger < 50 fun prop_program_shrink() = for_all ([program_gen], test_prog_shrink) fun prop_record_shrink() = for_all ([(record ["theInteger", "theString"] [integer(), string()])], record_shrink_test) + + fun even_number_gen size = + let val {raw, shrinker} = integer() size + val raw_res = raw * 2 + fun this_shrinker inst = + let val interim = shrinker {inst with curr = (inst.curr / 2), prev = (inst.prev / 2)} + val res = {interim with curr = (interim.curr * 2), prev = (interim.prev * 2)} + in res + end + in {raw = raw_res, shrinker = this_shrinker} + end + + fun even_test i = + (i mod 2 = 0) andalso (i < 10) + fun even_stmt() = + for_all ([even_number_gen], even_test) + + fun test_shrinking stmt prop n = + let fun aux acc 0 = acc + | aux acc i = + let val (_, ctx) = troupecheck [stmt] + val _ = print i + val pre = () + val timing = (shrink ctx prop pre).1 + val newAcc = timing :: acc + in aux newAcc (i-1) + end + in + aux [] n + end + + (* -----------Tests the shrinking of a record with an integer and a string *) + fun record_shrink_test r = + r.theInteger < 50 + + + (* -----------Tests the shrinking of a two strings*) + fun append_always_longer s1 s2 = + let fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) + in aux xs (append acc [x]) + end + in aux s [] + end + fun string_length s = + length (string_to_list s) + in string_length s1 < string_length (s1 ^ s2) + end + + (* -----------Tests the shrinking of a list of integers *) + fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + + (* -----------Tests the shrinking of a list of strings and a single string *) + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + + (* -----------Tests the shrinking of a float and a one_of statement with a long list *) + fun float_one_of_bad_shrink flt oneOf = + if (flt > 50) andalso (oneOf >= 1) then false else true + + + fun record_int_string_shrink() = for_all ([(record (["theInteger", "theString"], [integer(), string()]))], record_shrink_test) + fun two_strings_shrink() = for_all ([string(), string()], append_always_longer) + fun integer_list_shrink() = for_all ([list(integer())], my_sort_keep_length) + fun string_and_string_list_shrink() = for_all ([list(string()), string()], test_bad_insert) + fun float_and_one_of_shrink() = for_all ([float(), one_of [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]], float_one_of_bad_shrink) in (* @@ -962,7 +1075,7 @@ ALL TESTS - x -------------------------------- *) -troupecheck[prop_record_shrink] +print (test_shrinking float_and_one_of_shrink float_one_of_bad_shrink 100) (* tc [program_gen] test_prog_opt *) (* shrinking tests - x *) diff --git a/troupecheck/timing-experiments/internal-shrink-timings.trp b/troupecheck/timing-experiments/internal-shrink-timings.trp new file mode 100644 index 0000000..5234412 --- /dev/null +++ b/troupecheck/timing-experiments/internal-shrink-timings.trp @@ -0,0 +1,607 @@ +import troupecheck +import lists +(* NOTE: for this program to work, troupecheck library file needs to modified to return a tuple on the form: + (<>, <>, <>, <>) + when a failing a test. + The test that is run must always fail at some point. + This program was only made to time different examples of internal shrinking and not meant for further usage.*) + + +let fun eval exp env = + case exp of + ("num", n) => n + | ("var", n) => lookup env n ("unknown variable " ^ n) + | ("add", e1, e2) => (eval e1 env) + (eval e2 env) + | ("sub", e1, e2) => (eval e1 env) - (eval e2 env) + | ("mul", e1, e2) => (eval e1 env) * (eval e2 env) + | ("div", e1, e2) => (eval e1 env) / (eval e2 env) + | _ => print ("Error: ill defined expression"); exit (authority, 1) + + fun execute stmt env = + case stmt of + ("assign", var, exp) => + let val value = eval exp env + in + append [(var, value)] env + end + | ("print", exp) => (()(* print ("from prog: " ^ (toString (eval exp env)) *); env) + + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun interpret prog = + let fun interpretHelper [] env = env + | interpretHelper (stmt :: rest) env = + let val newEnv = execute stmt env + in + interpretHelper rest newEnv + end + val (stmts, exp) = prog + val last_env = (interpretHelper stmts []) + in + eval exp last_env + end + + fun optimize_prog prog = + let val (stmts, exp) = prog + fun optimize_exp exp = + case exp of + ("num", n) => ("num", n) + | ("var", x) => ("var", x) + | ("add", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1+n2)) + |_ => ("add", (optimize_exp e1), (optimize_exp e2))) + | _ => ("add", (optimize_exp e1), (optimize_exp e2))) + | ("sub", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1-n2)) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("sub", (optimize_exp e1), (optimize_exp e2))) + | ("mul", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => ("num", (n1*n2)) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("mul", (optimize_exp e1), (optimize_exp e2))) + | ("div", e1, e2) => + (case e1 of + ("num", n1) => (case e2 of + ("num", n2) => if ((n1 = 0) andalso (n2 = 0)) then ("div", e1, e2) else ("num", (n1/n2)) + |_ => ("div", (optimize_exp e1), (optimize_exp e2)) ) + |_ => ("div", (optimize_exp e1), (optimize_exp e2))) + + fun optimize_stmt stmt = + case stmt of + ("assign", var, exp) => ("assign", var, (optimize_exp exp)) + | ("print", exp) => ("print", (optimize_exp exp)) + in + ((map optimize_stmt stmts), optimize_exp exp) + end + + fun exp_gen ls nesting_level tco size = + let val exp_ts = + if nesting_level = 2 then ["num"] + else (if length ls = 0 then ["num", "add", "sub", "mul", "div"] + else ["var", "num", "add", "sub", "mul", "div"]) + val exp_type = one_of exp_ts tco size + in + case exp_type of + "num" => + let val value = integer(1, inf) tco size in + ("num", value) end + | "var" => + let val value = one_of ls tco size in + ("var", value) end + |"add" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("add", e1, e2) + end + |"sub" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("sub", e1, e2) + end + |"mul" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("mul", e1, e2) + end + |"div" => + let val e1 = exp_gen ls (nesting_level+1) tco size + val e2 = exp_gen ls (nesting_level+1) tco size + in + ("div", e1, e2) + end + end + + fun assign_stmt_gen ls tco size = + let val n = string() tco size + val exp = exp_gen ls 0 tco size + in + ("assign", n, exp) + end + + fun print_stmt_gen ls tco size = + let val exp = exp_gen ls 0 tco size + in + ("print", exp) + end + + fun stmt_gen ls tco size = + let val stmt = one_of ["print", "assign"] tco size + in + case stmt of + "assign" => + let val res = assign_stmt_gen ls tco size in + res end + |"print" => + let val res = print_stmt_gen ls tco size in + res end + end + + fun program_gen tco size = + let val num_of_insts = (integer(0, size) tco size) + fun prog_gen_aux env p 0 = (p, env) + | prog_gen_aux env p i = + let val stmt = stmt_gen env tco size + val newEnv = if stmt.0 = "assign" then (append [stmt.1] env) else env + in + prog_gen_aux newEnv (append p [stmt]) (i-1) + end + val (prog_stmts, last_env) = prog_gen_aux [] [] num_of_insts + val last_exp = exp_gen last_env 0 tco size + val prog = (prog_stmts, last_exp) + in + prog + end + + fun test_prog_shrink prog = + (interpret prog) < 100 + (* -----------Tests shrinking of even numbers *) + fun even_number_gen tco size = + let val int = integer() tco size + in int * 2 + end + fun even_test i = + (i mod 2 = 0) andalso (i < 10) + (* -----------Tests the shrinking of a record with an integer and a string *) + fun record_shrink_test r = + r.theInteger < 50 + + + (* -----------Tests the shrinking of a two strings*) + fun append_always_longer s1 s2 = + let fun string_to_list s = + let fun aux "" acc = acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) + in aux xs (append acc [x]) + end + in aux s [] + end + fun string_length s = + length (string_to_list s) + in string_length s1 < string_length (s1 ^ s2) + end + + (* -----------Tests the shrinking of a list of integers *) + fun filter_less ([], _) = [] + | filter_less ((x::xs), p) = + if x < p then append [x] (filter_less (xs, p)) else (filter_less (xs, p)) + + fun filter_greater ([], _) = [] + | filter_greater ((x::xs), p) = + if x > p then append [x] (filter_greater (xs, p)) else (filter_greater (xs, p)) + + + fun my_quicksort [] = [] + | my_quicksort (x::xs) = + let val smaller = my_quicksort(filter_less(xs, x)) + val greater = my_quicksort(filter_greater(xs, x)) in + append (append smaller [x]) (greater) end + fun my_sort_keep_length xs = + length xs = length (my_quicksort(xs)) + + (* -----------Tests the shrinking of a list of strings and a single string *) + fun bad_insert xs x = + if length xs < 10 then append [x] xs else + xs + fun test_bad_insert xs x = + length (bad_insert xs x) = (length xs) + 1 + + (* -----------Tests the shrinking of a float and a one_of statement with a long list *) + fun float_one_of_bad_shrink flt oneOf = + if (flt > 50) andalso (oneOf >= 1) then false else true + + (* Statements to choose from *) + fun program_shrink() = for_all ([program_gen], test_prog_shrink) + fun record_int_string_shrink() = for_all ([(record (["theInteger", "theString"], [integer(), string()]))], record_shrink_test) + fun two_strings_shrink() = for_all ([string(), string()], append_always_longer) + fun integer_list_shrink() = for_all ([list(integer())], my_sort_keep_length) + fun string_and_string_list_shrink() = for_all ([list(string()), string()], test_bad_insert) + fun float_and_one_of_shrink() = for_all ([float(), one_of [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]], float_one_of_bad_shrink) + + + +(* +------------------------------ +INTERNAL SHRINKING + +------------------------------ +*) + fun report_error tup = + print tup.0; + exit (authority, 0) + + fun boolean_check x tco = + () + + fun function_not_done_check p tco = + () +(* +-------------------------------- +UTILS + +Different utility functions that are used across the library. + +-------------------------------- +*) + fun remove_nth n [] i = [] + | remove_nth n (x::xs) i = + if n = i then xs + else x :: (remove_nth n xs (i + 1)) + + fun make_list (f, i) = + case i of + 0 => [] + | _ => (f()) :: (make_list (f, i-1)) + + fun abs_value x = + if x < 0 then -x else x + +(* TODO: handle when arguments are passed to a property that does not take arguments *) + fun apply_args p l tco = + let val _ = send (tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + in case l of + [] => (* this case is only reached if there are no generators to begin with *) + let val _ = boolean_check (p()) tco + val res = p() + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + | (x::xs) => + let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l + val _ = boolean_check res tco + val _ = blockdecl auth + in declassify (res, auth, `{}`) + end + end + + fun string_to_list s = + let fun aux "" acc = reverse acc + | aux s acc = + let val x = substring (s, 0, 1) + val xs = substring (s, 1, 1/0) in + aux xs (x :: acc) end in + aux s [] end + + (* Combines a list of individual strings to a single string *) + fun list_to_string ls tco = + foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) tco else y ^ x) "" ls + + fun string_length s = + length (string_to_list s) + + fun build_record names vals = + let fun aux r [] [] = r + | aux r (n::ns) (v::vs) = + aux (recordExtend(r, n, v)) ns vs in + aux {} names vals + end + + (* Hardcoded until a tuple from list function is implemented in Troupe - an issue has been raised on GH.*) + fun build_tuple ls = + case ls of + [] => (0) + |[x] => (x) + |[x1,x2] => (x1,x2) + |[x1,x2,x3] => (x1,x2,x3) + |[x1,x2,x3,x4] => (x1,x2,x3,x4) + |[x1,x2,x3,x4,x5] => (x1,x2,x3,x4,x5) + |[x1,x2,x3,x4,x5,x6] => (x1,x2,x3,x4,x5,x6) + |[x1,x2,x3,x4,x5,x6,x7] => (x1,x2,x3,x4,x5,x6,x7) + |[x1,x2,x3,x4,x5,x6,x7,x8] => (x1,x2,x3,x4,x5,x6,x7,x8) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9] => (x1,x2,x3,x4,x5,x6,x7,x8,x9) + |[x1,x2,x3,x4,x5,x6,x7,x8,x9,x10] => (x1,x2,x3,x4,x5,x6,x7,x8,x9,x10) + |_ => (2, 3, 4, 5) + + fun dec_nth list idx = + let fun dec_nth_aux [] acc i = reverse acc + | dec_nth_aux (x::xs) acc i = + case i = idx of + true => + let val dec_val = if x <= 1/10000 then 0 else x/(3/2) in + append (reverse (0 :: acc)) xs end + | false => dec_nth_aux xs (x :: acc) (i+1) + in + dec_nth_aux list [] 0 end + + fun zero_nth list idx = + let fun zero_nth_aux [] acc i = reverse acc + | zero_nth_aux (x::xs) acc i = + case i = idx of + true => + append (reverse (0 :: acc)) xs + | false => zero_nth_aux xs (x :: acc) (i+1) + in + zero_nth_aux list [] 0 end + + fun dec_all seq = + let fun dec_all_aux [] i = [] + | dec_all_aux (x::xs) i = + if x = 0 then + dec_all_aux xs (i+1) + else + [(fn () => (zero_nth seq i)), (fn() => [fn () => (dec_nth seq i), fn () => dec_all_aux xs (i+1)])] in + dec_all_aux seq 0 end + + fun seqs_of_seq sequence lengths = + let fun aux seq acc 0 = (reverse acc, seq) + | aux (x::xs) acc n = + aux xs (x :: acc) (n-1) + val (res, _) = (foldl (fn (x,(acc, s)) => + let val (curr_acc, curr_seq) = aux s [] x in + (curr_acc :: acc, curr_seq) end)([], sequence) lengths) + in reverse res + end + + fun cutoff_at list idx = + let fun aux ls acc 0 = reverse acc + | aux (x::xs) acc i = + aux xs (x :: acc) (i-1) in + aux list [] idx end + + fun for_i f y 0 = y + | for_i f y i = for_i f (f (i,y)) (i-1) + + + + + fun init_tc auth rng = + receive [hn ("REQUEST_RNG", senderid) => + let val _ = send (senderid, rng) + in init_tc auth rng end, + + hn ("REQUEST_AUTH", senderid) => + let val _ = send (senderid, auth) + in init_tc auth rng end, + + hn ("UPDATE_RNG", senderid, new_rng) => + let val _ = send(senderid, "done") in + init_tc auth new_rng end] + + fun rec_rng ls = + receive [hn ("REQUEST_RND", senderid) => + let val rnd = random() + val _ = send (senderid, rnd) + in rec_rng (rnd :: ls ) + end, + hn ("REQUEST_SEQ", senderid) => + let val _ = send (senderid, (reverse ls)) + in rec_rng [] + end] + + fun rep_rng ls = + receive [hn ("REQUEST_RND", senderid) => + case ls of + (x::xs) => + let val _ = send (senderid, x) + in rep_rng xs + end + | [] => + let val _ = send (senderid, 0) + in rep_rng ls + end, + hn ("REQUEST_LEFT", senderid) => + let val _ = send (senderid, ls) + in rep_rng [] + end, + hn ("UPDATE_LS", new_ls) => + rep_rng new_ls] + + fun shrink_sized_sequence seqs gens prop pre size left_over_len idx_of_sized tco = + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + val cap = ceil (((length (nth seqs (idx_of_sized+1)))-2)/left_over_len )(* number of to remove parts of the sequence *) + val size_ls = reverse (for_i (fn (x,y) => x :: y) [] (left_over_len-1)) + fun aux i = + let val to_remove = reverse (foldl (fn (x,y) => ((i*left_over_len)-x) :: y)[i*left_over_len] size_ls) + val new_seq = foldl (fn (x,y) => remove_nth x y 0) (nth seqs (idx_of_sized+1)) to_remove + val new_seqs = mapi (fn (i, x) => if i = idx_of_sized then new_seq else x) seqs + val new_args = mapi (fn (i, x) => + let val _ = send (pid, ("UPDATE_LS", (nth new_seqs (i+1)))) + val arg = x tco size + in arg + end) gens + in case i = (cap) of + true => + (new_seqs, new_args) + | false => + let val precond_is_met = if (pre <> ()) then (apply_args pre new_args tco) else true + in case (apply_args prop new_args tco) orelse (precond_is_met = false) of + true => aux (i+1) + | false => (new_seqs, new_args) + end + end + in aux 1 + end + + + + fun internal_shrink_aux seqs gens lengths prop pre size counter tco = + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + in case seqs of + (x1::x2::x3::xs) => + let val seqs_of_curr = seqs_of_seq (x2()) lengths + val args_and_leftovers = mapi (fn (i, x) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = x tco size + val _ = send (pid, ("REQUEST_LEFT", self())) + val left_overs = receive [hn x => x] + in {arg = arg, left_overs = left_overs} + end) gens + val (test_args_rev, left_over_seqs_rev) = foldl (fn (x, (raws, left_overs)) => (x.arg::raws, x.left_overs::left_overs)) ([],[]) args_and_leftovers + val (test_args, left_over_seqs) = (reverse test_args_rev, reverse left_over_seqs_rev) + val (is_sized_sequence, idx_of_sized, left_over_size, _) = foldl (fn (x,(bool, idx, len, count)) => if (length x > 0) + then (true, count, (length x), (count+1)) + else (bool, idx, len, (count+1))) (false, -1, 0, 0) left_over_seqs + + val (ret_seqs, args) = if is_sized_sequence + then shrink_sized_sequence seqs_of_curr gens prop pre size left_over_size idx_of_sized tco + else (seqs_of_curr, test_args) + val precond_is_met = if (pre <> ()) then (apply_args pre args tco) else true + in + case (apply_args prop args tco) orelse (precond_is_met = false) of + true => internal_shrink_aux (x1::x3()) gens lengths prop pre size counter tco + | false => internal_shrink ret_seqs gens prop pre size (counter+1) tco + end + | (x::xs) => + let val seqs_of_curr = seqs_of_seq (x()) lengths + val test_args = mapi (fn (i, y) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y tco size + in arg end) gens + val precond_is_met = if (pre <> ()) then (apply_args pre test_args tco) else true + in + case (apply_args prop test_args tco) orelse (precond_is_met = false) orelse (size < 0) of + true => + let val res = mapi (fn (i, y) => + let val _ = send (pid, ("UPDATE_LS", (nth seqs_of_curr (i+1)))) + val arg = y tco (size+1) + in arg end) gens in + {shrunk_ctx = res, count = counter} end + | false => internal_shrink_aux [x] gens lengths prop pre (size-1) counter tco + + end + end + + and internal_shrink sequences gens prop pre size counter tco = + let val (seqs_comb, seq_lengths_rev) = foldl (fn (x, (seq, lengths)) => ((append seq x), ((length x) :: lengths))) ([], []) sequences + val seq_lengths = reverse seq_lengths_rev + in + if foldl (fn (x,y) => (x = 0) andalso y) true seqs_comb then + internal_shrink_aux [fn () => seqs_comb] gens seq_lengths prop pre size counter tco + else + let val decreased_seqs = dec_all seqs_comb + val dec_seqs_w_root = (fn() => seqs_comb) :: decreased_seqs + val res = internal_shrink_aux dec_seqs_w_root gens seq_lengths prop pre size (counter) tco + in + res end + end + + fun random_shrink_aux sequences generators prop pre success size counter divi tco = + if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val new_size = floor (size/divi) + val (shrunk_args_rev, shrunk_sequences_rev) = + foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x tco new_size + val _ = send (pid, ("REQUEST_SEQ", self())) + val seq = receive [hn x => x] + in (arg :: arg_acc, seq :: seq_acc) + end) ([],[]) generators + val (shrunk_args, shrunk_sequences) = (reverse shrunk_args_rev, reverse shrunk_sequences_rev) + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true + in + case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of + true => random_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco + | false => + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco + end + + fun internal_shrinker sequence generators prop pre size counter tco = + let val start_time = getTime() + val rng_recorder = spawn (fn() => rec_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) + val _ = receive [hn x => ()] + val res = random_shrink_aux sequence generators prop pre 0 size counter 2 tco + val rng_replayer = spawn (fn() => rep_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) + val _ = receive [hn x => ()] + val res = internal_shrink (res.sequences) generators prop pre res.size (res.count) tco + val end_time = getTime() + in + (res, (end_time - start_time)) end + + fun test_shrinking stmt gens prop n = + let fun aux acc 0 = acc + | aux acc i = + let val (_, ctx_seq, size, ctx) = troupecheck [stmt] authority + val _ = print i + val inter_shrink_tco = spawn (fn() => init_tc authority ()) + val pre = () + val int_val = (internal_shrinker ctx_seq gens prop pre size 0 inter_shrink_tco).1 + val newAcc = int_val :: acc + in aux newAcc (i-1) + end + in + aux [] n + end + + (* Statements to choose from *) + fun program_shrink() = for_all ([program_gen], test_prog_shrink) + fun record_int_string_shrink() = for_all ([(record (["theInteger", "theString"], [integer(), string()]))], record_shrink_test) + fun two_strings_shrink() = for_all ([string(), string()], append_always_longer) + fun integer_list_shrink() = for_all ([list(integer())], my_sort_keep_length) + fun string_and_string_list_shrink() = for_all ([list(string()), string()], test_bad_insert) + fun float_and_one_of_shrink() = for_all ([float(), one_of [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]], float_one_of_bad_shrink) + fun even_numbers_shrink() = for_all ([even_number_gen], even_test) + + (* val test_prog = test_shrinking (program_shrink) [program_gen] test_prog_shrink 100 *) + (* val test_int_string = test_shrinking (record_int_string_shrink) [(record (["theInteger", "theString"], [integer(), string()]))] record_shrink_test 100 *) + (* val test_integer_list = test_shrinking (integer_list_shrink) [list(integer())] my_sort_keep_length 100 *) + (* val test_string_stringList = test_shrinking (string_and_string_list_shrink) [list(string()), string()] test_bad_insert 100 *) + (* val test_float_oneOf = test_shrinking (float_and_one_of_shrink) [float(), one_of [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]] float_one_of_bad_shrink 100 *) + val test_even_number = test_shrinking (even_numbers_shrink) [even_number_gen] even_test 100 + + fun sum [] acc = acc + | sum (x::xs) acc = + sum xs (acc+x) + + fun average ls = + let val len = length ls + val sum_ls = sum ls 0 + in (sum_ls/len) + end +in + (* print "prog:"; + print (test_prog) *) + (* print "int + string:"; + print (test_int_string) *) + (* print "int list:"; + print (test_integer_list) *) + (* print "string + string list:"; + print (test_string_stringList) *) + (* print "float + one_of:"; + print (test_float_oneOf) *) + print "even numbers:"; + print (test_even_number) + +end \ No newline at end of file diff --git a/troupecheck/tc_tests/shrink_comparisons.trp b/troupecheck/timing-experiments/shrink_comparisons.trp similarity index 100% rename from troupecheck/tc_tests/shrink_comparisons.trp rename to troupecheck/timing-experiments/shrink_comparisons.trp From d05e10b4b228ac75982fa7fd0b6cb6df24dd2772 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 9 Jun 2024 13:17:02 +0200 Subject: [PATCH 116/121] Random shrinking - changed cap to 100 --- lib/troupecheck.trp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index de2c3c4..c33f9c0 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -342,7 +342,7 @@ All of these functions are spawned and then requests or updates may be send to t end fun random_shrink_aux sequences generators prop pre success size counter divi tco = - if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else + if (counter = 100) orelse (size = 0) then {count = success, size = size, sequences = sequences} else let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] val new_size = floor (size/divi) From e3882fc65c7971cb7f9d389f889cb6657f294987 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 9 Jun 2024 13:44:29 +0200 Subject: [PATCH 117/121] internal shrinking in shrink_comparison updated to current version --- .../timing-experiments/shrink_comparisons.trp | 164 +++++++++--------- 1 file changed, 81 insertions(+), 83 deletions(-) diff --git a/troupecheck/timing-experiments/shrink_comparisons.trp b/troupecheck/timing-experiments/shrink_comparisons.trp index 013465a..fcf90a8 100644 --- a/troupecheck/timing-experiments/shrink_comparisons.trp +++ b/troupecheck/timing-experiments/shrink_comparisons.trp @@ -36,29 +36,12 @@ Different utility functions that are used across the library. | remove_nth n (x::xs) i = if n = i then xs else x :: (remove_nth n xs (i + 1)) - - fun divide_list_work f length num_workers = - let fun make_infols acc 1 = append acc [(length - (floor(length/num_workers) * (num_workers-1)))] - | make_infols acc i = - make_infols (append acc [floor(length/num_workers)]) (i-1) - val infols = make_infols [] num_workers - val _ = map (fn x => spawn(fn()=> f x)) infols - val res = foldl (fn (_,y) => let val res = receive[hn x => x] in append res y end)[] infols in - res end fun make_list (f, i) = - let fun make_ls_aux (f_aux, n)= - case n of - 0 => [] - | _ => append [f_aux()] (make_ls_aux (f_aux, n-1)) - val self_id = self() - fun func (l) = let val res = make_ls_aux (f, l) in send (self_id, (res)) end - val res = divide_list_work func i 1 - in res - end + case i of + 0 => [] + | _ => append [f()] (make_list (f, i-1)) - fun abs_value x = - if x < 0 then -x else x (* TODO: handle when arguments are passed to a property that does not take arguments *) fun apply_args p l tco = @@ -75,7 +58,7 @@ Different utility functions that are used across the library. let val res = foldl (fn (x,y) => function_not_done_check y tco; y x) p l val _ = boolean_check res tco val _ = blockdecl auth - in declassify (res, auth, `{}`) + in declassify (res, auth, `{}`) end end @@ -93,7 +76,7 @@ Different utility functions that are used across the library. fun string_length s = length (string_to_list s) - + fun build_record names vals = let fun aux r [] [] = r | aux r (n::ns) (v::vs) = @@ -165,10 +148,20 @@ Different utility functions that are used across the library. fun for_i f y 0 = y | for_i f y i = for_i f (f (i,y)) (i-1) +(* +-------------------------------- +SHRINKING +Works by first using random shrinking when a failing example has been found (shrink & random_shrink_aux). +Random shrinking means simply generating new test cases with gradually smaller size, to find a case smaller than the original one. This rarely produces a minmal result. +The smallest randomly shrunk instance is then further shrunk using internal shrinking. (internal_shrink & internal_shrink_aux) +Internal shrinking means keeping track of all random decision made during generation, and then re-generating with smaller "random" decisions. +This part of the code also contains the functionality for recording all random decisions, and replaying these random decisions (rec_rng & rep_rng). +All of these functions are spawned and then requests or updates may be send to them, so that the correct RNG's are used at different points in the code. - +-------------------------------- +*) fun init_tc auth rng = receive [hn ("REQUEST_RNG", senderid) => let val _ = send (senderid, rng) @@ -182,14 +175,15 @@ Different utility functions that are used across the library. let val _ = send(senderid, "done") in init_tc auth new_rng end] + fun rec_rng ls = receive [hn ("REQUEST_RND", senderid) => let val rnd = random() val _ = send (senderid, rnd) - in rec_rng (append ls [rnd]) + in rec_rng (rnd :: ls) end, hn ("REQUEST_SEQ", senderid) => - let val _ = send (senderid, ls) + let val _ = send (senderid, (reverse ls)) in rec_rng [] end] @@ -212,33 +206,33 @@ Different utility functions that are used across the library. rep_rng new_ls] fun shrink_sized_sequence seqs gens prop pre size left_over_len idx_of_sized tco = - let val _ = send(tco, ("REQUEST_RNG", self())) - val pid = receive [hn x => x] - val _ = send(tco, ("REQUEST_AUTH", self())) - val auth = receive [hn x => x] - val cap = ceil (((length (nth seqs (idx_of_sized+1)))-2)/left_over_len )(* number of to remove parts of the sequence *) - val size_ls = for_i (fn (x,y) => append y [x]) [] (left_over_len-1) - fun aux i = - let val to_remove = foldl (fn (x,y) => append y [(i*left_over_len)-x])[i*left_over_len] size_ls - val new_seq = foldl (fn (x,y) => remove_nth x y 0) (nth seqs (idx_of_sized+1)) to_remove - val new_seqs = mapi (fn (i, x) => if i = idx_of_sized then new_seq else x) seqs - val new_args = mapi (fn (i, x) => - let val _ = send (pid, ("UPDATE_LS", (nth new_seqs (i+1)))) - val arg = x tco size - in arg - end) gens - in case i = (cap) of - true => - (new_seqs, new_args) - | false => - let val precond_is_met = if (pre <> ()) then (apply_args pre new_args tco) else true - in case (apply_args prop new_args tco) orelse (precond_is_met = false) of - true => aux (i+1) - | false => (new_seqs, new_args) - end + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val _ = send(tco, ("REQUEST_AUTH", self())) + val auth = receive [hn x => x] + val cap = ceil (((length (nth seqs (idx_of_sized+1)))-2)/left_over_len )(* number of to remove parts of the sequence *) + val size_ls = for_i (fn (x,y) => append y [x]) [] (left_over_len-1) + fun aux i = + let val to_remove = foldl (fn (x,y) => append y [(i*left_over_len)-x])[i*left_over_len] size_ls + val new_seq = foldl (fn (x,y) => remove_nth x y 0) (nth seqs (idx_of_sized+1)) to_remove + val new_seqs = mapi (fn (i, x) => if i = idx_of_sized then new_seq else x) seqs + val new_args = mapi (fn (i, x) => + let val _ = send (pid, ("UPDATE_LS", (nth new_seqs (i+1)))) + val arg = x tco size + in arg + end) gens + in case i = (cap) of + true => + (new_seqs, new_args) + | false => + let val precond_is_met = if (pre <> ()) then (apply_args pre new_args tco) else true + in case (apply_args prop new_args tco) orelse (precond_is_met = false) of + true => aux (i+1) + | false => (new_seqs, new_args) end - in aux 1 - end + end + in aux 1 + end @@ -307,39 +301,40 @@ Different utility functions that are used across the library. res end end - fun random_shrink_aux sequences generators prop pre success size counter divi tco = - if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else - let val _ = send(tco, ("REQUEST_RNG", self())) - val pid = receive [hn x => x] - val new_size = floor (size/divi) - val (shrunk_args, shrunk_sequences) = - foldl (fn (x, (arg_acc, seq_acc)) => - let val arg = x tco new_size - val _ = send (pid, ("REQUEST_SEQ", self())) - val seq = receive [hn x => x] - in (append arg_acc [arg], append seq_acc [seq]) - end) ([],[]) generators - val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true - in - case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of - true => random_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco - | false => - random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco - end + fun random_shrink_aux sequences generators prop pre success size counter divi tco = + if (counter = 100) orelse (size = 0) then {count = success, size = size, sequences = sequences} else + let val _ = send(tco, ("REQUEST_RNG", self())) + val pid = receive [hn x => x] + val new_size = floor (size/divi) + val (shrunk_args, shrunk_sequences) = + foldl (fn (x, (arg_acc, seq_acc)) => + let val arg = x tco new_size + val _ = send (pid, ("REQUEST_SEQ", self())) + val seq = receive [hn x => x] + in (append arg_acc [arg], append seq_acc [seq]) + end) ([],[]) generators + val precond_is_met = if (pre <> ()) then (apply_args pre shrunk_args tco) else true + in + case (apply_args prop shrunk_args tco) orelse (precond_is_met = false) of + true => random_shrink_aux sequences generators prop pre success size (counter+1) (divi+2) tco + | false => + random_shrink_aux shrunk_sequences generators prop pre (success+1) new_size (0) 2 tco + end - fun internal_shrinker sequence generators prop pre size counter tco = - let val start_time = getTime() - val rng_recorder = spawn (fn() => rec_rng []) - val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) - val _ = receive [hn x => ()] - val res = random_shrink_aux sequence generators prop pre 0 size counter 2 tco - val rng_replayer = spawn (fn() => rep_rng []) - val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) - val _ = receive [hn x => ()] - val res = internal_shrink (res.sequences) generators prop pre res.size (res.count) tco - val end_time = getTime() - in - (res, (end_time - start_time)) end + fun internal_shrinker sequence generators prop pre size counter tco = + let val start_time = getTime() + val rng_recorder = spawn (fn() => rec_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_recorder)) + val _ = receive [hn x => ()] + val res = random_shrink_aux sequence generators prop pre 0 size counter 2 tco + val rng_replayer = spawn (fn() => rep_rng []) + val _ = send (tco, ("UPDATE_RNG", self(), rng_replayer)) + val _ = receive [hn x => ()] + val res = internal_shrink (res.sequences) generators prop pre res.size (res.count) tco + val end_time = getTime() + in + (res, (end_time-start_time)) + end (* ------------------------------ @@ -347,6 +342,9 @@ EXTERNAL SHRINKING ------------------------------ *) + fun abs_value x = + if x < 0 then -x else x + fun list_to_string ls = foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) else y ^ x) "" ls From 088efd52c5ef363724d4963a90d25f9164151882 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 9 Jun 2024 14:03:29 +0200 Subject: [PATCH 118/121] Updated timing experiments with internal shrinkign --- troupecheck/timing-experiments/internal-shrink-timings.trp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/troupecheck/timing-experiments/internal-shrink-timings.trp b/troupecheck/timing-experiments/internal-shrink-timings.trp index 5234412..5559597 100644 --- a/troupecheck/timing-experiments/internal-shrink-timings.trp +++ b/troupecheck/timing-experiments/internal-shrink-timings.trp @@ -516,7 +516,7 @@ Different utility functions that are used across the library. end fun random_shrink_aux sequences generators prop pre success size counter divi tco = - if (counter = 1000) orelse (size = 0) then {count = success, size = size, sequences = sequences} else + if (counter = 100) orelse (size = 0) then {count = success, size = size, sequences = sequences} else let val _ = send(tco, ("REQUEST_RNG", self())) val pid = receive [hn x => x] val new_size = floor (size/divi) From b513af222d199a859581d7993fe4337b32e881b7 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 9 Jun 2024 17:33:31 +0200 Subject: [PATCH 119/121] clean up - removed unsused code --- lib/troupecheck.trp | 50 +++++---------------------------------------- 1 file changed, 5 insertions(+), 45 deletions(-) diff --git a/lib/troupecheck.trp b/lib/troupecheck.trp index c33f9c0..d474d1c 100644 --- a/lib/troupecheck.trp +++ b/lib/troupecheck.trp @@ -49,15 +49,10 @@ Handles the printing of appropriate error messages for errors that may occur in let val _ = send (tco, ("REQUEST_AUTH", self())) val auth = receive [hn x => x] val err_string = case error_reason of - ("cant_generate", tries) => "Couldn't produce an instance that satisfies all strict constraints after " - ^ (toString tries) ^ " tries.\n" - | ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" + ("cant_satisfy", tries) => "No valid test could be generated after " ^ (toString tries) ^ " tries.\n" | ("non_boolean_result", _) => "The property or precondition code returned a non-boolean result.\n" | ("type_mismatch", _) => "The types' structure doesn't match the property.\n" - | ("illegal_gen_def", _ ) => "Generator is defined wrong - use tuple() or record() to combine generators.\n" | ("record_mismatch", _) => "the number of names provided for record generation, does not match the number of types provided.\n" - | ("shrinking_looped", _) => "Shrinking looped.\n" - | ("non_string_type", _) => "An element of non-string type found when trying to convert list to string.\n" in write "\u001B[31m \nError: " auth; (* Changing the print color to red *) write (err_string ^ "\u001B[0m") auth; (* Changing the color back *) @@ -105,21 +100,6 @@ Different utility functions that are used across the library. in declassify (res, auth, `{}`) end end - - fun string_to_list s = - let fun aux "" acc = acc - | aux s acc = - let val x = substring (s, 0, 1) - val xs = substring (s, 1, 1/0) in - aux xs (append acc [x]) end in - aux s [] end - - (* Combines a list of individual strings to a single string *) - fun list_to_string ls tco = - foldl (fn (x,y) => if getType x <> "string" then report_error ("non_string_type", 0) tco else y ^ x) "" ls - - fun string_length s = - length (string_to_list s) fun report_fail_reason rec noOfTests tco = let val _ = send (tco, ("REQUEST_AUTH", self())) @@ -479,35 +459,18 @@ However, it can be done if the users wishes to and understands what is going on. (* NOTE: Generates only strings of letters (upper and lower case) and numbers. *) fun string_gen tco size = - let val length = (int_gen (0, size) tco size) + let val len = (int_gen (0, size) tco size) fun string_aux acc 0 = acc | string_aux acc i = string_aux ((char_gen tco size) ^ acc) (i-1) - val string = (string_aux "" length) + val string = (string_aux "" len) in string end - fun list_gen () tco size = - let val len = (int_gen (0, size) tco size) - val gen = generator_gen tco size - val res = make_list ((fn () => gen tco size), len) - in res - end - | list_gen (generator) tco size = + fun list_gen (generator) tco size = let val len = (int_gen (0, size) tco size) val res = make_list ((fn () => generator tco size), len) in res end - - and generator_gen tco size = - let val inf = 1/0 - val gens_ls = - case (size mod 3) of - 0 => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, char_gen, string_gen] - | _ => [(float_gen (inf, inf)), (int_gen(inf, inf)), bool_gen, (list_gen(generator_gen tco (size-1))), char_gen, string_gen, - (tuple_gen (list_gen(generator_gen tco (size-1)))), (rec_gen (list_gen(string_gen)) ((generator_gen tco (size-1)))), - (labeled_value_gen (list_gen(string_gen)) (generator_gen tco (size-1)))] - val gen = one_of gens_ls tco size - in gen end (* -------------------------------- @@ -620,14 +583,12 @@ These are functions that make it easier for the user to make use of the differen fun boolean () = bool_gen - fun list () = list_gen () - |list (type) = list_gen (type) + fun list (type) = list_gen (type) fun string () = string_gen fun char () = char_gen - fun generator() = generator_gen fun tuple (ts) = tuple_gen ts @@ -657,7 +618,6 @@ in , ("list", list) , ("string", string) , ("char", char) - , ("generator", generator) , ("tuple", tuple) , ("labeled_value", labeled_value) , ("combined_labeled_value", combined_labeled_value) From 2d7f714680ebb9942e198a76d016ea2140d31ab9 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 9 Jun 2024 18:33:52 +0200 Subject: [PATCH 120/121] Added golden tests for nth function - and made the battleship-game ready to play --- tests/rt/pos/core/nth1.golden | 2 ++ tests/rt/pos/core/nth1.trp | 4 ++++ tests/rt/pos/core/nth2.golden | 2 ++ tests/rt/pos/core/nth2.trp | 8 ++++++++ troupecheck/battleship/battleship-game.trp | 2 +- 5 files changed, 17 insertions(+), 1 deletion(-) create mode 100644 tests/rt/pos/core/nth1.golden create mode 100644 tests/rt/pos/core/nth1.trp create mode 100644 tests/rt/pos/core/nth2.golden create mode 100644 tests/rt/pos/core/nth2.trp diff --git a/tests/rt/pos/core/nth1.golden b/tests/rt/pos/core/nth1.golden new file mode 100644 index 0000000..20ad979 --- /dev/null +++ b/tests/rt/pos/core/nth1.golden @@ -0,0 +1,2 @@ +2024-06-09T16:24:36.820Z [RTM] info: Skipping network creation. Observe that all external IO operations will yield a runtime error. +>>> Main thread finished with value: 2@{}%{} diff --git a/tests/rt/pos/core/nth1.trp b/tests/rt/pos/core/nth1.trp new file mode 100644 index 0000000..fe5b7fc --- /dev/null +++ b/tests/rt/pos/core/nth1.trp @@ -0,0 +1,4 @@ +import lists +let val ls = [1,2,3,4] +in nth ls 2 +end \ No newline at end of file diff --git a/tests/rt/pos/core/nth2.golden b/tests/rt/pos/core/nth2.golden new file mode 100644 index 0000000..76123f6 --- /dev/null +++ b/tests/rt/pos/core/nth2.golden @@ -0,0 +1,2 @@ +2024-06-09T16:28:52.670Z [RTM] info: Skipping network creation. Observe that all external IO operations will yield a runtime error. +>>> Main thread finished with value: true@{}%{} diff --git a/tests/rt/pos/core/nth2.trp b/tests/rt/pos/core/nth2.trp new file mode 100644 index 0000000..e832b84 --- /dev/null +++ b/tests/rt/pos/core/nth2.trp @@ -0,0 +1,8 @@ +import lists +let val ls = ["ls", 3, 1/2, {r = 10, p = 7}] + val string = nth ls 1 + val int = nth ls 2 + val float = nth ls 3 + val record = nth ls 4 +in (getType string = "string") andalso (getType int = "number") andalso (getType float = "number") andalso (getType record = "record") +end diff --git a/troupecheck/battleship/battleship-game.trp b/troupecheck/battleship/battleship-game.trp index b8f9365..75360d6 100644 --- a/troupecheck/battleship/battleship-game.trp +++ b/troupecheck/battleship/battleship-game.trp @@ -332,5 +332,5 @@ Testing the game host using TroupeCheck fun prop_bad_do_att() = for_all ([(labeled_value ([`{alice}`, `{bob}`], board_ships_gen)), attack_gen], test_bad_do_attack) -in troupecheck[prop_bad_do_att] authority +in setup () 0 end \ No newline at end of file From 036a9347010721f1581bec8ee6622d448d33afd2 Mon Sep 17 00:00:00 2001 From: lukasnysted Date: Sun, 9 Jun 2024 20:00:56 +0200 Subject: [PATCH 121/121] reverting to original gitignore file --- .gitignore | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index a69870a..5f0095b 100644 --- a/.gitignore +++ b/.gitignore @@ -32,6 +32,4 @@ yarn-error.log *.swp bin/troupe bin/understudy -trp-rt/out/ -troupecheck/test.trp -troupecheck/*.py \ No newline at end of file +trp-rt/out/ \ No newline at end of file