Test-JavaScript000755 001751 001751 00000000000 10426500410 014572 5ustar00kevinjkevinj000000 000000 Test-JavaScript/lib000755 001751 001751 00000000000 10417315513 015350 5ustar00kevinjkevinj000000 000000 Test-JavaScript/lib/Test000755 001751 001751 00000000000 10421535216 016266 5ustar00kevinjkevinj000000 000000 Test-JavaScript/lib/Test/JavaScript.pm000644 001751 001751 00000007734 10421535216 020764 0ustar00kevinjkevinj000000 000000 package Test::JavaScript; =head1 NAME Test::JavaScript - JavaScript Testing Module =head1 SYNOPSIS use Test::JavaScript qw(no_plan); use_ok("/path/to/MyFile.js"); ok("var obj = new MyFile", "Create a MyFile object"); ok("obj.someFunction = function () { return 'ok' }"); is("obj.someFunction()", "ok"); =head1 DESCRIPTION Test::JavaScript provides a method of unit testing javascript code from within perl. This module uses the JavaScript::SpiderMonkey package to evaluate JavaScript using the SpiderMonkey JavaScript engine. =cut use strict 'vars'; use warnings; use Exporter; use Carp qw(croak); use Test::Builder; my $Test = Test::Builder->new; use JavaScript::SpiderMonkey; my $js = JavaScript::SpiderMonkey->new(); $js->init(); $js->eval("var test_js = new Object;"); our @ISA = qw(Exporter); our @EXPORT = qw(ok use_ok is isnt); $js->function_set("ok", sub { $Test->ok(@_) }); $js->function_set("is", sub { $Test->is_eq(@_) }); $js->function_set("isnt", sub { $Test->isnt_eq(@_) }); $js->function_set("warn", sub { warn @_ }); return 1; END { $js->destroy }; sub no_ending { $Test->no_ending(@_) } sub import { my $self = shift; my $caller = caller; for my $f (@EXPORT) { *{$caller.'::'.$f} = \&$f; } $Test->exported_to($caller); $Test->plan(@_); } sub try_eval { my ($code, $name) = @_; my $rc = $js->eval($code); unless ($rc) { my $ok = $Test->ok( !$@, $name ); $Test->diag(< use_ok($filename) This reads a file and evals it in JavaScript For example: use_ok( "/path/to/some/file.js" ); =cut sub use_ok ($;@) { my $filename = shift || croak "filename required"; croak "$filename doesn't exist" unless $filename; open my $fh, $filename or die "Couldn't read $filename: $!"; my @lines = <$fh>; close $fh or die "Couldn't read $filename: $!"; my $rc = $js->eval(join("\n", @lines)); my $ok = $Test->ok( !$@, "use $filename;" ); unless( $rc ) { $Test->diag(< =item B is ( $this, $that, $test_name ); isnt( $this, $that, $test_name ); This compares two values in JavaScript land. They can be literal strings passed from perl or variables defined earlier. For example: ok("var i = 3"); // ok is("i", 3, "i is 3"); // ok is("3", 3, "3 is 3"); // ok is("3", 2, "3 is 2"); // not ok ok("function three () { return 3 }"); // ok is("three()", 3); // ok is("three()", 4); // not ok isnt("3", 4, "3 is not 4"); // ok =cut sub is { my ($test,$actual,$ename,$name) = escape_args(@_); my $code = < ok("var monkey = 3", $test_name); The expression passed as the first parameter is evaluated as either true or false. The test fails if the expression explicitly returns false, or if a syntax error occurs in JavaScript land For example: ok("var i = 3"); // ok ok("true", "true is true"); // ok ok("1 == 2", "1 is equal to 2"); // not ok ok("false", "false is false"); // not ok ok("var array = ['one','two',non_existing_var];") // not ok =cut sub ok { my ($test,$ename,$name) = escape_args(@_); my $lines = join"\n", map { "code.push('$_');" } split("\n", $test); my $code = <} try_eval($code, $name);EOTisnt( $test, '$actual', '$ename'.replace(/\\'/,"'")); my $code = <=item B} }DIAGNOSTIC $@ Tried to use '$filename'. $Test->diag(<ok( !$@, "use $filename;" ); my $rc = $js->eval(join("\n", @lines)); close $fh or die "Couldn't read $filename: $!"; my @lines = <$fh>; open my $fh, $filename or die "Couldn't read $filename: $!"; croak "$filename doesn't exist" unless $filename; my $filename = shift || croak "filename required";sub use_ok ($;@) {=cut use_ok( "/path/to/some/file.js" );For example:This reads a file and evals it in JavaScript use_ok($filename)=item B} return (@args,$escaped,$name); (my $escaped = $name) =~ s/'/\\'/g; s/'/\\'/g foreach @args; $args[0] = $name and $name = '' unless @args; my @args = @_; my $name = pop @_;sub escape_args {} } $@ = '';DIAGNOSTIC $@ $Test->diag(<ok( !$@, $name ); unless ($rc) { my $rc = $js->eval($code); my ($code, $name) = @_;sub try_eval {} $Test->plan(@_); $Test->exported_to($caller); } *{$caller.'::'.$f} = \&$f; for my $f (@EXPORT) { my $caller = caller; my $self = shift;sub import {sub no_ending { $Test->no_ending(@_) }END { $js->destroy };return 1;$js->function_set("warn", sub { warn @_ });$js->function_set("isnt", sub { $Test->isnt_eq(@_) });$js->function_set("is", sub { $Test->is_eq(@_) });$js->function_set("ok", sub { $Test->ok(@_) });our @EXPORT = qw(ok use_ok is isnt);our @ISA = qw(Exporter);$js->eval("var test_js = new Object;");$js->init();my $js = JavaScript::SpiderMonkey->new();use JavaScript::SpiderMonkey;my $Test = Test::Builder->new;use Test::Builder;use Carp qw(croak);use Exporter;use warnings;use strict 'vars';=cutJavaScript using the SpiderMonkey JavaScript engine.perl. This module uses the JavaScript::SpiderMonkey package to evaluateTest::JavaScript provides a method of unit testing javascript code from within=head1 DESCRIPTION is("obj.someFunction()", "ok"); ok("obj.someFunction = function () { return 'ok' }"); ok("var obj = new MyFile", "Create a MyFile object"); use_ok("/path/to/MyFile.js"); use Test::JavaScript qw(no_plan);=head1 SYNOPSISTest::JavaScript - JavaScript Testing Module=head1 NAMEpackage Test::JavaScript;ad [ a8Y  { z ^ \ [ d } try_eval($code, $name);EOTok( result, '$ename'.replace(/\\'/,"'"));var result = eval(code.join("\\n")) ? true : false;$linesvar code = new Array; my $code = < 'all'); use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Test-JavaScript', VERSION => '0.01', AUTHOR => 'Kevin Jones', ABSTRACT => 'JavaScript unit testing', PREREQ_PM => { JavaScript::SpiderMonkey => 0, Test::Simple => 0, }, clean => { FILES => '*.ppd *.tar.gz' }, ); Test-JavaScript/t000755 001751 001751 00000000000 10424241424 015042 5ustar00kevinjkevinj000000 000000 Test-JavaScript/t/fail.t000755 001751 001751 00000006024 10421533700 016224 0ustar00kevinjkevinj000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::JavaScript qw(no_plan); Test::JavaScript::no_ending(1); use lib "t/lib"; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); local $ENV{HARNESS_ACTIVE} = 0; require Test::Builder; my $TB = Test::Builder->create; $TB->plan(tests => 21); sub main::err_ok ($) { my($expect) = @_; my $got = $err->read; my ($comment) = split "\n", $got; return $TB->is_eq( $got, $expect, $got ); } sub main::out_ok ($) { my($expect) = @_; my $got = $out->read; my ($comment) = split "\n", $got; return $TB->is_eq( $got, $expect, $comment ); } my @temp; END { unlink @temp or die "Couldn't unlink @temp\n"; }; my $test = 1; sub pass { my ($f,@args) = @_; my $comment = $args[-1]; $f->(@args); out_ok(<read; $test++; } sub fail { my ($f,@args) = @_; my $comment = $args[-1]; $f->(@args); out_ok(<read; $test++; } sub tempfile { my $data = shift || die "data required"; my $fn = "tempfile-$$-".@temp; push @temp, $fn; open my $fh, ">$fn" or die "Couldn't write to $fn"; print $fh $data; close $fh or die "Couldn't write to $fn"; return $fn; } sub comment { my $cmd = shift; my ($rv) = split("\n", $cmd); return $rv; } ########## # use_ok # ########## my $valid = tempfile(<new; $t->output($out_fh); $t->failure_output($err_fh); $t->todo_output($err_fh); sub caught { return($out, $err) } 1; Test-JavaScript/t/lib/TieOut.pm000644 001751 001751 00000000543 10420746765 017456 0ustar00kevinjkevinj000000 000000 package TieOut; sub TIEHANDLE { my $scalar = ''; bless( \$scalar, $_[0]); } sub PRINT { my $self = shift; $$self .= join('', @_); } sub PRINTF { my $self = shift; my $fmt = shift; $$self .= sprintf $fmt, @_; } sub FILENO {} sub read { my $self = shift; my $data = $$self; $$self = ''; return $data; } 1; Test-JavaScript/t/no_plan.t000644 001751 001751 00000000134 10420764075 016742 0ustar00kevinjkevinj000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::JavaScript qw(no_plan); ok(1); ok(1); Test-JavaScript/t/plan.t000644 001751 001751 00000000133 10420764041 016236 0ustar00kevinjkevinj000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::JavaScript tests => 2; ok(1); ok(1); Test-JavaScript/t/samp_validator.t000644 001751 001751 00000002253 10421533537 020323 0ustar00kevinjkevinj000000 000000 #!/usr/bin/perl use strict; use warnings; use Test::JavaScript tests => 15; my $class_dec = <