From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

TMUELLER / HTTP-Exception-0.04007 / t / 01-exceptions.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

              
use strict;
use Test::Exception;
use Test::More;
use HTTP::Exception;
use HTTP::Status;
my @exception_class_classes = Exception::Class::Classes();
my %exception_class_classes;
@exception_class_classes{@exception_class_classes} = undef;
################################################################################
# HTTP::Exception Tests
ok  exists $exception_class_classes{'HTTP::Exception'}, 'HTTP::Exception acts as loader and exception';
throws_ok sub { HTTP::Exception->throw(200) },  'HTTP::Exception::200';
throws_ok sub { HTTP::Exception->throw },       qr/HTTP::Exception->throw needs a HTTP-Statuscode to throw/;
throws_ok sub { HTTP::Exception->throw(1) },    qr/Unknown HTTP-Statuscode:/;
eval { HTTP::Exception->throw };
my $e0 = HTTP::Exception->caught;
ok (!defined $e0, 'HTTP::Exception is not caught when no Errorcode is given');
eval { HTTP::Exception->throw(1) };
my $e00 = HTTP::Exception->caught;
ok (!defined $e00, 'HTTP::Exception is not caught when wrong Errorcode is given');
my $e2 = HTTP::Exception->new(200);
__PACKAGE__->_run_tests_for_exception_object($e2);
delete $exception_class_classes{'HTTP::Exception'}; # got a special treatment
################################################################################
# HTTP::Exception::... Tests
for my $exception_name (keys %exception_class_classes) {
    # testing whether throw works
    throws_ok sub { $exception_name->throw }, $exception_name;
    # testing whether new works
    my $e = $exception_name->new;
    isa_ok  $e, $exception_name;
    __PACKAGE__->_run_tests_for_exception_object($e);
    # testing whether catching via HTTP::Exception works
    eval { $exception_name->throw() };
    my $e1 = HTTP::Exception->caught;
    isa_ok  $e1, $exception_name;
    __PACKAGE__->_run_tests_for_exception_object($e1);
    # testing catch via HTTP::Exception::NXX classes
    # maybe using another tests' result is not so good, but anyways
    my $error_code_range = $e1->code;
    $error_code_range =~ s/\d{2}$/XX/;
    eval { $exception_name->throw() };
    my $e2 = "HTTP::Exception::$error_code_range"->caught;
    __PACKAGE__->_run_tests_for_exception_object($e2);
    # testing whether catching via HTTP::Exception::... works
    eval { $exception_name->throw() };
    my $e3 = $exception_name->caught;
    isa_ok  $e3, $exception_name;
    __PACKAGE__->_run_tests_for_exception_object($e3);
}
################################################################################
# tests sub
sub _run_tests_for_exception_object {
    my $class = shift;
    my $e = shift;
    like    $e->code,
            qr/\d+/,
            'code is a number ('. $e->code .')';
    is      $e->status_message,
            HTTP::Status::status_message($e->code),
            'status_message is same as HTTP::Status';
    is      $e->as_string,
            HTTP::Status::status_message($e->code),
            'to_string as well';
    is      (($e->Fields)[0],
            'status_message',
            'field status_message found');
    can_ok  $e,
            qw(code status_message as_string);
    ok      !$e->can('_make_exceptions'),
            '_make_exceptions is not imported from Loader';
    SKIP: {
        # yes, ugly, I know
        skip q(can't reliably determine expected Errorcode), 2 unless (ref($e) =~ /(\d+)$/);
        is  $e->code,
            $1,
            'Errorcode in Classname and expected HTTP-Errorcode match';
    };
}
done_testing;