File: fqname.t

package info (click to toggle)
libdevel-pragma-perl 0.54-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 448 kB
  • sloc: perl: 747; makefile: 2
file content (44 lines) | stat: -rw-r--r-- 736 bytes parent folder | download | duplicates (2)
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
#!/usr/bin/env perl

use strict;
use warnings;

use vars qw(@RESULTS);

use Test::More tests => 1;

package MyPragma;

use Devel::Pragma qw(fqname);

sub import {
    my ($class, @names) = @_;
    for my $name (@names) {
        my $fqname = fqname($name);
        push @::RESULTS, $fqname;
    }
}

package MySubPragma;

BEGIN { our @ISA = qw(MyPragma) }

sub import {
    shift->SUPER::import(@_);
}

package main;

BEGIN { MyPragma->import(qw(foo Foo::Bar::baz Foo'Bar'baz Foo'Bar::baz)) }

{
    package Some::Other::Package;

    BEGIN { MySubPragma->import(qw(quux)) }

    ::is_deeply(
        \@::RESULTS,
        [ qw(main::foo Foo::Bar::baz Foo::Bar::baz Foo::Bar::baz Some::Other::Package::quux) ],
        'fqname'
    );
}