From dcc3aa6da59f7992e3a9512e360a7e6622bad2ff Mon Sep 17 00:00:00 2001 From: Boyd Duffee Date: Thu, 21 Jul 2022 22:35:21 +0100 Subject: [PATCH 1/2] Migrate current tests to Test2 Squashed commits after messing up the rebase onto the latest develop branch. Recreated and these are the commit messages rescued from that. tableau.t PITA! The circular references in MathObjects made the deep comparisons impossible, so all MathObjects were stringified for comparisons. WARN and DEBUG message sub redefinitions were removed. A "validator" and a stringify sub were added to get around some of the comparison issues. Organized into subtests. math_objects_basics.t Convert `throws_ok` to the like/dies construct and the tests pass. Arranged sections in subtests Three test files migrated from Test::More to Test2 without modification (other than moving the environment setup from the script to Test::PG) This expands on the original t/README.md on the details of testing. t/context Minor changes to migrate tests in t/context from Test::More to Test2 There were few tests in these files. toltype_digits.t organized into subtests by topic Use the Test::PG environment with Test2 Find that the original test produced unexpected results and the tests that expose the incorrect behaviour have been wrapped in a TODO block Added unit tests for Units.pm Tests to validate the correctness of #677 Unit tests for Units.pm electron volts Tests for parserNumberWithUnits.pl with basic energy conversions Adding a Test::PG module in t/lib/ to take the place of t/build_PG_envir.pl --- t/README.md | 69 +++- t/contexts/fraction.t | 28 +- t/contexts/integer.t | 23 +- t/contexts/toltype_digits.t | 96 +++-- t/contexts/trig_degrees.t | 60 +++- t/lib/Test/PG.pm | 108 ++++++ t/macros/basicmacros.t | 24 +- t/macros/math_objects_basics.t | 156 +++++---- t/macros/math_objects_more.t | 20 +- t/macros/pgaux.t | 18 +- t/macros/tableau.t | 617 ++++++++++++++++++++------------- t/units/basic_module.t | 24 ++ t/units/basic_parser.t | 202 +++++++++++ t/units/electron_volts.t | 30 ++ 14 files changed, 1013 insertions(+), 462 deletions(-) create mode 100644 t/lib/Test/PG.pm create mode 100644 t/units/basic_module.t create mode 100644 t/units/basic_parser.t create mode 100644 t/units/electron_volts.t diff --git a/t/README.md b/t/README.md index 93f8ef8c8b..993c4599dd 100644 --- a/t/README.md +++ b/t/README.md @@ -1,14 +1,45 @@ -# Unit Tests for PG +# Testing PG + +This directory houses the resources for testing PG. It includes a mix +of strategies for testing at different scales. It helps to catch errors +before they are found in production and prevent regressions from being +re-introduced. + +The philosophy of +[Test Driven Design](https://en.wikipedia.org/wiki/Test-driven_development) +is that when a bug is found, a test is written to show it failing +and when it is fixed, the test will pass. +The unit tests are easy to run and amenable to automation. Some services +can be "mocked" so that behaviour can be tested in their absence. +All of this is to provide confidence that the code does what is intended +and a working test can be better than documentation because it shows how +the code currently works in practice. + +Old references can be found on the WebWork wiki page +[Unit Testing](https://webwork.maa.org/wiki/Unit_Testing) + + +# Unit Tests + +[Unit tests](https://en.wikipedia.org/wiki/Unit_testing) look at small chunks +of self-coherent code to verify the behaviour of a subroutine or module. +This is the test you write to catch corner cases or to explore code branches. +In this repository, all files with the `.t` extension are unit tests which +are found by Perl's [prove](https://perldoc.perl.org/prove) command. The individual unit tests are located in each of the directories. +Best practice is to create a directory for each module being tested and +group similar tests together in separate files with a descriptive name, +such as **t/units/** for testing the **Units.pm** module. -Formal unit tests are located in the the `macros` and `contexts` directories that are designed to test the pg macros and contexts respectively. +Formal unit tests are located in the the `macros` and `contexts` directories +that are designed to test the pg macros and contexts respectively. ## Running the tests ```bash cd $PG_ROOT -prove -r . +prove -lr t/ ``` will run all of the tests in `.t` files within subdirectories of `t`. @@ -23,6 +54,7 @@ prove -v pgaux.t ``` which will be verbose (`-v`). +Or you could use `prove -lv t/macros/pgaux.t` from the root directory. ## Writing a Unit Test @@ -70,3 +102,34 @@ is(check_score($f->eval(x=>2),"4"),1,"math objects: eval x^2 at x=2"); ``` The `check_score` subroutine evaluates and compares a MathObject with a string representation of the answer. If the score is 1, then the two are equal. + + +# Integration tests + +[Integration testing](https://en.wikipedia.org/wiki/Integration_testing) +tests components working together as a group. The files with the `.pg` +extension are used to demonstrate the output of the rendering engine. + +**TODO:** add an explanation of how to run these integration tests +and their requirements. + + +# Test Dependencies + +The tests for **Units.pm** have brought in a new module dependency, +[Test2](https://metacpan.org/pod/Test2::V0) which is the state of the art in +testing Perl modules. It can compare data structures, examine warnings and +catch fatal errors thrown under expected conditions. It provides many tools +for testing and randomly executes its subtests to avoid the programmer +depending on stateful data. + +To make these easier to install with +[cpanm](https://metacpan.org/dist/App-cpanminus/view/bin/cpanm), there is a +[cpanfile](https://metacpan.org/dist/Module-CPANfile/view/lib/cpanfile.pod) +in the root directory. Use + + cpanm --installdeps . + +which will install the runtime and test dependencies. +To use the cpanfile for a minimal install skipping the test requirements, +use the `--notest` option with cpanm. diff --git a/t/contexts/fraction.t b/t/contexts/fraction.t index ecebcd848f..ec10c3deaf 100644 --- a/t/contexts/fraction.t +++ b/t/contexts/fraction.t @@ -1,23 +1,15 @@ -use warnings; -use strict; +use Test2::V0; -package main; +# should I "use" Parser Value Parser::Legacy here instead? -use Test::More; -use Test::Exception; +use lib 't/lib'; +use Test::PG; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. +=head2 Fraction context -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} - -use lib "$main::pg_dir/lib"; - -require("$main::pg_dir/t/build_PG_envir.pl"); +To test the reduction of fractions -## END OF TOP_MATERIAL +=cut loadMacros("PGstandard.pl", "MathObjects.pl", "contextFraction.pl"); @@ -39,9 +31,9 @@ Context("Fraction"); # require("Parser::Legacy::LimitedNumeric::Number"); # require("Parser::Legacy"); -my $a1 = Compute("1/2"); -my $a2 = Compute("2/4"); +ok my $a1 = Compute("1/2"); +ok my $a2 = Compute("2/4"); -is($a1->value, $a2->value, "contextFraction: reduce fractions"); +is $a1->value, $a2->value, 'contextFraction: reduce fractions'; done_testing(); diff --git a/t/contexts/integer.t b/t/contexts/integer.t index 7981c240dd..d5f495e84a 100644 --- a/t/contexts/integer.t +++ b/t/contexts/integer.t @@ -1,23 +1,15 @@ -use warnings; -use strict; +use Test2::V0; -package main; +# should I "use" Parser Value Parser::Legacy here instead? -use Test::More; -use Test::Exception; +use lib 't/lib'; +use Test::PG; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. +=head2 Integer context -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} - -use lib "$main::pg_dir/lib"; +To test for greatest common denomenators and such like. -require("$main::pg_dir/t/build_PG_envir.pl"); - -## END OF TOP_MATERIAL +=cut loadMacros("MathObjects.pl", "contextInteger.pl"); @@ -33,4 +25,3 @@ ANS($b->cmp); ok(1, "integer test: dummy test"); done_testing(); - diff --git a/t/contexts/toltype_digits.t b/t/contexts/toltype_digits.t index f878cea032..4b3f741f85 100644 --- a/t/contexts/toltype_digits.t +++ b/t/contexts/toltype_digits.t @@ -1,64 +1,56 @@ -use warnings; -use strict; +use Test2::V0; -package main; +use lib 't/lib'; +use Test::PG; -use Test::More; -use Test::Exception; +=head2 TolType context -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. +To test for tolerances -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} - -use lib "$main::pg_dir/lib"; - -require("$main::pg_dir/t/build_PG_envir.pl"); - -## END OF TOP_MATERIAL +=cut loadMacros("PGstandard.pl", "MathObjects.pl"); my $ctx = Context("Numeric"); -$ctx->flags->set(tolType => 'digits', tolerance => 3, tolTruncation => 1); - my $pi = Real("pi"); -is(check_score($pi, Compute("3.14")), 1, "toltype digits: pi is 3.14"); -is(check_score($pi, Compute("3.141")), 1, "toltype digits: pi is 3.141"); -is(check_score($pi, Compute("3.142")), 1, "toltype digits: pi is 3.142"); -is(check_score($pi, Compute("3.143")), 0, "toltype digits: pi is not 3.143"); -is(check_score($pi, Compute("3.15")), 0, "toltype digits: pi is not 3.15"); - -note(""); -note("change tolTrunction to 0"); - -$ctx->flags->set(tolType => 'digits', tolerance => 3, tolTruncation => 0); -is(check_score($pi, Compute("3.14")), 1, "toltype digits: pi is 3.14"); -is(check_score($pi, Compute("3.141")), 0, "toltype digits: pi is not 3.141"); -is(check_score($pi, Compute("3.142")), 1, "toltype digits: pi is not 3.142"); -is(check_score($pi, Compute("3.143")), 0, "toltype digits: pi is not 3.143"); -is(check_score($pi, Compute("3.15")), 0, "toltype digits: pi is not 3.15"); - -note(""); -note("set tolExtraDigits to 2"); - -$ctx->flags->set( - tolType => 'digits', - tolerance => 3, - tolTruncation => 0, - tolExtraDigits => 2 -); -is(check_score($pi, Compute("3.14")), 1, "toltype digits: pi is 3.14"); -is(check_score($pi, Compute("3.141")), 0, "toltype digits: pi is not 3.141"); -is(check_score($pi, Compute("3.142")), 1, "toltype digits: pi is not 3.142"); -is(check_score($pi, Compute("3.143")), 0, "toltype digits: pi is not 3.143"); -is(check_score($pi, Compute("3.15")), 0, "toltype digits: pi is not 3.15"); - -is(check_score($pi, Compute("3.1416")), 1, "toltype digits: pi is 3.1416"); -is(check_score($pi, Compute("3.1415888")), 1, "toltype digits: pi is 3.1415888"); -is(check_score($pi, Compute("3.1415")), 0, "toltype digits: pi is not 3.1415"); +subtest 'set tolTrunction to 1' => sub { + $ctx->flags->set(tolType => 'digits', tolerance => 3, tolTruncation => 1); + + is check_score($pi, Compute("3.14")), 1, "toltype digits: pi is 3.14"; + is check_score($pi, Compute("3.141")), 1, "toltype digits: pi is 3.141"; + is check_score($pi, Compute("3.142")), 1, "toltype digits: pi is 3.142"; + is check_score($pi, Compute("3.143")), 0, "toltype digits: pi is not 3.143"; + is check_score($pi, Compute("3.15")), 0, "toltype digits: pi is not 3.15"; +}; + +subtest 'set tolTrunction to 0' => sub { + $ctx->flags->set(tolType => 'digits', tolerance => 3, tolTruncation => 0); + + is check_score($pi, Compute("3.14")), 1, "toltype digits: pi is 3.14"; + is check_score($pi, Compute("3.141")), 0, "toltype digits: pi is not 3.141"; + is check_score($pi, Compute("3.142")), 1, "toltype digits: pi is not 3.142"; + is check_score($pi, Compute("3.143")), 0, "toltype digits: pi is not 3.143"; + is check_score($pi, Compute("3.15")), 0, "toltype digits: pi is not 3.15"; +}; + +subtest 'set tolExtraDigits to 2' => sub { + $ctx->flags->set( + tolType => 'digits', + tolerance => 3, + tolTruncation => 0, + tolExtraDigits => 2 + ); + + is check_score($pi, Compute("3.14")), 1, "toltype digits: pi is 3.14"; + is check_score($pi, Compute("3.141")), 0, "toltype digits: pi is not 3.141"; + is check_score($pi, Compute("3.142")), 1, "toltype digits: pi is not 3.142"; + is check_score($pi, Compute("3.143")), 0, "toltype digits: pi is not 3.143"; + is check_score($pi, Compute("3.15")), 0, "toltype digits: pi is not 3.15"; + + is check_score($pi, Compute("3.1416")), 1, "toltype digits: pi is 3.1416"; + is check_score($pi, Compute("3.1415888")), 1, "toltype digits: pi is 3.1415888"; + is check_score($pi, Compute("3.1415")), 0, "toltype digits: pi is not 3.1415"; +}; done_testing(); diff --git a/t/contexts/trig_degrees.t b/t/contexts/trig_degrees.t index 3d2230ad75..ba8481721f 100644 --- a/t/contexts/trig_degrees.t +++ b/t/contexts/trig_degrees.t @@ -1,23 +1,26 @@ -use warnings; -use strict; +use Test2::V0; -package main; +use lib 't/lib'; +use Test::PG; -use Test::More; -use Test::Exception; +# remove warnings about redefining trig functions +delete $main::{sin}; +delete $main::{cos}; +delete $main::{atan2}; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} +=head2 Errors to be fixed -use lib "$main::pg_dir/lib"; +There is something wrong with either contextTrigDegrees.pl or how this test +sets up the context. It looks like it still calculates in radians. +Maybe the problem is how it imports symbols? -require("$main::pg_dir/t/build_PG_envir.pl"); +When you fix it, the test output will report the test numbers after C + +These are the same results as the original Test::More version with build_PG_env.pl + +=cut -## END OF TOP_MATERIAL loadMacros("contextTrigDegrees.pl"); @@ -25,9 +28,21 @@ my $ctx = Context("TrigDegrees"); ok(Value::isContext($ctx), "trig degrees: check context"); -my $cos60 = Compute("cos(60)"); +ok my $cos60 = Compute("cos(60)"), 'Call Compute'; +ok my $eval_cos60 = $cos60->cmp->evaluate("1/2"), 'evalute an answer to cos(60)'; + +is $eval_cos60, + hash { + field type => 'Value (Real)'; + field score => 0; + field correct_ans => "cos(60)"; + field student_ans => 0.5; + field error_flag => U(); + field error_message => DF(); + etc(); + }, 'What does the Compute("cos(60)") object look like?'; + -Compute("cos(60)")->cmp->evaluate("1/2"); # dd Compute("1/2")->value; # is (check_score($cos60,"1/2"),1,"trig degrees: cos(60) = 1/2"); @@ -38,4 +53,19 @@ Compute("cos(60)")->cmp->evaluate("1/2"); # is (check_score(Compute("cos(60)"),"sin(30)"),1,"trig degrees: cos(60) = 1/2"); +# simple sanity checking +is check_score( Compute('sin(0)'), '0'), 1, 'trig degrees: sin(0) = 0'; +is check_score( Compute('sin(90)'), '1'), 1, 'trig degrees: sin(90) = 1'; +is check_score( Compute('cos(0)'), '1'), 1, 'trig degrees: cos(0) = 1'; + +todo 'why is cos(90) not equal to 0' => sub { + # are we still computing in radians? + is check_score( Compute('cos(90)'), '0'), 1, 'trig degrees: cos(90) = 0'; + is check_score( Compute('cos(90)'), '1.6155E-15'), 1, 'trig degrees: cos(90) ~ 0'; + + my $pi = 4 * atan2(1,1); + is check_score( Compute("cos($pi/3)"), "sin($pi/6)"), 1, 'trig degrees: cos(60) = sin(30)'; +}; + + done_testing(); diff --git a/t/lib/Test/PG.pm b/t/lib/Test/PG.pm new file mode 100644 index 0000000000..c382a303b8 --- /dev/null +++ b/t/lib/Test/PG.pm @@ -0,0 +1,108 @@ +package Test::PG; + +BEGIN { + die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; + $main::pg_dir = $ENV{PG_ROOT}; +} + +use warnings; +use strict; + +use lib "$main::pg_dir/lib"; # only needed if not using prove with -l + + +=head1 Test::PG + +This module provides the environment and some generic functions for +writing tests for PG macros. Mostly copied from F, +it also redefines Test2's "exists" function from C to C +to avoid the conflict with WebWork's exponential function. +Its final action is to load C. + +The reason for the module is that There Is More Than One Way To Do It +and people develop different styles. This is my coding style. +Also we learn the underlying structures better by re-inventing the wheel. +We just try to make a better wheel, but success is not guaranteed. + +This module strives for elegance in reducing boiler plate in test files, +a minimum of duplicated code and adheres to the principle of least surprise +by locating modules below the C directory. +It does not make a decent cup of tea. + +=head2 Usage + +To test a macro that needs to be loaded, include this preamble +at the top of your test file and customize. + + use Test2::V0; + + use MyPGLib; # does your macro need a module? + + use lib 't/lib'; + use Test::PG; # setup a minimal WW environment + + loadMacros("parserMyPGMacro.pl"); + + Context("Numeric"); + +And run your test from the $PG_ROOT directory with + + prove -l t/my_macro/my_test.t + + +=head2 TODO + +=head3 Quiet warnings in F + +The functions sin, cos and atan2 are redefined and generate warnings. +C them from the symbol table before loading the macro. + +F declares C<$deg> twice, it being +a required file, the package scope isn't heeded by the second C. +I wonder if this happens every time this macro is loaded. + +=cut + + +package main; + +$main::{EXISTS} = delete $main::{E}; # redefine Test2's E() function as EXISTS() + +my $macros_dir = "$main::pg_dir/macros"; + +# use WeBWorK::Localize; +use PGcore; +use Parser; + +# build up enough of a PG environment to get things running +our %envir = ( + htmlDirectory => '/opt/webwork/courses/daemon_course/html', + htmlURL => 'http://localhost/webwork2/daemon_course/html', + tempURL => 'http://localhost/webwork2/daemon_course/tmp', + pgDirectories => { macrosPath => ["$macros_dir"] }, + macrosPath => ["$macros_dir"], + displayMode => 'HTML_MathJax', + language => 'en-us', + language_subroutine => sub { return @_; }, # return the string passed in instead going to maketext +); + +sub be_strict { + require 'ww_strict.pm'; + strict::import(); +} + +sub PG_restricted_eval { + WeBWorK::PG::Translator::PG_restricted_eval(@_); +} + +sub check_score { + my ($correct_answer, $ans) = @_; + return $correct_answer->cmp->evaluate($ans)->{score}; +} + +require "$macros_dir/PG.pl"; +DOCUMENT(); + +loadMacros('PGbasicmacros.pl'); + +1; diff --git a/t/macros/basicmacros.t b/t/macros/basicmacros.t index eab341352f..fd69c3d5e7 100644 --- a/t/macros/basicmacros.t +++ b/t/macros/basicmacros.t @@ -1,29 +1,19 @@ -use warnings; -use strict; +use Test2::V0; -package main; - -use Test::More; -use Test::Exception; +use HTML::Entities; +use HTML::TagParser; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. +use lib 't/lib'; +use Test::PG; -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} -use lib "$main::pg_dir/lib"; +=head1 MathObjects -require("$main::pg_dir/t/build_PG_envir.pl"); +=cut -## END OF TOP_MATERIAL loadMacros("PGbasicmacros.pl"); -use HTML::Entities; -use HTML::TagParser; - my $name = "myansrule"; my $named_box = NAMED_ANS_RULE($name); diff --git a/t/macros/math_objects_basics.t b/t/macros/math_objects_basics.t index a0b5a18d72..933199f73a 100644 --- a/t/macros/math_objects_basics.t +++ b/t/macros/math_objects_basics.t @@ -1,25 +1,18 @@ -use warnings; -use strict; +use Test2::V0; -package main; - -use Test::More; -use Test::Exception; +use Parser; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. +use lib 't/lib'; +use Test::PG; -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} -use lib "$main::pg_dir/lib"; +=head1 MathObjects -require("$main::pg_dir/t/build_PG_envir.pl"); +Test MathObject properties and operations. +Try out operations with Infinity. -## END OF TOP_MATERIAL +=cut -use Parser; loadMacros("MathObjects.pl"); @@ -28,71 +21,82 @@ Context("Numeric"); my ($val1, $val2) = (10, 5); my $obj1 = Compute($val1); my $obj2 = Compute($val2); -my $one = Compute("1"); my $zero = Compute("0"); - -is($obj1->class, "Real", "math objects: check class of object"); -is($obj2->type, "Number", "math objects: check type of object"); -ok($one->isOne, "math objects: check if a number is 1"); -ok(!$zero->isOne, "math objects: check if a number is not 1"); -ok($zero->isZero, "math objects: check if a number is 0"); -ok(!$one->isZero, "math objects: check if a number is not 0"); - -ok(Value::isValue($obj1), "math objects: check if an object is a value"); -ok(Value::isNumber($obj1), "math objects: check if an object is a number"); -ok(Value::isReal($obj1), "math objects: check if a number is a real number"); -ok(!Value::isComplex($obj1), "math objects: check if an integer is complex"); - -ok(!Value::isFormula($obj1), "math objects: check if a number is not a formula"); - -# check infinite values -note("Tests for infinite values"); - -my $inf = Compute("inf"); -is($inf->value, "infinity", "math objects: check for infinity via a string"); -is($inf->class, "Infinity", "math objects: check that the class is Infinity"); -is($inf->type, "Infinity", "math objects: check that the type is Infinity"); -ok(!Value::isNumber($inf), "math objects: check if inf is a number"); - -# check that operations with infinity are not allowed - -throws_ok { - Compute("$obj1+$inf"); -} -qr/can't be infinities/, "math objects: addition with infinity"; -throws_ok { - Compute("$obj1-$inf"); -} -qr/can't be infinities/, "math objects: subtraction with infinity"; -throws_ok { - Compute("$obj1*$inf"); -} -qr/can't be infinities/, "math objects: multiplication with infinity"; -throws_ok { - Compute("$obj1/$inf"); -} -qr/can't be infinities/, "math objects: division with infinity"; - -# is($result1->value,"infinity","math objects: check that the sum of a finite and infinite value is infinite"); +ok my $one = Compute("1"), 'Create a MathObject with Compute'; + +subtest 'Basic properties of MathObjects' => sub { + is $obj1->class, 'Real', 'math objects: check class of object'; + is $obj2->type, 'Number', 'math objects: check type of object'; + is $one->isOne, T(), 'math objects: check if a number is 1'; + is $zero->isOne, F(), 'math objects: check if a number is not 1'; + is $zero->isZero, T(), 'math objects: check if a number is 0'; + is $one->isZero, F(), 'math objects: check if a number is not 0'; +}; + +subtest 'Class methods of Value to determine type' => sub { + is Value::isValue($obj1), T(), 'math objects: check if an object is a value'; + is Value::isNumber($obj1), T(), 'math objects: check if an object is a number'; + is Value::isReal($obj1), T(), 'math objects: check if a number is a real number'; + is Value::isComplex($obj1), F(), 'math objects: check if an integer is complex'; + + is Value::isFormula($obj1), F(), 'math objects: check if a number is not a formula'; +}; + +ok my $inf = Compute("inf"), 'Can create Infinity'; + +subtest 'Tests for infinite values' => sub { + is $inf->value, 'infinity', 'math objects: check for infinity via a string'; + is $inf->class, 'Infinity', 'math objects: check that the class is Infinity'; + is $inf->type, 'Infinity', 'math objects: check that the type is Infinity'; + ok !Value::isNumber($inf), 'math objects: check if inf is a number'; +}; + +subtest 'check that operations with infinity are not allowed' => sub { + like( + dies { Compute("$obj1+$inf") }, + qr/can't be infinities/, + "math objects: addition with infinity" + ); + like( + dies { Compute("$obj1-$inf") }, + qr/can't be infinities/, + "math objects: subtraction with infinity" + ); + like( + dies { Compute("$obj1*$inf") }, + qr/can't be infinities/, + "math objects: multiplication with infinity" + ); + like( + dies { Compute("$obj1/$inf") }, + qr/can't be infinities/, + "math objects: division with infinity" + ); + + # is($result1->value,'infinity','math objects: check that the sum of a finite and infinite value is infinite'); +}; my $sum = $obj1 + $obj2; my $diff = $obj1 - $obj2; -my $prod = $obj1 * $obj2; - -is($sum->value, $val1 + $val2, "math objects: test sum"); -is($diff->value, $val1 - $val2, "math objects: test difference"); -is($prod->value, $val1 * $val2, "math objects: test product"); - -## check scores using the cmp method - -is(check_score($sum, Compute($sum)), 1, "math object: use cmp to check sum"); -is(check_score($diff, Compute($diff)), 1, "math object: use cmp to check diff"); -is(check_score($prod, Compute($prod)), 1, "math object: use cmp to check prod"); - -## check some wrong answers; +ok my $prod = $obj1 * $obj2, 'Operate on two MathObjects'; + +subtest 'check object operations' => sub { + is $sum->value, $val1 + $val2, 'math objects: test sum'; + is $diff->value, $val1 - $val2, 'math objects: test difference'; + is $prod->value, $val1 * $val2, 'math objects: test product'; +}; + +subtest 'check scores using the cmp method' => sub { + is check_score($sum, Compute($sum)), 1, 'math object: use cmp to check sum'; + is check_score($diff, Compute($diff)), 1, 'math object: use cmp to check diff'; + is check_score($prod, Compute($prod)), 1, 'math object: use cmp to check prod'; +}; + +subtest 'check some wrong answers' => sub { + is check_score($sum, Compute($sum + 1)), 0, 'math object: use cmp to check sum'; + is check_score($diff, Compute($diff + 1)), 0, 'math object: use cmp to check diff'; + is check_score($prod, Compute($prod + 1)), 0, 'math object: use cmp to check prod'; +}; -is(check_score($sum, Compute($sum + 1)), 0, "math object: use cmp to check sum"); -is(check_score($diff, Compute($diff + 1)), 0, "math object: use cmp to check diff"); -is(check_score($prod, Compute($prod + 1)), 0, "math object: use cmp to check prod"); done_testing(); diff --git a/t/macros/math_objects_more.t b/t/macros/math_objects_more.t index e54bb409e8..37c0ec29d7 100644 --- a/t/macros/math_objects_more.t +++ b/t/macros/math_objects_more.t @@ -1,23 +1,15 @@ -use warnings; -use strict; +use Test2::V0; -package main; +use lib 't/lib'; +use Test::PG; -use Test::More; -use Test::Exception; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. +=head1 MathObjects -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} +Tests pass -use lib "$main::pg_dir/lib"; +=cut -require("$main::pg_dir/t/build_PG_envir.pl"); - -## END OF TOP_MATERIAL loadMacros("MathObjects.pl"); diff --git a/t/macros/pgaux.t b/t/macros/pgaux.t index 73bc3031de..34bec6aeb7 100644 --- a/t/macros/pgaux.t +++ b/t/macros/pgaux.t @@ -1,21 +1,15 @@ -use warnings; -use strict; +use Test2::V0; -package main; +use lib 't/lib'; +use Test::PG; -use Test::More; -## the following needs to include at the top of any testing down to TOP_MATERIAL +=head1 PGauxiliaryFunctions -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} +Tests pass -use lib "$main::pg_dir/lib"; -require("$main::pg_dir/t/build_PG_envir.pl"); +=cut -## END OF TOP_MATERIAL loadMacros("PGauxiliaryFunctions.pl"); diff --git a/t/macros/tableau.t b/t/macros/tableau.t index a059ab4557..b09da818f4 100755 --- a/t/macros/tableau.t +++ b/t/macros/tableau.t @@ -1,40 +1,44 @@ -use warnings; -use strict; +use Test2::V0; -package main; +use Class::Accessor; +use Parser; +use PGcore; +use Value; -use Test::More; -use Test::Exception; +use lib 't/lib'; +use Test::PG; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} +=head1 Tableau -use lib "$main::pg_dir/lib"; +Deep recursion error possibly due to "context" being a reference +to the original context variable. +I can't find a way to stop the recursion. +As a result Test::More::is_deeply( $A, $B ) +becomes Test2::Tools::Compare::is( $A->string, $B->string ) +I wrote a validator for the cases where you are trying to compare +a Value::Matrix with an array ref of values which doesn't have +a "string" method. If someone can clean it up, future coders +will thank you. -require("$main::pg_dir/t/build_PG_envir.pl"); +Tests many of the functions provided by F -## END OF TOP_MATERIAL +Removed the redefined WARN and DEBUG MESSAGES -use Parser; -use Value; -use Class::Accessor; -use PGcore; +Error Messages: -loadMacros("tableau.pl", "Value.pl"); #gives us Real() etc. +A context appears to have been destroyed without first calling release(). +Based on $@ it does not look like an exception was thrown (this is not always +a reliable test) + +=cut -note( - "THIS FILE TESTS MANY OF THE FUNCTIONS PROVIDED BY tableau.pl -# -# -" -); + +loadMacros('tableau.pl', 'Value.pl'); #gives us Real() etc. my %context = (); + sub Context { Parser::Context->current(\%context, @_) } unless (%context && $context{current}) { # ^variable our %context @@ -43,13 +47,6 @@ unless (%context && $context{current}) { Context(); # Initialize context (for persistent mod_perl) } -sub WARN_MESSAGE { - warn("WARN MESSAGE: ", @_); -} - -sub DEBUG_MESSAGE { - warn("DEBUG MESSAGE: ", @_); -} Context("Matrix"); Context()->flags->set( @@ -57,11 +54,27 @@ Context()->flags->set( zeroLevelTol => 1E-5 ); + my $A = Real(.0000005); my $B = Real(0); -is($A, $B, "test zeroLevel tolerance"); -ok($A == $B, "test zeroLevel tolerance with ok"); +subtest 'test zeroLevel tolerance' => sub { + is($A->value, within($B->value, $B->getFlag('zeroLevel')), 'test zeroLevel tolerance'); + ok($A == $B, 'test zeroLevel tolerance with ok'); + + my $real_object = object { + prop isa => 'Value::Real'; + + field data => array { item 0 => match qr/\d/; }; + field context => D(); + + call string => match qr/\d/; + call TeX => match qr/\d/; + }; + + is $A, $real_object, 'Zero is a Real'; + is $B, $real_object, 'Near-Zero is a Real'; +}; my $money_total = 6000; my $time_total = 600; @@ -93,192 +106,305 @@ my $b = Value::Vector->new([ -$bill_profit, -$steve_profit ]); # need vertica my $c = Value::Vector->new([ $money_total, $time_total, 1, 1 ]); my $tableau1 = Tableau->new(A => $a, b => $b, c => $c); -############################################################### -# Check mutators -# -# + ############################################################### -ok(1 == 1, "trivial first test"); -ok(defined($tableau1), 'tableau has been defined and loaded'); -is(ref($tableau1), "Tableau", 'has type Tableau'); - -# test "close_enough_to_zero" subroutine -is $tableau1->close_enough_to_zero(0), 1, "checking_close_enough to zero"; -is $tableau1->close_enough_to_zero(1e-9), 0, "checking_close_enough to zero"; -is $tableau1->close_enough_to_zero(1e-5), 0, "checking_close_enough to zero"; -is $tableau1->close_enough_to_zero(1e-10), 1, "checking_NOT_close_enough to zero for 1e-10 "; -note("sanity check 1e-10 vs 10**(-10): ", 1e-10, " ", 10**(-10)); -note(1.e-10); -note(0.9999e-10); -note(-0.9999e-10); -is $tableau1->close_enough_to_zero(0.9999e-10), 1, "checking_close_enough to zero for 0.9999e-10"; - -is $tableau1->close_enough_to_zero(-0.9999e-10), 1, "checking_close_enough to zero for -0.9999e-10"; -note("display stringified \$tableau1: ", $tableau1, "\n"); -is ref($tableau1), "Tableau", "checking data type is Tableau"; -ok $tableau1 eq "[[-5000,-400,-1,0,1,0,0,-4700],[-3000,-500,0,-1,0,1,0,-4500]]", "checking_stringification of tableau"; - -is($tableau1->{m}, 2, 'number of constraints is 2'); -is($tableau1->{n}, 4, 'number of variables is 4'); -is_deeply([ $tableau1->{m}, $tableau1->{n} ], [ $tableau1->{A}->dimensions ], '{m},{n} match dimensions of A'); -is_deeply($tableau1->{A}, $a, 'constraint matrix'); -is_deeply($tableau1->{b}, Matrix([$b])->transpose, 'constraint constants is m by 1 matrix'); -is_deeply($tableau1->{c}, $c, 'objective function constants'); -is_deeply($tableau1->{A}, $tableau1->A, '{A} original constraint matrix accessor'); -is_deeply($tableau1->{b}, $tableau1->b, '{b} orginal constraint constants accessor'); -is_deeply($tableau1->{c}, $tableau1->c, '{c} original objective function constants accessor'); +subtest 'Check mutators' => sub { + is $tableau1, D(), 'tableau has been defined and loaded'; + is $tableau1, object { prop isa => 'Tableau' }, 'has type Tableau'; +}; + +subtest 'test "close_enough_to_zero" subroutine' => sub { + is $tableau1->close_enough_to_zero(0), 1, 'checking_close_enough to zero'; + is $tableau1->close_enough_to_zero(1e-9), 0, 'checking_close_enough to zero'; + is $tableau1->close_enough_to_zero(1e-5), 0, 'checking_close_enough to zero'; + is $tableau1->close_enough_to_zero(1e-10), 1, 'checking_NOT_close_enough to zero for 1e-10 '; + note('sanity check 1e-10 vs 10**(-10): ', 1e-10, ' ', 10**(-10)); + note(1.e-10); + note(0.9999e-10); + note(-0.9999e-10); + is $tableau1->close_enough_to_zero(0.9999e-10), 1, 'checking_close_enough to zero for 0.9999e-10'; + + is $tableau1->close_enough_to_zero(-0.9999e-10), 1, 'checking_close_enough to zero for -0.9999e-10'; +}; + +subtest 'Basic test warmup' => sub { + note("display stringified \$tableau1: ", $tableau1, "\n"); + is ref($tableau1), "Tableau", "checking data type is Tableau"; + is $tableau1, + '[[-5000,-400,-1,0,1,0,0,-4700],[-3000,-500,0,-1,0,1,0,-4500]]', + 'checking_stringification of tableau'; + + is $tableau1->{m}, 2, 'number of constraints is 2'; +}; + +subtest 'check data structure of tableau object' => sub { + is($tableau1->{m}, 2, 'number of constraints is 2'); + is($tableau1->{n}, 4, 'number of variables is 4'); + is [ $tableau1->{m}, $tableau1->{n} ], [ $tableau1->{A}->dimensions ], + '{m},{n} match dimensions of A'; + + is $tableau1, + object { + field A => object { + prop isa => 'Value::Matrix'; + call string => "$a"; + field context => D(); + field data => D(); + }; + field b => D(); + field c => D(); + etc(); + }, 'tableau attributes'; + + # call the string method to avoid the circular refs + is $tableau1->{A}->string, $a->string, 'Constraint matrix'; + is $tableau1->{b}->string, Matrix([$b])->transpose->string, 'Constraint constants is m by 1 matrix'; + is $tableau1->{c}->string, $c->string, 'Objective function constants'; + + is $tableau1->{A}->string, $tableau1->A->string, '{A} original constraint matrix accessor'; + is $tableau1->{b}->string, $tableau1->b->string, '{b} original constraint constants accessor'; + is $tableau1->{c}->string, $tableau1->c->string, '{c} original objective function constants accessor'; +}; my $test_constraint_matrix = Matrix($ra_matrix->[0], $ra_matrix->[1]); -is_deeply($tableau1->{current_constraint_matrix}, - $test_constraint_matrix, 'initialization of current_constraint_matrix'); -is_deeply( - $tableau1->{current_constraint_matrix}, - $tableau1->current_constraint_matrix, - 'current_constraint_matrix accessor' -); -is_deeply($tableau1->{current_b}, $tableau1->{b}, 'initialization of current_b'); -is_deeply($tableau1->{current_b}, $tableau1->current_b, 'current_b accessor'); -is_deeply([ $tableau1->current_b->dimensions ], [ 2, 1 ], 'dimensions of current_b'); -my $obj_row_test = [ ((-$c)->value, 0, 0, 1, 0) ]; -is_deeply($tableau1->objective_row, $obj_row_test, 'initialization of $tableau->{obj_row}'); - -is(ref($tableau1->{obj_row}), 'Value::Matrix', '->{obj_row} has type Value::Matrix'); -is(ref($tableau1->obj_row), 'Value::Matrix', '->obj_row has type Value::Matrix'); -is_deeply($tableau1->obj_row, $tableau1->{obj_row}, 'verify mutator for {obj_row}'); -is_deeply(ref($tableau1->objective_row), 'ARRAY', '->objective_row has type ARRAY'); -is_deeply($tableau1->objective_row, [ $tableau1->{obj_row}->value ], 'access to {obj_row}'); -is_deeply($tableau1->objective_row, [ $tableau1->obj_row->value ], 'objective_row is obj_row->value = ARRAY'); - -is(ref($tableau1->current_tableau), 'Value::Matrix', '-> current_tableau is Value::Matrix'); -is_deeply($tableau1->current_tableau, Matrix($ra_matrix), 'entire tableau including obj coeff row'); - -is(ref($tableau1->S), "Value::Matrix", 'slack variables are a Value::Matrix'); -is_deeply($tableau1->S, $tableau1->I($tableau1->m), 'slack variables are identity matrix'); - -# test basis -is_deeply(ref($tableau1->basis_columns), "ARRAY", "{basis_column} has type ARRAY"); -is_deeply($tableau1->basis_columns, [ 5, 6 ], "initialization of basis"); -is( - ref($tableau1->current_basis_matrix), - ref(Value::Matrix->I($tableau1->m)), - "current_basis_matrix type is MathObjectMatrix" -); -is_deeply($tableau1->current_basis_matrix, Value::Matrix->I($tableau1->m), "initialization of basis"); - -# change basis and test again -$tableau1->basis(2, 3); -is_deeply(ref($tableau1->basis_columns), "ARRAY", "{basis_column} has type ARRAY"); -is_deeply($tableau1->basis_columns, [ 2, 3 ], " basis columns set to {2,3}"); -is( - ref($tableau1->current_basis_matrix), - ref($test_constraint_matrix->column_slice(2, 3)), - "current_basis_matrix type is MathObjectMatrix" -); -is_deeply( - $tableau1->current_basis_matrix, - $test_constraint_matrix->column_slice(2, 3), - "basis_matrix for columns {2,3} is correct" -); -is_deeply($tableau1->basis(Set(2, 3)), List([ 2, 3 ]), "->basis(Set(2,3))"); -is_deeply($tableau1->basis(List(2, 3)), List([ 2, 3 ]), "->basis(List(2,3))"); -is_deeply($tableau1->basis([ 2, 3 ]), List([ 2, 3 ]), "->basis([2,3])"); - -# find basis column index corresponding to row index (and value of the basis coefficient) - -$tableau1->basis(5, 6); -note("\nbasis is", $tableau1->basis(5, 6)); -note(print $tableau1->current_tableau, "\n"); -is_deeply([ $tableau1->find_leaving_column(1) ], [ 5, 1 ], "find_leaving_column returns [col_index, pivot_value] "); -is_deeply([ $tableau1->find_leaving_column(2) ], [ 6, 1 ], "find_leaving_column returns [col_index, pivot_value] "); - -is_deeply($tableau1->find_next_basis_from_pivot(1, 2), Set(2, 6), "find next basis from pivot (1,2)"); -is_deeply($tableau1->find_next_basis_from_pivot(1, 3), Set(3, 6), "find next basis from pivot (1,3)"); -is_deeply($tableau1->find_next_basis_from_pivot(2, 1), Set(1, 5), "find next basis from pivot (2,1)"); -is_deeply($tableau1->find_next_basis_from_pivot(1, 1), Set(1, 6), "find next basis from pivot (1,1)"); - -throws_ok( - sub { $tableau1->find_next_basis_from_pivot(2, 5) }, - qr/pivot point should not be in a basis column/, - "can't pivot in basis column (2,5)" -); # probably shouldn't be doing this. -throws_ok( - sub { $tableau1->find_next_basis_from_pivot(1, 6) }, - qr/pivot point should not be in a basis column/, - "can't pivot in basis column (2,6)" -); # probably shouldn't be doing this. -is_deeply($tableau1->find_next_basis_from_pivot(2, 1), Set(1, 5), "find next basis from pivot (2,1)"); -throws_ok( - sub { $tableau1->find_next_basis_from_pivot(2, 6) }, - qr/pivot point should not be in a basis column/, - "can't pivot in basis column (2,6)" -); # probably shouldn't be doing this. - -$tableau1->basis(2, 3); -note("\nbasis is", $tableau1->basis()); -note(print $tableau1->current_tableau, "\n"); -is_deeply([ $tableau1->find_leaving_column(1) ], [ 2, 500 ], "find_leaving_column returns [col_index, pivot_value] "); -is_deeply([ $tableau1->find_leaving_column(2) ], [ 3, 500 ], "find_leaving_column returns [col_index, pivot_value] "); - -throws_ok( - sub { $tableau1->find_next_basis_from_pivot(1, 2) }, - qr/pivot point should not be in a basis column/, - "can't pivot in basis column (1,2)" -); # probably shouldn't be doing this either. -throws_ok( - sub { $tableau1->find_next_basis_from_pivot(1, 3) }, - qr/pivot point should not be in a basis column.*/, - "can't pivot in basis column (1,3)" -); # probably shouldn't be doing this. -is_deeply($tableau1->find_next_basis_from_pivot(2, 1), Set(1, 2), "find next basis from pivot (2,1)"); -is_deeply($tableau1->find_next_basis_from_pivot(1, 1), Set(1, 3), "find next basis from pivot (1,1)"); - -$tableau1->basis(5, 6); -note("\nbasis is ", $tableau1->basis()); -note($tableau1->current_tableau, "\n"); -note("find next short cut pivots"); -# ($row_index, $value, $feasible_point) = $self->find_short_cut_row() -is_deeply([ $tableau1->find_short_cut_row() ], [ 1, -4700, 0 ], "row 1"); -is_deeply([ $tableau1->find_short_cut_column(1) ], [ 1, -5000, 0 ], "column 1 "); -is_deeply([ $tableau1->next_short_cut_pivot() ], [ 1, 1, 0, 0 ], "pivot (1,1)"); -is_deeply([ $tableau1->next_short_cut_basis() ], [ 1, 6, undef ], "new basis {1,6} continue"); -$tableau1->current_tableau(1, 6); -note($tableau1->current_tableau); - -is_deeply([ $tableau1->find_short_cut_row ], [ 2, Value::Real->new(-8.4E+06), 0 ], "find short cut row"); -is_deeply([ $tableau1->find_short_cut_column(2) ], [ 2, Value::Real->new(-1.3E+06), 0 ], "find short cut col 2 "); -is_deeply([ $tableau1->next_short_cut_pivot() ], [ 2, 2, 0, 0 ], "pivot (2,2)"); -is_deeply([ $tableau1->next_short_cut_basis() ], [ 1, 2, undef ], "new basis {1,2} continue"); - -$tableau1->current_tableau(1, 2); -note($tableau1->current_tableau); - -is_deeply([ $tableau1->next_short_cut_pivot() ], [ undef, undef, 1, 0 ], "feasible point found"); -is_deeply( - [ $tableau1->next_short_cut_basis() ], - [ 1, 2, 'feasible_point' ], - "all constraints positive at basis {1,2} --start phase2" -); -is_deeply([ $tableau1->find_pivot_column('max') ], [ 3, Value::Real->new(-100000), 0 ], "col 3"); -is_deeply([ $tableau1->find_pivot_row(3) ], [ 1, Value::Real->new(550000 / 500), 0 ], "row 1 "); -is_deeply([ $tableau1->find_next_pivot('max') ], [ 1, 3, 0, 0 ], "pivot (1,3)"); -is_deeply([ $tableau1->find_next_basis('max') ], [ 2, 3, undef ], "new basis {2,3} continue"); - -$tableau1->current_tableau(2, 3); -note($tableau1->current_tableau); -is_deeply([ $tableau1->find_pivot_column('max') ], [ 4, Value::Real->new(-300), 0 ], "col 4"); -is_deeply([ $tableau1->find_pivot_row(4) ], [ 1, 4500, 0 ], "row 2) "); - -is_deeply([ $tableau1->find_next_pivot('max') ], [ 1, 4, 0, 0 ], "pivot 1,4"); -is_deeply([ $tableau1->find_next_basis('max') ], [ 3, 4, undef ], "new basis {3,4} continue"); - -$tableau1->current_tableau(3, 4); -note($tableau1->current_tableau); -is_deeply([ $tableau1->find_pivot_column('max') ], [ 5, Value::Real->new(-1), 0 ], "col 5"); -is_deeply([ $tableau1->find_pivot_row(5) ], [ undef, undef, 1 ], "row 2) "); - -is_deeply([ $tableau1->find_next_pivot('max') ], [ undef, 5, 0, 1 ], "unbounded -- no pivot"); -is_deeply([ $tableau1->find_next_basis('max') ], [ 3, 4, 'unbounded' ], "basis 3,4 unbounded"); + +subtest 'Current constraint matrix' => sub { + is $tableau1->{current_constraint_matrix}->string, + $test_constraint_matrix->string, + 'initialization of current_constraint_matrix'; + is + $tableau1->{current_constraint_matrix}->string, + $tableau1->current_constraint_matrix->string, + 'current_constraint_matrix accessor'; + is $tableau1->{current_b}->string, $tableau1->{b}->string, 'initialization of current_b'; + is $tableau1->{current_b}->string, $tableau1->current_b->string, 'current_b accessor'; + + is [ $tableau1->current_b->dimensions ], [ 2, 1 ], 'dimensions of current_b'; +}; + +subtest 'Objective row properties' => sub { + my $obj_row_test = [ ((-$c)->value, 0, 0, 1, 0) ]; + + for (my $i = 0; $i < 4; $i++) { + is $tableau1->objective_row->[$i]->string, $obj_row_test->[$i]->string, + 'initialization of $tableau->{obj_row} (first half)'; + } + is @{$tableau1->objective_row}[4..7], + @{$obj_row_test}[4..7], + 'initialization of $tableau->{obj_row} (second half)'; + + is $tableau1->{obj_row}, object { prop isa => 'Value::Matrix' }, '->{obj_row} has type Value::Matrix'; + is $tableau1->obj_row, object { prop isa => 'Value::Matrix' }, '->obj_row has type Value::Matrix'; + is $tableau1->obj_row->string, $tableau1->{obj_row}->string, 'verify mutator for {obj_row}'; + is ref $tableau1->objective_row, 'ARRAY', '->objective_row has type ARRAY'; + + # the first 4 elements are Value::Real's and the remainder are perl scalars (numbers) + # these are all mapped to array refs of scalars + # should these use the validator( $compare_data ) pattern below? + is [ map { ref $_ ? $_->{data} : [$_] } $tableau1->objective_row->@* ], + [ map { ref $_ ? $_->{data} : $_ } $tableau1->{obj_row}->value ], + 'access to {obj_row}'; + is [ map { ref $_ ? $_->{data} : [$_] } $tableau1->objective_row->@* ], + [ map { ref $_ ? $_->{data} : $_ } $tableau1->obj_row->value ], + 'objective_row is obj_row->value = ARRAY'; +}; + +subtest 'Current tableau' => sub { + is $tableau1->current_tableau, + object { prop isa => 'Value::Matrix' }, + '-> current_tableau is Value::Matrix'; + is $tableau1->current_tableau, + Matrix($ra_matrix)->string, + 'entire tableau including obj coeff row'; + + is $tableau1->S, object { prop isa => 'Value::Matrix' }, 'slack variables are a Value::Matrix'; + is $tableau1->S, $tableau1->I($tableau1->m)->string, 'slack variables are identity matrix'; +}; + +subtest 'Verify stringify subroutine' => sub { + my $aref = [ [qw/1 2/], 7, [3, 0.4], [ (5, -.6, [8, 9])], 0, -1, [qw/-2 -3/]]; + my $expected_string = '[[1,2],7,[3,0.4],[5,-0.6,[8,9]],0,-1,[-2,-3]]'; + is stringify($aref), $expected_string, 'Local stringify recursively descends the refs'; +}; + +# try out validator for mixed data types +my $compare_data = sub { + my %params = @_; + + # postfix dereferencing stable in perl 5.24 + my ($g, $e) = map { ref $_ =~ /Value/ ? $_->copy : $_ } @{$params{got}}; + + my ($got, $exp); + $got = ref $g eq 'Value::Matrix' ? $g->string : stringify($g); + $exp = ref $e eq 'Value::Matrix' ? $e->string : stringify($e); + + return is $got, $exp, 'Compare datastructures of MathObjects'; +}; + +subtest 'Verify objective_row methods and properties' => sub { + is [ $tableau1->obj_row, $tableau1->{obj_row} ], + validator( $compare_data ), + 'verify mutator for {obj_row}'; + + is [ $tableau1->objective_row, [$tableau1->obj_row->value] ], + validator( $compare_data ), + 'objective_row is obj_row->value = ARRAY'; +}; + +subtest 'test basis' => sub { + is ref $tableau1->basis_columns, 'ARRAY', '{basis_column} has type ARRAY'; + is [$tableau1->basis_columns, [ 5, 6 ]], validator( $compare_data ), 'initialization of basis'; + is( + ref($tableau1->current_basis_matrix), + ref(Value::Matrix->I($tableau1->m)), + 'current_basis_matrix type is MathObjectMatrix' + ); + is $tableau1->current_basis_matrix->string, + Value::Matrix->I($tableau1->m)->string, + 'initialization of basis'; +}; + + +subtest 'change basis and test again' => sub { + $tableau1->basis(2, 3); + + is ref $tableau1->basis_columns, 'ARRAY', '{basis_column} has type ARRAY'; + is [$tableau1->basis_columns, [ 2, 3 ]], validator( $compare_data ), ' basis columns set to {2,3}'; + is( + ref($tableau1->current_basis_matrix), + ref($test_constraint_matrix->column_slice(2, 3)), + 'current_basis_matrix type is MathObjectMatrix' + ); + is( + $tableau1->current_basis_matrix->string, + $test_constraint_matrix->column_slice(2, 3)->string, + 'basis_matrix for columns {2,3} is correct' + ); + is $tableau1->basis(Set(2, 3))->string, List([ 2, 3 ])->string, '->basis(Set(2,3))'; + is $tableau1->basis(List(2, 3))->string, List([ 2, 3 ])->string, '->basis(List(2,3))'; + is $tableau1->basis([ 2, 3 ])->string, List([ 2, 3 ])->string, '->basis([2,3])'; +}; + +subtest 'find basis column index corresponding to row index' => sub { + # and value of the basis coefficient + + $tableau1->basis(5, 6); + note("\nbasis is", $tableau1->basis(5, 6)); + note(print $tableau1->current_tableau, "\n"); + is [ $tableau1->find_leaving_column(1) ], [ 5, 1 ], + 'find_leaving_column returns [col_index, pivot_value] '; + is [ $tableau1->find_leaving_column(2) ], [ 6, 1 ], + 'find_leaving_column returns [col_index, pivot_value] '; + + is $tableau1->find_next_basis_from_pivot(1, 2)->string, Set(2, 6)->string, + 'find next basis from pivot (1,2)'; + is $tableau1->find_next_basis_from_pivot(1, 3)->string, Set(3, 6)->string, + 'find next basis from pivot (1,3)'; + is $tableau1->find_next_basis_from_pivot(2, 1)->string, Set(1, 5)->string, + 'find next basis from pivot (2,1)'; + is $tableau1->find_next_basis_from_pivot(1, 1)->string, Set(1, 6)->string, + 'find next basis from pivot (1,1)'; + + like( + dies { $tableau1->find_next_basis_from_pivot(2, 5) }, + qr/pivot point should not be in a basis column/, + "can't pivot in basis column (2,5)" + ); # probably shouldn't be doing this. + like( + dies { $tableau1->find_next_basis_from_pivot(1, 6) }, + qr/pivot point should not be in a basis column/, + "can't pivot in basis column (2,6)" + ); # probably shouldn't be doing this. + + is $tableau1->find_next_basis_from_pivot(2, 1)->string, Set(1, 5)->string, + 'find next basis from pivot (2,1)'; + like( + dies { $tableau1->find_next_basis_from_pivot(2, 6) }, + qr/pivot point should not be in a basis column/, + "can't pivot in basis column (2,6)" + ); # probably shouldn't be doing this. +}; + +subtest 'find another basis (2,3)' => sub { + $tableau1->basis(2, 3); + note("\nbasis is", $tableau1->basis()); + note(print $tableau1->current_tableau, "\n"); + + is [ $tableau1->find_leaving_column(1) ], [ 2, 500 ], + 'find_leaving_column returns [col_index, pivot_value] '; + is [ $tableau1->find_leaving_column(2) ], [ 3, 500 ], + 'find_leaving_column returns [col_index, pivot_value] '; + + like( + dies { $tableau1->find_next_basis_from_pivot(1, 2) }, + qr/pivot point should not be in a basis column/, + "can't pivot in basis column (1,2)" + ); # probably shouldn't be doing this either. + like( + dies { $tableau1->find_next_basis_from_pivot(1, 3) }, + qr/pivot point should not be in a basis column/, + "can't pivot in basis column (1,3)" + ); # probably shouldn't be doing this. + + is $tableau1->find_next_basis_from_pivot(2, 1)->string, Set(1, 2)->string, + 'find next basis from pivot (2,1)'; + is $tableau1->find_next_basis_from_pivot(1, 1)->string, Set(1, 3)->string, + 'find next basis from pivot (1,1)'; +}; + +subtest 'find next short cut pivots' => sub { + $tableau1->basis(5, 6); + note("\nbasis is ", $tableau1->basis()); + note($tableau1->current_tableau, "\n"); + + # ($row_index, $value, $feasible_point) = $self->find_short_cut_row() + + is [ $tableau1->find_short_cut_row() ], [ 1, -4700, 0 ], 'row 1'; + is [ $tableau1->find_short_cut_column(1) ], [ 1, -5000, 0 ], 'column 1 '; + is [ $tableau1->next_short_cut_pivot() ], [ 1, 1, 0, 0 ], 'pivot (1,1)'; + is [ $tableau1->next_short_cut_basis() ], [ 1, 6, undef ], 'new basis {1,6} continue'; + + $tableau1->current_tableau(1, 6); + note($tableau1->current_tableau); + + is [ $tableau1->find_short_cut_row ], + [ 2, Value::Real->new(-8.4E+06)->string, 0 ], 'find short cut row'; + is [ $tableau1->find_short_cut_column(2) ], + [ 2, Value::Real->new(-1.3E+06)->string, 0 ], 'find short cut col 2 '; + is [ $tableau1->next_short_cut_pivot() ], [ 2, 2, 0, 0 ], 'pivot (2,2)'; + is [ $tableau1->next_short_cut_basis() ], [ 1, 2, undef ], 'new basis {1,2} continue'; + + $tableau1->current_tableau(1, 2); + note($tableau1->current_tableau); + + is [ $tableau1->next_short_cut_pivot() ], [ undef, undef, 1, 0 ], 'feasible point found'; + is( + [ $tableau1->next_short_cut_basis() ], + [ 1, 2, 'feasible_point' ], + 'all constraints positive at basis {1,2} --start phase2' + ); + is [ $tableau1->find_pivot_column('max') ], [ 3, Value::Real->new(-100000)->string, 0 ], 'col 3'; + is [ $tableau1->find_pivot_row(3) ], [ 1, Value::Real->new(550000 / 500)->string, 0 ], 'row 1'; + is [ $tableau1->find_next_pivot('max') ], [ 1, 3, 0, 0 ], 'pivot (1,3)'; + is [ $tableau1->find_next_basis('max') ], [ 2, 3, undef ], 'new basis {2,3} continue'; + + $tableau1->current_tableau(2, 3); + note($tableau1->current_tableau); + is [ $tableau1->find_pivot_column('max') ], [ 4, Value::Real->new(-300)->string, 0 ], 'col 4'; + is [ $tableau1->find_pivot_row(4) ], [ 1, 4500, 0 ], 'row 2'; + + is [ $tableau1->find_next_pivot('max') ], [ 1, 4, 0, 0 ], 'pivot 1,4'; + is [ $tableau1->find_next_basis('max') ], [ 3, 4, undef ], 'new basis {3,4} continue'; + + $tableau1->current_tableau(3, 4); + note($tableau1->current_tableau); + is [ $tableau1->find_pivot_column('max') ], [ 5, Value::Real->new(-1)->string, 0 ], 'col 5'; + is [ $tableau1->find_pivot_row(5) ], [ undef, undef, 1 ], 'row 2'; + + is [ $tableau1->find_next_pivot('max') ], [ undef, 5, 0, 1 ], 'unbounded -- no pivot'; + is [ $tableau1->find_next_basis('max') ], [ 3, 4, 'unbounded' ], 'basis 3,4 unbounded'; +}; # note that the column is returned from find_next_pivot so one can find a certificate # of unboundedness (can return a line going off to infinity) @@ -292,31 +418,44 @@ is_deeply([ $tableau1->find_next_basis('max') ], [ 3, 4, 'unbounded' ], "basis 3 # # "unbounded, feasible_point, infeasible_tableau, optimal"? # # it might be easier to remember. # -note("reset tableau to feasible point and try to minimize it for phase2"); -$tableau1->current_tableau(1, 2); -note($tableau1->current_tableau); -is_deeply([ $tableau1->next_short_cut_pivot() ], [ undef, undef, 1, 0 ], "feasible point found"); -is_deeply( - [ $tableau1->next_short_cut_basis() ], - [ 1, 2, 'feasible_point' ], - "all constraints positive at basis {1,2} --start phase2" -); - -is_deeply([ $tableau1->find_pivot_column('min') ], [ undef, undef, 1 ], "all neg coeff"); -is_deeply([ $tableau1->find_pivot_row(1) ], [ 1, Value::Real->new(550000 / 1300000), 0 ], "row 1 "); -is_deeply([ $tableau1->find_next_pivot('min') ], [ undef, undef, 1, 0 ], "optimum"); -is_deeply([ $tableau1->find_next_basis('min') ], [ 1, 2, 'optimum' ], "optimum"); -# -# -is_deeply( - $tableau1->statevars, # round off errors - [ 550000 / 1300000, 8400000 / 1300000, 0, 0, 0, 0, 8.339999999999999E9 / 1300000 ], "state variables" -); +subtest 'reset tableau to feasible point and try to minimize it for phase2' => sub { + $tableau1->current_tableau(1, 2); + note($tableau1->current_tableau); + is [ $tableau1->next_short_cut_pivot() ], [ undef, undef, 1, 0 ], 'feasible point found'; + is( + [ $tableau1->next_short_cut_basis() ], + [ 1, 2, 'feasible_point' ], + 'all constraints positive at basis {1,2} --start phase2' + ); + + is [ $tableau1->find_pivot_column('min') ], [ undef, undef, 1 ], 'all neg coeff'; + is [ $tableau1->find_pivot_row(1) ], + [ 1, Value::Real->new(550000 / 1300000)->string, 0 ], + 'row 1'; + is [ $tableau1->find_next_pivot('min') ], [ undef, undef, 1, 0 ], 'optimum'; + is [ $tableau1->find_next_basis('min') ], [ 1, 2, 'optimum' ], 'optimum'; + + is( + $tableau1->statevars, # round off errors + [ 550000 / 1300000, 8400000 / 1300000, 0, 0, 0, 0, 8.339999999999999E9 / 1300000 ], + 'state variables' + ); + + is $tableau1->align, 'cccc|cc|c|c', 'check align'; + is $tableau1->toplevel, [qw(x1 x2 x3 x4 x5 x6 z b)], 'check toplevel'; + + # diag($tableau1->align); + # diag(join(q{ } , @{$tableau1->toplevel})); +}; -is($tableau1->align, 'cccc|cc|c|c', "check align"); -is_deeply($tableau1->toplevel, [qw(x1 x2 x3 x4 x5 x6 z b)], "check toplevel"); -# diag($tableau1->align); -# diag(join(" " , @{$tableau1->toplevel})); done_testing(); + +sub stringify { + my $arrayref = shift; + warn "Not an array ref [$arrayref]" unless ref $arrayref eq 'ARRAY'; + return sprintf("[%s]", + join(',', map { my $s = $_; ref $s eq 'ARRAY' ? stringify($s) : $s } @{$arrayref}) + ); +} diff --git a/t/units/basic_module.t b/t/units/basic_module.t new file mode 100644 index 0000000000..0ad70fe095 --- /dev/null +++ b/t/units/basic_module.t @@ -0,0 +1,24 @@ +use Test2::V0; + +use Units; + +# get unit hashes +my %joule = evaluate_units('J'); +my %newton_metre = evaluate_units('N*m'); +my %energy_base_units = evaluate_units('kg*m^2/s^2'); + +# basic definitions of energy equivalence +is \%joule, \%newton_metre, + 'A joule is a newton-metre'; +is \%joule, \%energy_base_units, + 'A joule is a kg metre squared per second squared'; + + +# test the error handling +my $fake = 'bleurg'; +ok my %error = evaluate_units($fake); +like $error{ERROR}, qr/UNIT ERROR Unrecognizable unit: \|$fake\|/, + "No unit '$fake' defined in Units file"; + + +done_testing; diff --git a/t/units/basic_parser.t b/t/units/basic_parser.t new file mode 100644 index 0000000000..8fb3bc661a --- /dev/null +++ b/t/units/basic_parser.t @@ -0,0 +1,202 @@ +use Test2::V0; + +use Parser::Legacy::NumberWithUnits; # load this before the parser macro +use Units; + +use lib 't/lib'; +use Test::PG; + +loadMacros("parserNumberWithUnits.pl"); + +Context("Numeric"); + + +=head1 NumberWithUnits + +We test the basic functionality of the NumberWithUnits parser, +F, to give us faith +that the parser and its methods are working. +Other test files will probe deeper into specific use cases of +the NumberWithUnits macro and the L module. + +=head2 Testing Strategy + +Test all the methods of an object, check the attributes, verify the errors +are thrown correctly, display strings look the way they should and +all the ways that a student could answer produce the appropriate results. +Check that the objects we create belong to their expected class. + +Demonstrate some of the flavour of Test2, with hash, bag, dies, todo, etc. +Group similar tests into subtests. + +=head3 Setup + +All the boilerplate code is loaded with Test::PG and assume that people run +it from the root directory with C. +Load your base modules before loading the macros which depend on them +and set the Context, if appropriate. + +See the example in the documentation of L + + perldoc t/lib/Test/PG.pm + +=head2 TODO list + +=over 4 + +=item Fix display of temperature units + +=item Test adding new units + +=item Look up how to get the value of the object instead of reaching into the hashref + +=item Test messages from wrong student answer submissions + +=back + +=cut + + +# define some basic objects +ok my $joule = NumberWithUnits(1, 'J'); +ok my $Nm = NumberWithUnits(1, 'N*m'); +ok my $energy_base_units = NumberWithUnits(1, 'kg*m^2/s^2'); + + +subtest 'Verify classes and methods' => sub { + isa_ok $joule, 'Parser::Legacy::NumberWithUnits'; + can_ok $joule, + [ qw/cmp splitUnits getUnitNames getUnits TeXunits cmp_parse adjustCorrectValue + add_fundamental_unit add_unit string TeX / ], + 'Can we NumberWithUnits'; + + ok my $evaluator = $joule->cmp($Nm), 'Get an AnswerEvaluator'; + isa_ok $evaluator, 'AnswerEvaluator'; + can_ok $evaluator, [ qw/ evaluate / ], 'We Can Evaluate'; +}; + + +subtest 'Check attributes' => sub { + is( + $joule, + { + data => [ 1 ], + units => 'J', + units_ref => { kg => 1, m => 2, s => -2, factor => 1, + amp => 0, cd => 0, mol => 0, rad => 0, + degC => 0, degF => 0, degK => 0, + }, + isValue => T(), + context => check_isa 'Parser::Context', + }, + 'This looks like a joule' +); +}; + +subtest 'Basic definitions of energy equivalence' => sub { + is $joule->{data}->[0], $Nm->{data}->[0], 'One joule is one newton-metre'; + is $joule->getUnits, $Nm->getUnits, 'A joule has the same dimensions as a newton-metre'; + + is (check_score($joule, $Nm), 1, 'A Joule is a Newton-metre'); + is (check_score($joule, $energy_base_units), 1, 'A Joule can be expressed in SI base units'); +}; + +subtest 'Test error handling' => sub { + my $fake = 'bleurg'; + + like( + dies { NumberWithUnits(1, "$fake") }, + qr/Unrecognizable unit: \|$fake\|/, + "No unit '$fake' defined in Units file" + ); + like( + dies { NumberWithUnits(1) }, + qr/You must provide units for your number/, + "No unit given" + ); + like( + dies { NumberWithUnits('J') }, + qr/You must provide units for your number/, + "No value given, wants 2 arguments" + ); +}; + +subtest 'Check parsing of arguments' => sub { + ok my $three_args = NumberWithUnits(1, 'N', 'm'), 'Ignores extra argument'; + is $three_args->string, '1 N', 'Only sees the first unit'; + + ok my $string_arg = NumberWithUnits('1J'), 'Parses string argument'; + is $string_arg->string, '1 J', 'Parses string correctly'; +}; + +subtest 'Check some known units' => sub { + ok my @unit_names = (split /\|/, $joule->getUnitNames), 'Can getUnitNames'; + + is \@unit_names, + bag { + all_items( match qr/^[-%\w]+$/ ); + item 'J'; item 'N'; + item 'm'; item 'kg'; item 's'; + etc; + }, + 'Basic units loaded, sanity check'; +}; + +subtest 'Check other methods' => sub { + is [ $joule->splitUnits ], ['1', 'J'], 'splitUnits creates an array'; + + is $joule->adjustCorrectValue, 0, 'What is adjustCorrectValue?'; +}; + +subtest 'Check display methods' => sub { + is $joule->string, '1 J', 'Displays string - Joule'; + is $joule->TeX, '1\ {\rm J}', 'Displays LaTeX string - Joule'; + is $joule->TeXunits, '{\rm 1 J}', 'Displays LaTeX string - Joule'; + is $Nm->TeX, '1\ {\rm N\,m}', 'Displays LaTeX string - Newton metre'; + like $energy_base_units->TeX, + qr/ 1\\ \s \{ \S* \\frac\{ \\rm\S* \s kg \\, m\^\{2\}\} \{\\rm\S* \s s\^\{2\}\}\} /x, + 'Displays LaTeX string - energy in SI base units'; + + ok my $celsius = NumberWithUnits(1, 'degC'); + ok my $kelvin = NumberWithUnits(1, 'degK'); + todo 'Fix the display of temperatures' => sub { + is $celsius->TeX, '1\ {\rm ^{\circ}C}', 'Displays LaTeX string for degrees (finally)'; + is $kelvin->TeX, '1\ {\rm K}', 'Displays LaTeX string for kelvin, no degree sign'; + }; +}; + +subtest 'Check possible answer format branches' => sub { + # re-write without check_score so we can get the messages to students + + is check_score($joule, '1 J'), 1, 'one Joule plain'; + is check_score($joule, '1.00 J'), 1, 'one Joule float'; + is check_score($joule, '1E0 J'), 1, 'one Joule exponential notation'; + is check_score($joule, '7/7 J'), 1, 'one Joule value calculated'; + is check_score($joule, '1 J^1'), 1, 'one Joule to the power of one'; + is check_score($joule, 'J 1'), 0, 'one Joule wrong order'; + is check_score($joule, '2 J'), 0, 'one Joule wrong value'; + is check_score($joule, '1 j'), 0, 'one Joule wrong case'; + is check_score($joule, '1'), 0, 'one Joule missing unit'; + is check_score($joule, 'J'), 0, 'one Joule missing value'; + is check_score($joule, '1J'), 1, 'one Joule missing space between value and unit is valid'; + is check_score($joule, '1 N'), 0, 'one Joule wrong unit force not energy'; + is check_score($joule, '1 Nm'), 0, 'one Joule Nm missing *'; + is check_score($joule, '1 N*m'), 1, 'one Joule as Newton metre'; + is check_score($joule, '1 Joule'), 0, 'one Joule in words'; + is check_score($joule, '1E-3 kJ'), 1, 'one Joule value as exponential'; +}; + +todo 'check_score is stateful. Cannot handle repeated calls' => sub { + is check_score($joule, '1E-3 kJ'), 1, 'one Joule value as exponential second call'; + is check_score($joule, '1E-3 kJ'), 1, 'one Joule value as exponential third call'; + + # the other tests I'd like to run + is check_score($joule, '0.001 kJ'), 1, 'one Joule decimal kJ'; + is check_score($joule, '1/1000 kJ'), 1, 'one Joule fractional kJ'; + is check_score($joule, '10^-3 kJ'), 1, 'one Joule latex power kJ'; + is check_score($joule, '1 x 10^-3 kJ'), 1, 'one Joule scientific notation'; + is check_score($joule, '10**-3 kJ'), 1, 'one Joule power of 10 kJ'; +}; + + +done_testing; diff --git a/t/units/electron_volts.t b/t/units/electron_volts.t new file mode 100644 index 0000000000..03b667f0f1 --- /dev/null +++ b/t/units/electron_volts.t @@ -0,0 +1,30 @@ +use Test2::V0; + +use Units; + +my %joule = evaluate_units('J'); +my %newton_metre = evaluate_units('N*m'); +my %base_units = evaluate_units('kg*m^2/s^2'); + +my %electron_volt = evaluate_units('eV'); +my %kev = evaluate_units('keV'); +my %mev = evaluate_units('MeV'); +my %gev = evaluate_units('GeV'); + +is \%electron_volt, by_factor( 1.6022E-19, \%joule ), + 'eV and joules differ by a factor of 1.6022 x 10^19'; +is \%kev, by_factor( 1000, \%electron_volt ), 'kilo is factor 1000'; +is \%mev, by_factor( 10**6, \%electron_volt ), 'mega is factor 10^6'; +is \%gev, by_factor( 10**9, \%electron_volt ), 'giga is factor 10^9'; + + +done_testing; + +sub by_factor { + my ($value, $unit) = @_; + my $new_unit = { %$unit }; # shallow copy hash values + + $new_unit->{factor} *= $value; + + return $new_unit; +} From 68969721680f311436cb286c401dc2154058c4b4 Mon Sep 17 00:00:00 2001 From: Boyd Duffee Date: Fri, 22 Jul 2022 10:36:28 +0100 Subject: [PATCH 2/2] Migrate factorial.t to Test2 Convert math_objects/factorial.t to using the Test2 framework Update the t/README.md to the new usage of Test2 and the boilerplate Test::PG module removed the execute permission from tableau.t --- t/README.md | 27 ++------- t/macros/tableau.t | 0 t/math_objects/factorial.t | 116 +++++++++++++++++-------------------- 3 files changed, 60 insertions(+), 83 deletions(-) mode change 100755 => 100644 t/macros/tableau.t diff --git a/t/README.md b/t/README.md index 993c4599dd..4c7a852523 100644 --- a/t/README.md +++ b/t/README.md @@ -61,26 +61,10 @@ Or you could use `prove -lv t/macros/pgaux.t` from the root directory. To write a unit test, the following is needed at the top of the file: ```perl -use warnings; -use strict; +use Test2::V0; -package main; - -use Test::More; -use Test::Exception; - -## the following needs to include at the top of any testing down to TOP_MATERIAL - -BEGIN { - die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} - -use lib "$main::pg_dir/lib"; - -require("$main::pg_dir/t/build_PG_envir.pl"); - -## END OF TOP_MATERIAL +use lib 't/lib'; +use Test::PG; ``` and ensure that `PG_ROOT` is in your environmental variables. @@ -98,10 +82,11 @@ my $f = Compute("x^2"); # evaluate f at x=2 -is(check_score($f->eval(x=>2),"4"),1,"math objects: eval x^2 at x=2"); +is check_score($f->eval(x=>2), '4'), 1, 'math objects: eval x^2 at x=2'; ``` -The `check_score` subroutine evaluates and compares a MathObject with a string representation of the answer. If the score is 1, then the two are equal. +The `check_score` subroutine evaluates and compares a MathObject with a string representation of the answer. +If the score is 1, then the two are equal. # Integration tests diff --git a/t/macros/tableau.t b/t/macros/tableau.t old mode 100755 new mode 100644 diff --git a/t/math_objects/factorial.t b/t/math_objects/factorial.t index 5342054ad5..194397821d 100644 --- a/t/math_objects/factorial.t +++ b/t/math_objects/factorial.t @@ -1,78 +1,70 @@ -use warnings; -use strict; +use Test2::V0; -package main; +use lib 't/lib'; +use Test::PG; -use Test::More; -use Test::Exception; -# The following needs to include at the top of any testing down to END OF TOP_MATERIAL. +=head1 MathObjects - factorial -BEGIN { - die 'PG_ROOT not found in environment.\n' unless $ENV{PG_ROOT}; - $main::pg_dir = $ENV{PG_ROOT}; -} +Tests pass -use lib "$main::pg_dir/lib"; +=cut -require("$main::pg_dir/t/build_PG_envir.pl"); - -## END OF TOP_MATERIAL - -use Parser; loadMacros('MathObjects.pl'); Context('Numeric'); -Context()->variables->add(y => "Real"); +Context()->variables->add(y => "Real"); # unused Context()->variables->add(n => "Real"); my $five_fact = Compute('5!'); -use Data::Dumper; -print Dumper $five_fact->class; - -is($five_fact->class, 'Real', 'factorial: check class of object'); -is($five_fact->type, 'Number', 'factorial: check type of object'); - -ok(Value::isValue($five_fact), 'factorial: check if an object is a value'); -ok(Value::isNumber($five_fact), 'factorial: check if an object is a number'); -ok(Value::isReal($five_fact), 'factorial: check if a number is a real number'); -ok(!Value::isComplex($five_fact), 'factorial: check if an integer is complex'); -ok(!Value::isFormula($five_fact), 'factorial: check if a number is not a formula'); - -is($five_fact->value,120, 'factorial: 5! is 120'); -is(Compute("0!")->value, 1, 'factorial: 0! is 1'); - -note('The double factorial is not defined here.'); -my $four_double_fact = Compute("4!!")->value; -ok(6.2e+23 < $four_double_fact && $four_double_fact < 6.3e+23, 'factorial: 4!! is defined as (4!)!=24!' ); - -ok(Compute("170!") > 1e+306, 'factorial: 170! is large but not infinite.'); - -note('Tests for throwing exceptions.'); - -throws_ok { - Compute("(-1)!"); -} -qr/Factorial can only be taken of \(non-negative\) integers/, 'factorial: can\'t take factorial of negative integers.'; - -throws_ok { - Compute("1.5!"); -} -qr/Factorial can only be taken of \(non-negative\) integers/, 'factorial: can\'t take factorial of non-integer reals.'; - -note('Try taking factorials of variables'); -my $n_fact = Compute("n!"); -is($n_fact->class, "Formula", "factorial: n! is a Formula"); -is($n_fact->type, "Number", "factorial: n! has type is Number"); -is($n_fact->eval(n=>5), 120, 'factorial: n! evaluated at n=5 is correct.'); - -# check infinite values -note('Tests for infinite values'); - -my $large_fact = Compute('171!'); -my $inf = Compute('inf'); -is($large_fact->value, $inf, '171! is infinite.'); +is $five_fact->class, 'Real', 'factorial: check class of object'; +is $five_fact->type, 'Number', 'factorial: check type of object'; + +ok Value::isValue($five_fact), 'factorial: check if an object is a value'; +ok Value::isNumber($five_fact), 'factorial: check if an object is a number'; +ok Value::isReal($five_fact), 'factorial: check if a number is a real number'; +ok !Value::isComplex($five_fact), 'factorial: check if an integer is complex'; +ok !Value::isFormula($five_fact), 'factorial: check if a number is not a formula'; + +is $five_fact->value, 120, 'factorial: 5! is 120'; +is Compute("0!")->value, 1, 'factorial: 0! is 1'; + +subtest 'double factorial is not defined here' => sub { + my $four_double_fact = Compute("4!!")->value; + ok 6.2e+23 < $four_double_fact && $four_double_fact < 6.3e+23, + 'factorial: 4!! is defined as (4!)!=24!'; +}; + +ok Compute("170!") > 1e+306, 'factorial: 170! is large but not infinite.'; + +subtest 'Tests for throwing exceptions' => sub { + like( + dies { Compute("(-1)!") }, + qr/Factorial can only be taken of \(non-negative\) integers/, + 'factorial: cannot take factorial of negative integers' + ); + like( + dies { Compute("1.5!") }, + qr/Factorial can only be taken of \(non-negative\) integers/, + 'factorial: cannot take factorial of non-integer reals' + ); +}; + +subtest 'factorials of variables' => sub { + my $n_fact = Compute("n!"); + is $n_fact->class, 'Formula', 'factorial: n! is a Formula'; + is $n_fact->type, 'Number', 'factorial: n! has type is Number'; + is $n_fact->eval(n=>5), 120, 'factorial: n! evaluated at n=5 is correct.'; +}; + +subtest 'Tests for infinite values' => sub { + my $large_fact = Compute('171!'); + my $inf = Compute('inf'); + + is $large_fact->value, "$inf", '171! is infinite.'; # stringify $inf to make the comparison + ok $large_fact->{isInfinite}, 'object attribute for infinity is set'; +}; done_testing();