File: 01simple-subs.t

package info (click to toggle)
libattribute-storage-perl 0.12-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 172 kB
  • sloc: perl: 499; makefile: 3
file content (76 lines) | stat: -rw-r--r-- 1,901 bytes parent folder | download
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
#!/usr/bin/perl

use v5.14;
use warnings;

use Test2::V0;

use Attribute::Storage qw( get_subattr get_subattrs );

my $warnings = 0;
BEGIN {
   $SIG{__WARN__} = sub {
      local $SIG{__WARN__};
      warn $_[0];
      $warnings++;
   };
}

sub Title :ATTR(CODE)
{
   my $package = shift;
   my ( $title ) = @_;

   return "" unless defined $title;
   return $title;
}

sub myfunc :Title('The title of myfunc')
{
}

sub emptytitle :Title
{
}

sub anotherfunc
{
}

is( get_subattr( \&myfunc, "Title" ), "The title of myfunc", 'get_subattr Title on \&myfunc' );

is( get_subattr( "myfunc", "Title" ), "The title of myfunc", 'get_subattr Title on "myfunc"' );

is( get_subattr( \&myfunc, "Another" ), undef, 'get_subattr Another' );

is( get_subattr( \&anotherfunc, "Title" ), undef, 'get_subattr Title on \&another' );

is( get_subattrs( \&myfunc ),
   { Title => "The title of myfunc" },
   'get_subattrs' );

my $coderef;

$coderef = sub :Title('Dynamic code') { 1 };
is( get_subattr( $coderef, "Title" ), "Dynamic code", 'get_subattr Title on anon CODE' );

# We have to put  my $dummy = ...  or else the Perl compiler gets confused.
# Reported to perl-p5p@
$coderef = eval "my \$dummy = sub :Title('eval code') { 2 }" or die $@;
is( get_subattr( $coderef, "Title" ), "eval code", 'get_subattr Title on anon CODE from eval' );

$coderef = sub { 1 };
attributes->import( main => $coderef, "Title('attributes import')" );
is( get_subattr( $coderef, "Title" ), "attributes import", 'get_subattr Title on anon CODE from attributes->import application' );

{
   package OtherPackage;

   $coderef = sub { 2 };
   attributes->import( main => $coderef, "Title('import in other package')" );
}

is( get_subattr( $coderef, "Title" ), "import in other package", 'get_subattr Title on anon CODE ref in another package using attributes->import' );

is( $warnings, 0, 'No warnings were produced' );
done_testing;