← Back to branch summary

~ubuntu-branches/ubuntu/natty/libsignatures-perl/natty

« back to all changes in this revision

Viewing changes to t/proto.t

  • Committer: Bazaar Package Importer
  • Author(s): Ryan Niebur
  • Date: 2009-05-18 20:34:44 UTC
  • Revision ID: james.westby@ubuntu.com-20090518203444-ee3iqibpk6uxo7u8
Tags: upstream-0.05
Import upstream version 0.05

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/proto.t
 
1
use strict;
 
2
use warnings;
 
3
use Test::More tests => 8;
 
4
 
 
5
use vars qw/@warnings/;
 
6
BEGIN { $SIG{__WARN__} = sub { push @warnings, @_ } }
 
7
 
 
8
BEGIN { is(@warnings, 0, 'no warnings yet') }
 
9
 
 
10
use signatures;
 
11
 
 
12
sub with_proto ($x, $y, $z) : proto($$$) {
 
13
    return $x + $y + $z;
 
14
}
 
15
 
 
16
{
 
17
    my $foo;
 
18
    sub with_lvalue () : lvalue proto() { $foo }
 
19
}
 
20
 
 
21
is(prototype('with_proto'), '$$$', ':proto attribute');
 
22
 
 
23
is(prototype('with_lvalue'), '', ':proto with other attributes');
 
24
with_lvalue = 1;
 
25
is(with_lvalue, 1, 'other attributes still there');
 
26
 
 
27
BEGIN { is(@warnings, 0, 'no warnings with correct :proto declarations') }
 
28
 
 
29
sub invalid_proto ($x) : proto(invalid) { $x }
 
30
 
 
31
BEGIN {
 
32
    TODO: {
 
33
        local $TODO = ':proto checks not yet implemented';
 
34
        is(@warnings, 1, 'warning with illegal :proto');
 
35
        like(
 
36
            $warnings[0],
 
37
            qr/Illegal character in prototype for main::invalid_proto : invalid at /,
 
38
            'warning looks sane',
 
39
        );
 
40
    }
 
41
}
 
42
 
 
43
eval 'sub foo ($bar) : proto { $bar }';
 
44
like($@, qr/proto attribute requires argument/);