view release on metacpan or  search on metacpan

t/10-core.t  view on Meta::CPAN

# limit is optimised to 1

# testit split    => 'split;',                     q{split(/ /, $_, 1);};
# testit split    => 'CORE::split;',               q{split(/ /, $_, 1);};
# testit split    => 'split $a;',                  q{split(/$a/, $_, 1);};
# testit split    => 'CORE::split $a;',            q{split(/$a/, $_, 1);};
## FIXME
#testit split    => 'split $a, $b;',              q{split(/$a/u, $b, 1);};
#testit split    => 'CORE::split $a, $b;',        q{split(/$a/u, $b, 1);};
#testit split    => 'split $a, $b, $c;',          q{split(/$a/u, $b, $c);};
#testit split    => 'CORE::split $a, $b, $c;',    q{split(/$a/u, $b, $c);};

# testit sub      => 'CORE::sub { $a, $b }',
#			"sub {\n        \$a, \$b;\n    }\n    ;";

# testit system   => 'CORE::system($foo $bar);';

testit unshift  => 'CORE::unshift @foo;',        'CORE::unshift(@foo);';
testit unshift  => 'CORE::unshift @foo, 1;',     'CORE::unshift(@foo, 1);';
testit unshift  => 'CORE::unshift @foo, 1, 2;',  'CORE::unshift(@foo, 1, 2);';

# testit values   => 'CORE::values %bar;';
# testit values   => 'CORE::values @foo;';


# XXX These are deparsed wrapped in parens.
# whether they should be, I don't know!

# testit dump     => '(CORE::dump);';
# testit dump     => '(CORE::dump FOO);';
# testit goto     => '(CORE::goto);',     '(goto);';
# testit goto     => '(CORE::goto FOO);', '(goto FOO);';
# testit last     => '(CORE::last);',     '(last);';
# testit last     => '(CORE::last FOO);', '(last FOO);';
# testit next     => '(CORE::next);',     '(next);';
# testit next     => '(CORE::next FOO);', '(next FOO);';
# testit redo     => '(CORE::redo);',     '(redo);';
# testit redo     => '(CORE::redo FOO);', '(redo FOO);';
# testit redo     => '(CORE::redo);',     '(redo);';
# testit redo     => '(CORE::redo FOO);', '(redo FOO);';

# FIXME: used to work...
# testit return   => '(return);',         '(return);';
# testit return   => '(CORE::return);',   '(return);';

# these are the keywords I couldn't think how to test within this framework

my %not_tested = map { $_ => 1} qw(
    __DATA__
    __END__
    __FILE__
    __LINE__
    __PACKAGE__
    AUTOLOAD
    BEGIN
    CHECK
    CORE
    DESTROY
    END
    INIT
    UNITCHECK
    default
    else
    elsif
    for
    foreach
    format
    given
    if
    m
    no
    package
    q
    qq
    qr
    qw
    qx
    require
    s
    tr
    unless
    until
    use
    when
    while
    y
);



# Sanity check against keyword data:
# make sure we haven't missed any keywords,
# and that we got the strength right.

SKIP:
{
    skip "sanity checks when not PERL_CORE", 1 unless defined $ENV{PERL_CORE};
    my $count = 0;
    my $file = '../regen/keywords.pl';
    my $pass = 1;
    if (open my $fh, '<', $file) {
	while (<$fh>) {
	    last if /^__END__$/;
	}
	while (<$fh>) {
	    next unless /^([+\-])(\w+)$/;
	    my ($strength, $key) = ($1, $2);
	    $strength = ($strength eq '+') ? 1 : 0;
	    $count++;
	    if (!$SEEN{$key} && !$not_tested{$key}) {
		diag("keyword '$key' seen in $file, but not tested here!!");
		$pass = 0;
	    }
	    if (exists $SEEN_STRENGTH{$key} and $SEEN_STRENGTH{$key} != $strength) {
		diag("keyword '$key' strengh as seen in $file doen't match here!!");
		$pass = 0;
	    }
	}
    }
    else {
	diag("Can't open $file: $!");