From a40a07208bb63249f2e5adced1a12426005948d3 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Fri, 19 Aug 2022 15:34:47 -0500 Subject: [PATCH] Update the unit tests. --- t/README.md | 21 ++- t/build_PG_envir.pl | 58 ++++--- t/contexts/fraction.t | 38 ++--- t/contexts/integer.t | 28 ++-- t/contexts/toltype_digits.t | 56 +++---- t/contexts/trig_degrees.t | 84 ++++------ t/lib/Test/PG.pm | 108 ------------- t/macros/basicmacros.t | 37 ++--- t/macros/math_objects_basics.t | 55 ++----- t/macros/math_objects_more.t | 41 +++-- t/macros/pgaux.t | 28 ++-- t/macros/tableau.t | 191 ++++++++++------------- t/math_objects/factorial.t | 43 +++--- t/units/basic_module.t | 24 +-- t/units/basic_parser.t | 274 ++++++++++++++++----------------- t/units/electron_volts.t | 35 +++-- 16 files changed, 461 insertions(+), 660 deletions(-) delete mode 100644 t/lib/Test/PG.pm diff --git a/t/README.md b/t/README.md index 4c7a852523..2cf778d150 100644 --- a/t/README.md +++ b/t/README.md @@ -9,7 +9,7 @@ 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 +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 @@ -18,8 +18,7 @@ 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 [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. @@ -88,32 +87,30 @@ 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 tests [Integration testing](https://en.wikipedia.org/wiki/Integration_testing) -tests components working together as a group. The files with the `.pg` +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 +## 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 +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 +in the root directory. Use - cpanm --installdeps . +cpanm --installdeps . which will install the runtime and test dependencies. To use the cpanfile for a minimal install skipping the test requirements, diff --git a/t/build_PG_envir.pl b/t/build_PG_envir.pl index 417cb3844a..63aace623d 100644 --- a/t/build_PG_envir.pl +++ b/t/build_PG_envir.pl @@ -1,33 +1,52 @@ -use warnings; +#!/usr/bin/env perl + use strict; +use warnings; -package main; +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +use lib "$ENV{PG_ROOT}/lib"; -$main::macros_dir = "$main::pg_dir/macros"; +my $macros_dir = "$ENV{PG_ROOT}/macros"; -# use WeBWorK::Localize; use PGcore; use Parser; -# build up enough of a PG environment to get things running - -our %envir = (); -$envir{htmlDirectory} = "/opt/webwork/courses/daemon_course/html"; -$envir{htmlURL} = "http://localhost/webwork2/daemon_course/html"; -$envir{tempURL} = "http://localhost/webwork2/daemon_course/tmp"; -$envir{pgDirectories}->{macrosPath} = ["$main::macros_dir"]; -$envir{macrosPath} = ["$main::macros_dir"]; -$envir{displayMode} = "HTML_MathJax"; -$envir{language} = "en-us"; -$envir{language_subroutine} = sub { return @_; }; # return the string passed in instead going to maketext +# Build up enough of a PG environment to get things running. +$main::envir{htmlDirectory} = '/opt/webwork/courses/daemon_course/html'; +$main::envir{htmlURL} = 'http://localhost/webwork2/daemon_course/html'; +$main::envir{tempURL} = 'http://localhost/webwork2/daemon_course/tmp'; +$main::envir{pgDirectories}{macrosPath} = [$macros_dir]; +$main::envir{macrosPath} = [$macros_dir]; +$main::envir{displayMode} = 'HTML_MathJax'; +$main::envir{language} = 'en'; +$main::envir{language_subroutine} = sub { return $_[0]; }; + +$main::envir{functAbsTolDefault} = 0.001; +$main::envir{functLLimitDefault} = 0.0000001; +$main::envir{functMaxConstantOfIntegration} = 1E8; +$main::envir{functNumOfPoints} = 3; +$main::envir{functRelPercentTolDefault} = 0.1; +$main::envir{functULimitDefault} = 0.9999999; +$main::envir{functVarDefault} = 'x'; +$main::envir{functZeroLevelDefault} = 1E-14; +$main::envir{functZeroLevelTolDefault} = 1E-12; +$main::envir{numAbsTolDefault} = 0.001; +$main::envir{numFormatDefault} = ''; +$main::envir{numRelPercentTolDefault} = 0.1; +$main::envir{numZeroLevelDefault} = 1E-14; +$main::envir{numZeroLevelTolDefault} = 1E-12; +$main::envir{useBaseTenLog} = 0; +$main::envir{defaultDisplayMatrixStyle} = '[s]'; sub be_strict { - require 'ww_strict.pm'; + require ww_strict; strict::import(); + return; } sub PG_restricted_eval { - WeBWorK::PG::Translator::PG_restricted_eval(@_); + my @input = @_; + return WeBWorK::PG::Translator::PG_restricted_eval(@input); } sub check_score { @@ -35,9 +54,10 @@ sub check_score { return $correct_answer->cmp->evaluate($ans)->{score}; } -require "$main::macros_dir/PG.pl"; +do "$macros_dir/PG.pl"; + DOCUMENT(); -loadMacros("PGbasicmacros.pl"); +loadMacros('PGbasicmacros.pl'); 1; diff --git a/t/contexts/fraction.t b/t/contexts/fraction.t index ec10c3deaf..d873bba78e 100644 --- a/t/contexts/fraction.t +++ b/t/contexts/fraction.t @@ -1,38 +1,28 @@ -use Test2::V0; +#!/usr/bin/env perl -# should I "use" Parser Value Parser::Legacy here instead? +=head1 Fraction context -use lib 't/lib'; -use Test::PG; - -=head2 Fraction context - -To test the reduction of fractions +Test the fraction context defined in contextFraction.pl. =cut -loadMacros("PGstandard.pl", "MathObjects.pl", "contextFraction.pl"); +use Test2::V0 '!E', { E => 'EXISTS' }; -# dd @INC; +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; -for my $module (qw/Parser Value Parser::Legacy/) { - eval "package Main; require $module; import $module;"; -} +use lib "$ENV{PG_ROOT}/lib"; -# use Value; -# use Value::Complex; -# # use Value::Type; -# use Parser::Context::Default; -# use Parser::Legacy; -# use Parser::Context; +loadMacros('PGstandard.pl', 'MathObjects.pl', 'contextFraction.pl'); -Context("Fraction"); +use Value; +require Parser::Legacy; +import Parser::Legacy; -# require("Parser::Legacy::LimitedNumeric::Number"); -# require("Parser::Legacy"); +Context('Fraction'); -ok my $a1 = Compute("1/2"); -ok 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'; diff --git a/t/contexts/integer.t b/t/contexts/integer.t index d5f495e84a..887b2fdf24 100644 --- a/t/contexts/integer.t +++ b/t/contexts/integer.t @@ -1,27 +1,29 @@ -use Test2::V0; +#!/usr/bin/env perl -# should I "use" Parser Value Parser::Legacy here instead? +=head1 Integer context -use lib 't/lib'; -use Test::PG; +Test contextInteger.pl methods. -=head2 Integer context +=cut -To test for greatest common denomenators and such like. +use Test2::V0 '!E', { E => 'EXISTS' }; -=cut +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; + +use lib "$ENV{PG_ROOT}/lib"; -loadMacros("MathObjects.pl", "contextInteger.pl"); +loadMacros('MathObjects.pl', 'contextInteger.pl'); -for my $module (qw/Parser Value Parser::Legacy/) { - eval "package Main; require $module; import $module;"; -} +use Value; +require Parser::Legacy; +import Parser::Legacy; -Context("Integer"); +Context('Integer'); my $b = Compute(gcd(5, 2)); ANS($b->cmp); -ok(1, "integer test: dummy test"); +ok(1, 'integer test: dummy test'); done_testing(); diff --git a/t/contexts/toltype_digits.t b/t/contexts/toltype_digits.t index 4b3f741f85..baa7276a18 100644 --- a/t/contexts/toltype_digits.t +++ b/t/contexts/toltype_digits.t @@ -1,37 +1,39 @@ -use Test2::V0; +#!/usr/bin/env perl -use lib 't/lib'; -use Test::PG; +=head1 TolType context -=head2 TolType context - -To test for tolerances +Test MathObjects tolerances. =cut -loadMacros("PGstandard.pl", "MathObjects.pl"); +use Test2::V0 '!E', { E => 'EXISTS' }; + +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; + +loadMacros('PGstandard.pl', 'MathObjects.pl'); -my $ctx = Context("Numeric"); -my $pi = Real("pi"); +my $ctx = Context('Numeric'); +my $pi = Real('pi'); 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"; + 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"; + 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 { @@ -42,15 +44,15 @@ subtest 'set tolExtraDigits to 2' => sub { 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.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"; + 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 ba8481721f..3e70c8683c 100644 --- a/t/contexts/trig_degrees.t +++ b/t/contexts/trig_degrees.t @@ -1,71 +1,43 @@ -use Test2::V0; +#!/usr/bin/env perl -use lib 't/lib'; -use Test::PG; +=head1 contextTrigDegrees -# remove warnings about redefining trig functions -delete $main::{sin}; -delete $main::{cos}; -delete $main::{atan2}; - - -=head2 Errors to be fixed - -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? - -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 +Test computations in the TrigDegrees context. =cut +use Test2::V0 '!E', { E => 'EXISTS' }; -loadMacros("contextTrigDegrees.pl"); - -my $ctx = Context("TrigDegrees"); - -ok(Value::isContext($ctx), "trig degrees: check context"); - -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?'; - +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; -# dd Compute("1/2")->value; -# is (check_score($cos60,"1/2"),1,"trig degrees: cos(60) = 1/2"); +loadMacros('contextTrigDegrees.pl'); -# dd $cos60->cmp->evaluate("1/2")->{type}; -# dd $cos60->cmp->evaluate("1/2")->{score}; -# dd $cos60->cmp->evaluate("1/2")->{correct_ans}; -# dd $cos60->cmp->evaluate("1/2")->{student_ans}; +my $ctx = Context('TrigDegrees'); -# is (check_score(Compute("cos(60)"),"sin(30)"),1,"trig degrees: cos(60) = 1/2"); +ok(Value::isContext($ctx), 'trig degrees: check context'); -# 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'; +ok my $cos60 = Compute('cos(60)'), 'Call Compute'; +ok my $eval_cos60 = $cos60->cmp->evaluate('1/2'), 'evalute an answer to cos(60)'; -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'; +is $eval_cos60, hash { + field type => 'Value (Real)'; + field score => 1; + field correct_ans => 'cos(60)'; + field student_ans => 0.5; + field error_flag => U(); + field error_message => DF(); + etc(); +}, q{What does the Compute('cos(60)')->cmp->evaluate('1/2') object look like?}; - my $pi = 4 * atan2(1,1); - is check_score( Compute("cos($pi/3)"), "sin($pi/6)"), 1, 'trig degrees: cos(60) = sin(30)'; -}; +is(check_score($cos60, '1/2'), 1, 'trig degrees: cos(60) = 1/2'); +is(check_score(Compute('cos(60)'), 'sin(30)'), 1, 'trig degrees: cos(60) = 1/2'); +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'; +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'; +is check_score(Compute("cos($main::PI/3)"), "sin($main::PI/6)"), 0, 'trig degrees: cos(pi/3) != sin(pi/6)'; done_testing(); diff --git a/t/lib/Test/PG.pm b/t/lib/Test/PG.pm deleted file mode 100644 index c382a303b8..0000000000 --- a/t/lib/Test/PG.pm +++ /dev/null @@ -1,108 +0,0 @@ -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 fd69c3d5e7..f7633c9426 100644 --- a/t/macros/basicmacros.t +++ b/t/macros/basicmacros.t @@ -1,31 +1,24 @@ -use Test2::V0; - -use HTML::Entities; -use HTML::TagParser; - -use lib 't/lib'; -use Test::PG; +#!/usr/bin/env perl +use Test2::V0 '!E', { E => 'EXISTS' }; -=head1 MathObjects +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; -=cut - - -loadMacros("PGbasicmacros.pl"); +use HTML::Entities; +use HTML::TagParser; -my $name = "myansrule"; -my $named_box = NAMED_ANS_RULE($name); +my $name = NEW_ANS_NAME(); -my $html = HTML::TagParser->new($named_box); +my $html = HTML::TagParser->new(NAMED_ANS_RULE($name)); -my @inputs = $html->getElementsByTagName("input"); -is($inputs[0]->attributes->{id}, $name, "basicmacros: test NAMED_ANS_RULE id attribute"); -is($inputs[0]->attributes->{name}, $name, "basicmacros: test NAMED_ANS_RULE name attribute"); -is($inputs[0]->attributes->{type}, "text", "basicmacros: test NAMED_ANS_RULE type attribute"); -ok(!$inputs[0]->attributes->{value}, "basicmacros: test NAMED_ANS_RULE value attribute"); +my @inputs = $html->getElementsByTagName('input'); +is($inputs[0]->attributes->{id}, $name, 'basicmacros: test NAMED_ANS_RULE id attribute'); +is($inputs[0]->attributes->{name}, $name, 'basicmacros: test NAMED_ANS_RULE name attribute'); +is($inputs[0]->attributes->{type}, 'text', 'basicmacros: test NAMED_ANS_RULE type attribute'); +ok(!$inputs[0]->attributes->{value}, 'basicmacros: test NAMED_ANS_RULE value attribute'); -is($inputs[1]->attributes->{name}, "previous_$name", "basicmacros: test NAMED_ANS_RULE hidden name attribute"); -is($inputs[1]->attributes->{type}, "hidden", "basicmacros: test NAMED_ANS_RULE hidden type attribute"); +is($inputs[1]->attributes->{name}, "previous_$name", 'basicmacros: test NAMED_ANS_RULE hidden name attribute'); +is($inputs[1]->attributes->{type}, 'hidden', 'basicmacros: test NAMED_ANS_RULE hidden type attribute'); done_testing(); diff --git a/t/macros/math_objects_basics.t b/t/macros/math_objects_basics.t index 933199f73a..768d7212d5 100644 --- a/t/macros/math_objects_basics.t +++ b/t/macros/math_objects_basics.t @@ -1,10 +1,4 @@ -use Test2::V0; - -use Parser; - -use lib 't/lib'; -use Test::PG; - +#!/usr/bin/env perl =head1 MathObjects @@ -13,24 +7,26 @@ Try out operations with Infinity. =cut +use Test2::V0 '!E', { E => 'EXISTS' }; -loadMacros("MathObjects.pl"); +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; -Context("Numeric"); +loadMacros('MathObjects.pl'); my ($val1, $val2) = (10, 5); my $obj1 = Compute($val1); my $obj2 = Compute($val2); -my $zero = Compute("0"); -ok my $one = Compute("1"), 'Create a MathObject with Compute'; +my $zero = Compute('0'); +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'; + 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 { @@ -48,32 +44,14 @@ 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'; + 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'); + 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'); }; my $sum = $obj1 + $obj2; @@ -98,5 +76,4 @@ subtest 'check some wrong answers' => sub { 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 37c0ec29d7..67f43863f2 100644 --- a/t/macros/math_objects_more.t +++ b/t/macros/math_objects_more.t @@ -1,37 +1,36 @@ -use Test2::V0; - -use lib 't/lib'; -use Test::PG; - +#!/usr/bin/env perl =head1 MathObjects -Tests pass +Test more MathObject properties and operations. =cut +use Test2::V0 '!E', { E => 'EXISTS' }; -loadMacros("MathObjects.pl"); +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; -my $ctx = Context("Numeric"); +loadMacros('MathObjects.pl'); -ok(Value::isContext($ctx), "math objects: check context"); +my $ctx = Context('Numeric'); -my $f = Compute("x^2"); -my $g = Compute("sin(x)"); +ok(Value::isContext($ctx), 'math objects: check context'); -ok(Value::isFormula($f), "math objects: check for formula"); -is($f->class, "Formula", "math objects: check that the class is Formula"); -is($f->type, "Number", "math objects: check that the type is Number"); +my $f = Compute('x^2'); +my $g = Compute('sin(x)'); -## check answer evaluators +ok(Value::isFormula($f), 'math objects: check for formula'); +is($f->class, 'Formula', 'math objects: check that the class is Formula'); +is($f->type, 'Number', 'math objects: check that the type is Number'); -is(check_score($f->eval(x => 2), "4"), 1, "math objects: eval x^2 at x=2"); -is(check_score($f->eval(x => -3), "9"), 1, "math objects: eval x^2 at x=-3"); -# is(check_score($g->eval(x=>Compute("pi/6")),"1/2"),1,"math objects: eval sin(x) at x=pi/6"); +# check answer evaluators +is(check_score($f->eval(x => 2), '4'), 1, 'math objects: eval x^2 at x=2'); +is(check_score($f->eval(x => -3), '9'), 1, 'math objects: eval x^2 at x=-3'); +is(check_score($g->eval(x => 'pi/6'), '1/2'), 1, 'math objects: eval sin(x) at x=pi/6'); -## check derivatives -is(check_score($f->D("x"), "2x"), 1, "math objects: derivative of x^2"); -is(check_score($g->D("x"), "cos(x)"), 1, "math objects: derivative of sin(x)"); +# check derivatives +is(check_score($f->D('x'), '2x'), 1, 'math objects: derivative of x^2'); +is(check_score($g->D('x'), 'cos(x)'), 1, 'math objects: derivative of sin(x)'); done_testing(); diff --git a/t/macros/pgaux.t b/t/macros/pgaux.t index 34bec6aeb7..399de39e67 100644 --- a/t/macros/pgaux.t +++ b/t/macros/pgaux.t @@ -1,17 +1,17 @@ -use Test2::V0; - -use lib 't/lib'; -use Test::PG; - +#!/usr/bin/env perl =head1 PGauxiliaryFunctions -Tests pass +Test methods in PGauxiliaryFunctions. =cut +use Test2::V0 '!E', { E => 'EXISTS' }; + +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; -loadMacros("PGauxiliaryFunctions.pl"); +loadMacros('PGauxiliaryFunctions.pl'); # test step functions @@ -51,7 +51,7 @@ is(round(-0.95), -1, "round: fractional part > 0.5 and negative"); is(round(-0.45), 0, "round: fractional part < 0.5 and negative"); is(round(-0.5), -1, "round: fractional part = 0.5 and negative"); -## Round function which takes a second number, the number of digits to round to +# Round function which takes a second number, the number of digits to round to is(Round(1.793, 2), 1.79, "Round to 2 digits: test 1"); is(Round(1.797, 2), 1.80, "Round to 2 digits: test 2"); @@ -62,25 +62,25 @@ is(Round(-1.795, 2), -1.80, "Round to 2 digits: test 3"); is(Round(15.793, -1), 20, "Round to -1 digits (nearest 10)"); -## lcm +# lcm is(lcm(20, 30), 60, "lcm: non relatively prime numbers"); is(lcm(5, 6), 30, "lcm: relatively prime numbers"); is(lcm(2, 3, 4), 12, "lcm: 3 numbers"); is(lcm(2, 3, 4, 5, 6, 7, 8), 840, "lcm: 7 numbers"); -## gcd +# gcd is(gcd(16, 8), 8, "gcd: 2 powers of 2"); is(gcd(10, 9), 1, "gcd: 2 relatively prime"); is(gcd(10, 20, 30, 40), 10, "gcd: 4 multiples of 10"); -## isPrime +# isPrime is(isPrime(7), 1, "isPrime: 7 is prime"); is(isPrime(2), 1, "isPrime: 2 is prime"); is(isPrime(15), 0, "isPrime: 15 is not prime"); -## random_coprime +# random_coprime my $sum = 0; for my $i (1 .. 100) { @@ -107,8 +107,8 @@ for my $i (1 .. 100) { } is($sum1 + $sum2 + $sum3 + $sum4, 400, "random_pairwise_coprime: 100 tests of [-9..-1,1..9],[1..9],[1..9]"); -## reduce -## it would be nicer to directly compare the arrays +# reduce +# it would be nicer to directly compare the arrays my @my_arr = (3, 4); my @res = reduce(15, 20); is($my_arr[0], $res[0], "reduce: correct numerator"); diff --git a/t/macros/tableau.t b/t/macros/tableau.t index b09da818f4..ac7ae7b514 100644 --- a/t/macros/tableau.t +++ b/t/macros/tableau.t @@ -1,13 +1,4 @@ -use Test2::V0; - -use Class::Accessor; -use Parser; -use PGcore; -use Value; - -use lib 't/lib'; -use Test::PG; - +#!/usr/bin/env perl =head1 Tableau @@ -33,12 +24,20 @@ a reliable test) =cut +use Test2::V0 '!E', { E => 'EXISTS' }; + +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; + +use lib "$ENV{PG_ROOT}/lib"; + +use Class::Accessor; +use Value; loadMacros('tableau.pl', 'Value.pl'); #gives us Real() etc. my %context = (); - sub Context { Parser::Context->current(\%context, @_) } unless (%context && $context{current}) { # ^variable our %context @@ -54,7 +53,6 @@ Context()->flags->set( zeroLevelTol => 1E-5 ); - my $A = Real(.0000005); my $B = Real(0); @@ -63,7 +61,7 @@ subtest 'test zeroLevel tolerance' => sub { ok($A == $B, 'test zeroLevel tolerance with ok'); my $real_object = object { - prop isa => 'Value::Real'; + prop blessed => 'Value::Real'; field data => array { item 0 => match qr/\d/; }; field context => D(); @@ -110,8 +108,8 @@ my $tableau1 = Tableau->new(A => $a, b => $b, c => $c); ############################################################### subtest 'Check mutators' => sub { - is $tableau1, D(), 'tableau has been defined and loaded'; - is $tableau1, object { prop isa => 'Tableau' }, 'has type Tableau'; + is $tableau1, D(), 'tableau has been defined and loaded'; + is $tableau1, object { prop blessed => 'Tableau' }, 'has type Tableau'; }; subtest 'test "close_enough_to_zero" subroutine' => sub { @@ -141,26 +139,24 @@ subtest 'Basic test warmup' => sub { 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'; + is [ $tableau1->{m}, $tableau1->{n} ], [ $tableau1->{A}->dimensions ], '{m},{n} match dimensions of A'; + + is $tableau1, object { + field A => object { + prop blessed => '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->{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->{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'; @@ -180,7 +176,7 @@ subtest 'Current constraint matrix' => sub { 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'; + is [ $tableau1->current_b->dimensions ], [ 2, 1 ], 'dimensions of current_b'; }; subtest 'Objective row properties' => sub { @@ -190,40 +186,35 @@ subtest 'Objective row properties' => sub { 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], + 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'; + is $tableau1->{obj_row}, object { prop blessed => 'Value::Matrix' }, '->{obj_row} has type Value::Matrix'; + is $tableau1->obj_row, object { prop blessed => '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->current_tableau, object { prop blessed => '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 blessed => '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 $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'; }; @@ -233,7 +224,7 @@ my $compare_data = sub { my %params = @_; # postfix dereferencing stable in perl 5.24 - my ($g, $e) = map { ref $_ =~ /Value/ ? $_->copy : $_ } @{$params{got}}; + my ($g, $e) = map { ref $_ =~ /Value/ ? $_->copy : $_ } @{ $params{got} }; my ($got, $exp); $got = ref $g eq 'Value::Matrix' ? $g->string : stringify($g); @@ -243,34 +234,29 @@ my $compare_data = sub { }; 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->obj_row, $tableau1->{obj_row} ], validator($compare_data), 'verify mutator for {obj_row}'; - is [ $tableau1->objective_row, [$tableau1->obj_row->value] ], - validator( $compare_data ), + 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->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'; + 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->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)), @@ -292,22 +278,16 @@ subtest 'find basis column index corresponding to row index' => sub { $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)'; + 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) }, + 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. @@ -317,8 +297,7 @@ subtest 'find basis column index corresponding to row index' => sub { "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)'; + 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/, @@ -331,10 +310,8 @@ subtest 'find another basis (2,3)' => sub { 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] '; + 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) }, @@ -347,10 +324,8 @@ subtest 'find another basis (2,3)' => sub { "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)'; + 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 { @@ -368,11 +343,10 @@ subtest 'find next short cut pivots' => sub { $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_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_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); @@ -386,7 +360,7 @@ subtest 'find next short cut pivots' => sub { ); 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_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); @@ -402,7 +376,7 @@ subtest 'find next short cut pivots' => sub { 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_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 @@ -429,12 +403,10 @@ subtest 'reset tableau to feasible point and try to minimize it for phase2' => s '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->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 @@ -449,13 +421,10 @@ subtest 'reset tableau to feasible point and try to minimize it for phase2' => s # diag(join(q{ } , @{$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}) - ); + return sprintf("[%s]", join(',', map { my $s = $_; ref $s eq 'ARRAY' ? stringify($s) : $s } @{$arrayref})); } diff --git a/t/math_objects/factorial.t b/t/math_objects/factorial.t index 194397821d..cb8442d70c 100644 --- a/t/math_objects/factorial.t +++ b/t/math_objects/factorial.t @@ -1,21 +1,21 @@ -use Test2::V0; - -use lib 't/lib'; -use Test::PG; - +#!/usr/bin/env perl =head1 MathObjects - factorial -Tests pass +Test factorials. =cut +use Test2::V0 '!E', { E => 'EXISTS' }; + +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; loadMacros('MathObjects.pl'); Context('Numeric'); -Context()->variables->add(y => "Real"); # unused -Context()->variables->add(n => "Real"); +Context()->variables->add(y => 'Real'); # unused +Context()->variables->add(n => 'Real'); my $five_fact = Compute('5!'); @@ -28,42 +28,41 @@ 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'; +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!'; + 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.'; +ok Compute('170!') > 1e+306, 'factorial: 170! is large but not infinite.'; subtest 'Tests for throwing exceptions' => sub { like( - dies { Compute("(-1)!") }, + 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!") }, + 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.'; + 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'); + my $inf = Compute('inf'); - is $large_fact->value, "$inf", '171! is infinite.'; # stringify $inf to make the comparison + is $large_fact->value, $inf->string, '171! is infinite.'; # stringify $inf to make the comparison ok $large_fact->{isInfinite}, 'object attribute for infinity is set'; }; diff --git a/t/units/basic_module.t b/t/units/basic_module.t index 0ad70fe095..2ee84c6716 100644 --- a/t/units/basic_module.t +++ b/t/units/basic_module.t @@ -1,24 +1,26 @@ -use Test2::V0; +#!/usr/bin/env perl + +use Test2::V0 '!E', { E => 'EXISTS' }; + +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; + +use lib "$ENV{PG_ROOT}/lib"; use Units; # get unit hashes -my %joule = evaluate_units('J'); -my %newton_metre = evaluate_units('N*m'); +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'; - +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"; - +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 index 8fb3bc661a..f7b9381448 100644 --- a/t/units/basic_parser.t +++ b/t/units/basic_parser.t @@ -1,44 +1,10 @@ -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"); - +#!/usr/bin/env perl =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 +Test the basic functionality of the NumberWithUnits parser, +F, to demonstrate that the parser and its +methods are working. =head2 TODO list @@ -56,147 +22,165 @@ See the example in the documentation of L =cut +use Test2::V0 '!E', { E => 'EXISTS' }; +use Scalar::Util qw(blessed); -# 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'); +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +do "$ENV{PG_ROOT}/t/build_PG_envir.pl"; + +use lib "$ENV{PG_ROOT}/lib"; +use Parser::Legacy::NumberWithUnits; +use Units; + +loadMacros("parserNumberWithUnits.pl"); + +Context("Numeric"); + +# define some basic objects +my $joule = NumberWithUnits(1, 'J'); +my $Nm = NumberWithUnits(1, 'N*m'); +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'; + 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, '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' -); + 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 $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'); + 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" - ); + 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 $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'; + 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'; + 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->splitUnits ], [ '1', 'J' ], 'splitUnits creates an array'; - is $joule->adjustCorrectValue, 0, 'What is adjustCorrectValue?'; + 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'; - }; + 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'; + # 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'; +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'; + # 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 index 03b667f0f1..e310142640 100644 --- a/t/units/electron_volts.t +++ b/t/units/electron_volts.t @@ -1,30 +1,33 @@ -use Test2::V0; +#!/usr/bin/env perl + +use Test2::V0 '!E', { E => 'EXISTS' }; + +die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT}; +use lib "$ENV{PG_ROOT}/lib"; use Units; -my %joule = evaluate_units('J'); +my %joule = evaluate_units('J'); my %newton_metre = evaluate_units('N*m'); -my %base_units = evaluate_units('kg*m^2/s^2'); +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'; +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 + my ($value, $unit) = @_; + my $new_unit = {%$unit}; # shallow copy hash values - $new_unit->{factor} *= $value; + $new_unit->{factor} *= $value; - return $new_unit; + return $new_unit; }