The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

ADAMK / HTML-Location-1.03 / t / 02_main.t 

            

              
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

              
#!/usr/bin/perl 
# Load test the HTML::Location module
use strict;
BEGIN {
        $|  = 1;
        $^W = 1;
}
use Test::More tests => 128;
use File::Spec::Functions ':ALL';
use Scalar::Util 'refaddr';
use HTML::Location ();
# Precompute the required paths
my $path1 = catdir(  rootdir(), 'foo'                   );
my $path2 = catdir(  rootdir(), 'foo2'                  );
my $path3 = catfile( rootdir(), 'foo', 'foo', 'bar.txt' );
my $path4 = catdir(  rootdir(), 'foo', 'foo', 'bar'     );
#####################################################################
# Construction
# Create a basic test location
my $location = HTML::Location->new( $path1, 'http://foo.com' );
is_normal_location( $location );
is( $location->path, $path1, '->path gives expected value' );
is( $location->uri, 'http://foo.com/', '->uri returns expected value' );
isa_ok( $location->URI, 'URI' );
isa_ok( $location->__as_URI, 'URI' );
# Test equality and overload
my $location2 = HTML::Location->new( $path1,  'http://foo.com'  );
my $location3 = HTML::Location->new( $path2, 'http://foo.com'   );
my $location4 = HTML::Location->new( $path1,  'http://foo2.com' );
is( ($location->__eq($location2)), 1,  '->__eq returns true correctly'  );
is( ($location->__eq($location3)), '', '->__eq returns false correctly' );
is( ($location->__eq($location4)), '', '->__eq returns false correctly' );
is( ($location->__eq(undef)), '',      '->__eq returns false correctly' );
is( ($location->__eq()), '',           '->__eq returns false correctly' );
is( ($location eq $location2), 1,      'eq returns true correctly'      );
is( ($location eq $location3), '',     'eq returns false correctly'     );
is( ($location eq $location4), '',     'eq returns false correctly'     );
is( ($location eq undef), '',          'eq returns false correctly'     );
is( ($location2 eq $location), 1,      'eq returns true correctly'      );
is( ($location3 eq $location), '',     'eq returns false correctly'     );
is( ($location4 eq $location), '',     'eq returns false correctly'     );
is( (undef eq $location), '',          'eq returns false correctly'     );
is( $location, $location,              'Two locations match'            );
my $clone = $location->clone;
is_normal_location( $clone );
is( $clone->path, $path1, '->path gives expected value' );
is( $clone->uri, 'http://foo.com/', '->uri returns expected value' );
isnt( refaddr($clone), refaddr($location), 'Clone is different to original' );
# Test ->params for the equivalent values
my $param1 = HTML::Location->param( $location );
isa_ok( $param1, 'HTML::Location' );
is( refaddr($param1), refaddr($location), '->param(Location) returns the same location' );
is_deeply( $param1, $location, 'Locations match' );
my $param2 = HTML::Location->param( $path1, 'http://foo.com' );
isa_ok( $param2, 'HTML::Location' );
is_deeply( $param2, $location, 'Locations match' );
my $param3 = HTML::Location->param( [ $path1, 'http://foo.com' ] );
isa_ok( $param3, 'HTML::Location' );
is_deeply( $param3, $location, 'Locations match' );
# Do a basic file addition
my $file = $location->catfile( 'foo', 'bar.txt' );
is_normal_location( $file );
isnt( refaddr($location), refaddr($file), '->catfile returns a new object' );
is( $file->path, $path3, '->path gives expected value' );
is( $file->uri, 'http://foo.com/foo/bar.txt', '->uri returns expected value' );
# Has the method call changed the original object?
is_normal_location( $location );
is( $location->path, $path1, '->path gives expected value' );
is( $location->uri, 'http://foo.com/', '->uri returns expected value' );
# Do a basic directory addition
my $dir = $location->catdir( 'foo', 'bar' );
is_normal_location( $file );
isnt( refaddr($location), refaddr($dir), '->catfile returns a new object' );
is( $dir->path, $path4, '->path gives expected value' );
is( $dir->uri, 'http://foo.com/foo/bar', '->uri returns expected value' );
# Has the method call changed the original object?
is_normal_location( $location );
is( $location->path, $path1, '->path gives expected value' );
is( $location->uri, 'http://foo.com/', '->uri returns expected value' );
exit();
# Do a series of basic checks on a location
sub is_normal_location {
        my $object = shift;
        ok(     defined $object, '->new returns defined' );
        ok(     $object, '->new returns true' );
        isa_ok( $object, 'HTML::Location' );
        ok(     defined $object->path, '->path returns defined' );
        ok(     ! ref $object->path, "->path doesn't return a reference" );
        ok(     length $object->path, "->path doesn't return a zero length string" );
        ok(     defined $object->URI, "->URI returns defined" );
        ok(     ref $object->URI, "->URI returns a reference" );
        isa_ok( $object->URI, 'URI' );
        isnt(   refaddr($object->URI), refaddr($object->URI), '->URI returns a clone' );
        ok(     defined $object->uri, '->uri returns defined' );
        ok(     ! ref $object->uri, "->uri doesn't return a reference" );
        ok(     length $object->uri, "->uri doesn't return a null string" );
        ok(     length "$object", "Location stringifies to a non-null string" );
        is(     $object->uri, "$object", "Location stringifies to the ->uri value" );
}
1;