#!perl # ~~~ We still need a complete test suite.... Probably a class provided by # the JS plugin that allows any back end to run the same tests.... use strict; use warnings; use lib 't'; use Test::More; use HTML::DOM::Interface ':all'; use URI::file; use WWW::Scripter 0.016; # event2sub and $@ # blank page for playing with JS; some tests need their own, though my $js = (my $m = new WWW::Scripter)->use_plugin('JavaScript', engine => 'SpiderMonkey' ); $m->get(URI::file->new_abs( 't/blank.html' )); $js->new_function($_ => \&$_) for qw 'is ok'; use tests 1; # types of bound read-only properties { #warn $m->eval('String(document.__proto__)'); is $m->plugin('JavaScript')->eval( $m, 'typeof document.nodeType' ), 'number', 'types of bound read-only properties'; } use tests 1; # values passed back and forth { sub Foo::Bar::baz{ return join ',', map ref||(defined()?$_:'^^'),@_ }; $js->bind_classes({ 'Foo::Bar' => 'Bar', Bar => { baz => METHOD | STR } }); $js->set($m, 'baz', bless[], 'Foo::Bar'); is($js->eval($m, 'baz.baz(null, undefined, 3, "4", baz)'), 'Foo::Bar,^^,^^,3,4,Foo::Bar', 'passing objects'); } use tests 4; # null DOMString { sub Phoo::Bar::bar { return (undef,765)[!!pop]; } sub Phoo::Bar::baz { "heelo" } sub Phoo::Bar::nullbaz {} $js->bind_classes({ 'Phoo::Bar' => 'Phoo', Phoo => { bar => METHOD | STR, baz => STR, nullbaz => STR, } }); $js->set($m, 'baz', bless[], 'Phoo::Bar'); ok($js->eval($m, 'baz.bar(0) === null'), 'undef --> null conversion for a DOMString retval'); ok($js->eval($m, 'baz.bar(1) === "765"'), 'any --> string conversion for a DOMString retval'); ok($js->eval($m, 'baz.nullbaz === null'), 'undef --> null conversion when getting a DOMString prop'); ok($js->eval($m, 'baz.baz === "heelo"'), 'any --> string conversion when getting a DOMString prop'); } use tests 2; # window wrappers SKIP:{ skip "doesn’t work yet" ,2; ok $js->eval($m, 'window === top'), 'windows are wrapped up in global objects'; ok $js->eval($m, 'window === document.defaultView'), 'window === document.defaultView'; } use tests 3; # frames SKIP:{ skip "doesn’t work yet" ,3; $m->eval(q| document.write("<iframe id=i src='data:text/html,'>") document.close() |); ok $m->eval('frames[0] && "document" in frames[0] && frames[0].document.defaultView == frames[0]'), 'frame access by array index', or diag $@; ok $m->eval('frames.i && "document" in frames.i'), 'frame access by name'; ok $m->eval('frames.i === frames[0]'), 'the two methods return the same object'; } use tests 1; # syntax errors in HTML event attributes { my $w; local $SIG{__WARN__} = sub { $w = shift }; $m->get('data:text/html,<body onload="a b">'); ok $w, "syntax errors in HTML event attributes are turned into warninsg"; }