1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
use strict;
use warnings;
use Test::More tests => 4;
use LWP::UserAgent ();
use WWW::Mechanize ();
use URI ();
=pod
The monkeypatch introduced since at least WWW::Mechanize 1.34 only
ever allows one instance of every LWP::UserAgent descendant to have
credentials. This test checks that this buggy behaviour is gone.
=cut
my $uri = URI->new('http://localhost');
my $realm = 'myrealm';
my $ua = LWP::UserAgent->new();
$ua->credentials( $uri, $realm, 'user', 'pass' );
my $mech1 = WWW::Mechanize->new();
my $mech2 = WWW::Mechanize->new();
my $mech3 = WWW::Mechanize->new();
$mech1->credentials( 'mech1', 'mech1' );
$mech2->credentials( 'mech2', 'mech2' );
is_deeply(
[ $ua->credentials( $uri, $realm ) ], [ 'user', 'pass' ],
'LWP::UserAgent instance retains its old credentials'
);
is_deeply(
[ $mech1->get_basic_credentials( $realm, $uri ) ],
[ 'mech1', 'mech1' ], 'First instance retains its credentials'
);
is_deeply(
[ $mech2->get_basic_credentials( $realm, $uri ) ],
[ 'mech2', 'mech2' ], 'Second instance retains its credentials'
);
is_deeply(
[ $mech3->get_basic_credentials( $realm, $uri ) ], [],
'Untouched instance retains its credentials'
);
|
