vcs.maemo.org Git - pkg-perl/blob - deb-src/libwww-mechanize-perl/libwww-mechanize-perl-1.34/t/area_link.t

   1 #!perl -Tw
   2 # WWW::Mechanize tests for <area> tags
   3
   4 use warnings;
   5 use strict;
   6 use Test::More tests => 9;
   7 use URI::file;
   8
   9 BEGIN { delete @ENV{ qw( http_proxy HTTP_PROXY PATH IFS CDPATH ENV BASH_ENV) }; }
  10 BEGIN {
  11     use_ok( 'WWW::Mechanize' );
  12 }
  13
  14 eval 'use Test::Memory::Cycle';
  15 my $canTMC = !$@;
  16
  17 my $mech = WWW::Mechanize->new( cookie_jar => undef );
  18 isa_ok( $mech, 'WWW::Mechanize' );
  19
  20 my $uri = URI::file->new_abs( 't/area_link.html' );
  21 $mech->get( $uri );
  22 ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
  23
  24
  25 AREA_CHECKS: {
  26     my @wanted_links = (
  27         [ 'http://www.msnbc.com/area', undef, undef, 'area', {
  28             coords => '1,2,3,4',
  29             href => 'http://www.msnbc.com/area'
  30         } ],
  31         [ 'http://www.cnn.com/area', undef, undef, 'area', {
  32             coords => '5,6,7,8',
  33             href => 'http://www.cnn.com/area'
  34         } ],
  35         [ 'http://www.cpan.org/area', undef, undef, 'area', {
  36              '/' => '/',
  37              coords => '10,11,12,13',
  38              href => 'http://www.cpan.org/area'
  39         }  ],
  40         [ 'http://www.slashdot.org', undef, undef, 'area', {
  41              href => 'http://www.slashdot.org'
  42         } ],
  43         [ 'http://mark.stosberg.com', undef, undef, 'area', {
  44             alt => q{Mark Stosberg's homepage},
  45             href => 'http://mark.stosberg.com'
  46         } ],
  47     );
  48     my @links = $mech->find_all_links();
  49
  50     # Skip the 'base' field for now
  51     for (@links) {
  52         my $attrs = $_->[5];
  53         @{$_} = @{$_}[0..3];
  54         push @{$_}, $attrs;
  55     }
  56
  57     is_deeply( \@links, \@wanted_links, 'Correct links came back' );
  58
  59     my $linkref = $mech->find_all_links();
  60     is_deeply( $linkref, \@wanted_links, 'Correct links came back' );
  61
  62     SKIP: {
  63         skip 'Test::Memory::Cycle not installed', 2 unless $canTMC;
  64         memory_cycle_ok( \@links, 'Link list: no cycles' );
  65         memory_cycle_ok( $linkref, 'Single link: no cycles' );
  66     }
  67 }
  68
  69 SKIP: {
  70     skip 'Test::Memory::Cycle not installed', 2 unless $canTMC;
  71
  72     memory_cycle_ok( $uri, 'URI: no cycles' );
  73     memory_cycle_ok( $mech, 'Mech: no cycles' );
  74 }