File: quote.t

package info (click to toggle)
libdevel-declare-perl 0.006000-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 296 kB
  • ctags: 238
  • sloc: perl: 1,605; ansic: 756; makefile: 25
file content (52 lines) | stat: -rw-r--r-- 1,024 bytes parent folder | download | duplicates (7)
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
use strict;
use warnings;
use Test::More tests => 15;

use Devel::Declare 'method' => sub {};
use File::Spec;

sub test_eval;

QUOTE: {
    test_eval 'qq/method/';
    test_eval 'q/method/';
    test_eval "'method'";
    test_eval '"method"';
    test_eval 'qw/method/';
    test_eval '<<method;
tum ti tum
method';
    test_eval 'my $x = { method => 42 }';
}

SYSTEM: {
    test_eval 'sub {`method`}'; # compiled to prevent calling arbitrary exe!
    test_eval 'sub { qx{method} }';
}

REGEX: {
    local $_=''; # the passing results will act on $_
    test_eval 'qr/method/';
    test_eval '/method/';
    test_eval 's/method//';
    test_eval 'tr/method/METHOD/';
}

FILE: {
    test_eval q{ no warnings 'reserved'; open method, '<', File::Spec->devnull };
    test_eval '<method>';
}

sub test_eval {
    my $what = shift;
    eval $what;
    ok !$@, "$what" or d($@);
}
{
  my %seen;
  sub d { # diag the error the first time we get it
    my $err = shift;
    $err =~s/ at .*$//;
    $seen{$err}++ or diag $err;
  }
}