1#!/usr/bin/perl
2use strict;
3use warnings;
4use Test::More;
5
6# in each class/package constructed in this test script, we want to essentially
7# perform the same set of tests, just with slightly different parameters.
8sub do_common_subtests {
9    my %opt = @_;
10    my $class = $opt{class} || scalar caller;
11    subtest $opt{desc} => sub {
12        is $class->name,        $class,     'works in class method call';
13        my $obj = new_ok        $class, [], 'works in constructor';
14        isa_ok $obj->self,      $class,     'works in object method call';
15        isa_ok $obj->specified, $class,     'invocant specified in signature still works';
16        done_testing;
17    };
18}
19
20
21# Below are a series of packages that use MS with various, um, variations
22# on setting the import parameter. Not only do we want to make sure that using
23# the parameter works properly, we also want to ensure it doesn't change
24# existing functionality when it's not being used. We also want to be sure that
25# invalid values cause an exception, but when that happens it still does not
26# break anything for other classes using MS. (hey, it happens)
27
28
29# TODO: Should I generate these test classes? They're so very repetitive.
30#       Can't think of a simple way without string-eval, though...
31{
32    package Foo;
33    use Test::More;
34    use Method::Signatures { invocant => '$foo' };
35
36    method name { return $foo } # call this as a class method.
37    method new { return bless {}, $foo }
38    method self { return $foo }
39    method specified( $fnord: ) { return $fnord }
40
41    main::do_common_subtests(
42        desc => 'use option to specify different default invocant var',
43    );
44}
45
46
47{
48    package Bar;
49    use Test::More;
50    use Method::Signatures { invocant => '$bar' };
51
52    method name { return $bar }
53    method new { return bless {}, $bar }
54    method self { return $bar }
55    method specified( $fnord: ) { return $fnord }
56
57    main::do_common_subtests(
58        desc => 'diff invocant option in diff class in same program',
59    );
60}
61
62
63{
64    package Self;
65    use Test::More;
66    use Method::Signatures;
67
68    method name { return $self }
69    method new { return bless {}, $self }
70    method self { return $self }
71    method specified( $fnord: ) { return $fnord }
72
73    main::do_common_subtests(
74        desc => 'no invocant option in diff class in same program still defaults to "$self"',
75    );
76}
77
78
79{
80    package Bad;
81    use Test::More;
82
83    # this seems exhaustive enough for now...
84    my @bad_invocants = (
85        q{bad},    q{$also bad}, q{$real $bad},  q{thriller was a great album},
86        q{%worse}, q{"$worser"}, q{'$wurst'},    q{weiner $chnitzel},
87        q{""},     q{''},        q{[]},          q[{}],
88        q{},       q{undef},     q{0foo},        q{$0foo},
89        q{$},      q{$$},        q{$-},          q{$-foo},
90        q{$fo-o},  q{$foo-},     q{$foo-bar},    q{$$foo},
91        # and for the hell of it...
92        q{q[$urprise]},
93    );
94
95
96    # say *that* ten times fast:
97    my $desc = 'invalid invocant options incur exceptions';
98    subtest $desc => sub {
99
100        my $use_statement = q{ use Method::Signatures { invocant => q{%HERE} }; };
101
102        # make sure MS always throws an exception when use'd with invocant
103        # set to any of the bad values above.
104        for my $inv ( @bad_invocants ) {
105            (my $use = $use_statement) =~ s/%HERE/$inv/;
106            eval $use;
107            like $@, qr/Invalid invocant name/, "die when invocant option set to '$inv'";
108        }
109
110    };
111}
112
113# make sure previously tested classes still work after testing the
114# invalid invocants
115
116do_common_subtests(
117    class => 'Bar',
118    desc  => 'Bar class still works even after testing invalid invocants',
119);
120
121do_common_subtests(
122    class => 'Self',
123    desc  => 'Self class still works even after testing invalid invocants',
124);
125
126
127done_testing;
128