view release on metacpan or  search on metacpan

t/0006-delta-checks.t  view on Meta::CPAN

######################################################################
#
# 0006-delta-checks.t  Tests for constructs found by reading all
#                      perlXXXXXdelta files from perl56delta onward
#
# Each check below corresponds to a feature introduced in a specific
# Perl version and verified against the relevant delta documentation:
#
#   D01: UNITCHECK blocks                        -- Perl 5.10
#   D02: Possessive quantifiers a++ *+ ?+        -- Perl 5.10
#   D03: Recursive patterns (?PARNO) (?&n) (?R)  -- Perl 5.10
#   D04: ${^MATCH} ${^PREMATCH} ${^POSTMATCH}    -- Perl 5.10
#   D05: \g{N} relative backreference            -- Perl 5.10
#   D06: <<>> double-diamond operator            -- Perl 5.22
#   D07: /n non-capturing regex flag             -- Perl 5.22
#   D08: <<~ indented heredoc                    -- Perl 5.26
#   D09: isa infix operator                      -- Perl 5.32
#   D10: use builtin                             -- Perl 5.36
#   D11: for my ($a,$b) paired iteration         -- Perl 5.36
#   D12: ^^ / ^^= high-precedence logical XOR   -- Perl 5.40
#   D13: __CLASS__ keyword                       -- Perl 5.40
#   D14: any/all BLOCK LIST keyword operators    -- Perl 5.42
#   D15: my method / ->& lexical method call     -- Perl 5.42
#   D16: my sub / state sub lexical subroutines  -- Perl 5.18
#   D17: %hash{LIST} / %array[LIST] key/value slices -- Perl 5.20
#   D18: &. |. ^. ~. string bitwise operators    -- Perl 5.22
#   D19: \foreach reference aliasing             -- Perl 5.22
#
# COMPATIBILITY: Perl 5.005_03 and later
#
######################################################################
use strict;
BEGIN { if ($] < 5.006 && !defined(&warnings::import)) {
        $INC{'warnings.pm'} = 'stub'; eval 'package warnings; sub import {}' } }
use warnings; local $^W = 1;
BEGIN { pop @INC if $INC[-1] eq '.' }
use FindBin ();
use lib "$FindBin::Bin/../lib";
use lib "$FindBin::Bin/lib";

BEGIN {
    require Perl500503Syntax::OrDie;
    Perl500503Syntax::OrDie::_install_runtime_guards();
}

sub violates {
    my ($src) = @_;
    my @_v = Perl500503Syntax::OrDie::_check_source($src, 'test');
    return @_v ? 1 : 0;
}

use vars qw(@tests);
@tests = (

    # ==============================================================
    # D01: UNITCHECK blocks  (Perl 5.10)
    # perl5100delta: "UNITCHECK, a new special code block has been
    # introduced, in addition to BEGIN, CHECK, INIT and END."
    # ==============================================================
    ['D01 UNITCHECK: block - detected',
        sub { violates('UNITCHECK { print "unit\n" }' . "\n") }],

    ['D01 UNITCHECK: in comment - ignored',
        sub { !violates('# UNITCHECK { }' . "\n") }],

    ['D01 UNITCHECK: in string - ignored',
        sub { !violates('my $s = "UNITCHECK { }";' . "\n") }],

    ['D01 UNITCHECK: BEGIN still ok',
        sub { !violates('BEGIN { }' . "\n") }],

    ['D01 UNITCHECK: END still ok',
        sub { !violates('END { }' . "\n") }],

    # ==============================================================
    # D02: Possessive quantifiers a++ *+ ?+ {n,m}+  (Perl 5.10)
    # perl5100delta: "Possessive Quantifiers: Perl now supports the
    # possessive quantifier syntax"
    # ==============================================================
    ['D02 possessive: a++ - detected',
        sub { violates('if ($s =~ /a++/) {}' . "\n") }],

    ['D02 possessive: a*+ - detected',
        sub { violates('if ($s =~ /a*+/) {}' . "\n") }],

    ['D02 possessive: a?+ - detected',
        sub { violates('if ($s =~ /a?+/) {}' . "\n") }],

    ['D02 possessive: a{2,3}+ - detected',
        sub { violates('if ($s =~ /a{2,3}+/) {}' . "\n") }],

    ['D02 possessive: (?:foo)++ - detected',
        sub { violates('if ($s =~ /(?:foo)++/) {}' . "\n") }],

    ['D02 possessive: $var++ not detected (postfix increment)',
        sub { !violates('$count++;' . "\n") }],

    ['D02 possessive: $a++ + $b not detected',
        sub { !violates('my $x = $a++ + $b;' . "\n") }],

    ['D02 possessive: in comment - ignored',
        sub { !violates('# /a++/ possessive' . "\n") }],

    # ==============================================================
    # D03: Recursive patterns (?PARNO) (?&name) (?R)  (Perl 5.10)
    # perl5100delta: "Recursive Patterns: It is now possible to write
    # recursive patterns without using the (??{}) construct."
    # ==============================================================
    ['D03 recursive: (?1) - detected',
        sub { violates('if ($s =~ /(?1)/) {}' . "\n") }],

    ['D03 recursive: (?-1) relative - detected',
        sub { violates('if ($s =~ /(?-1)/) {}' . "\n") }],

    ['D03 recursive: (?&name) - detected',
        sub { violates('if ($s =~ /(?&word)/) {}' . "\n") }],

    ['D03 recursive: (?R) - detected',
        sub { violates('if ($s =~ /(?R)/) {}' . "\n") }],

    ['D03 recursive: (?:) non-capture - not detected',
        sub { !violates('if ($s =~ /(?:foo)/) {}' . "\n") }],

    ['D03 recursive: (?=) lookahead - not detected',
        sub { !violates('if ($s =~ /(?=foo)/) {}' . "\n") }],

    ['D03 recursive: in comment - ignored',
        sub { !violates('# (?1) recursive' . "\n") }],

    # ==============================================================
    # D04: ${^MATCH} ${^PREMATCH} ${^POSTMATCH}  (Perl 5.10)
    # perl5100delta: "Optional pre-match and post-match captures