1use Test::More;
2use HTTP::Proxy::Engine;
3
4plan tests => 18;
5
6my $e;
7my $p = bless {}, "HTTP::Proxy";
8
9$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy );
10isa_ok( $e, 'HTTP::Proxy::Engine::Legacy' );
11
12# use the default engine for $^O
13eval { HTTP::Proxy::Engine->new() };
14isa_ok( $e, 'HTTP::Proxy::Engine' );
15
16eval { HTTP::Proxy::Engine->new( engine => Legacy ) };
17like( $@, qr/^No proxy defined/, "proxy required" );
18
19eval { HTTP::Proxy::Engine->new( proxy => "P", engine => Legacy ) };
20like( $@, qr/^P is not a HTTP::Proxy object/, "REAL proxy required" );
21
22# direct engine creation
23# HTTP::Proxy::Engine::Legacy was required before
24$e = HTTP::Proxy::Engine::Legacy->new( proxy => $p );
25isa_ok( $e, 'HTTP::Proxy::Engine::Legacy' );
26
27eval { HTTP::Proxy::Engine::Legacy->new() };
28like( $@, qr/^No proxy defined/, "proxy required" );
29
30eval { HTTP::Proxy::Engine::Legacy->new( proxy => "P" ) };
31like( $@, qr/^P is not a HTTP::Proxy object/, "REAL proxy required" );
32
33# non-existent engine
34eval { HTTP::Proxy::Engine->new( proxy => $p, engine => Bonk ) };
35like(
36    $@,
37    qr/^Can't locate HTTP.+?Proxy.+?Engine.+?Bonk\.pm in \@INC/,
38    "Engine Bonk does not exist"
39);
40
41# check the base accessor
42$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy );
43is( $e->proxy, $p, "proxy() get" );
44
45# check subclasses accessors
46$e = HTTP::Proxy::Engine->new( proxy => $p, engine => Legacy, select => 2 );
47is( $e->select,    2, "subclass get()" );
48is( $e->select(4), 4, "subclass set()" );
49is( $e->select,    4, "subclass get()" );
50
51$e = HTTP::Proxy::Engine::Legacy->new( proxy => $p, select => 3 );
52is( $e->select,    3, "subclass get()" );
53is( $e->select(4), 4, "subclass set()" );
54is( $e->select,    4, "subclass get()" );
55
56# but where is the code?
57is( *{HTTP::Proxy::Engine::select}{CODE},
58    undef, "code not in the base class" );
59is( ref *{HTTP::Proxy::Engine::select}{CODE},
60    '', "code not in the base class" );
61my $c = \&HTTP::Proxy::Engine::Legacy::select; # remove "used only once" warning
62is( ref *{HTTP::Proxy::Engine::Legacy::select}{CODE},
63    'CODE', "code in the subclass" );
64