view release on metacpan or  search on metacpan

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

testit 'readline', 'CORE::readline $a . $b;', 'CORE::readline $a . $b;';
testit 'readpipe', 'CORE::readpipe $a + $b;', 'CORE::readpipe $a + $b;';
# testit 'reverse', 'CORE::reverse sort(@foo);', 'CORE::reverse sort(@foo);';
testit 'shift', 'CORE::shift @foo;', 'CORE::shift @foo;';

testit splice   => q{CORE::splice @foo;},                 q{CORE::splice(@foo);};
testit splice   => q{CORE::splice @foo, 0;},              q{CORE::splice(@foo, 0);};
testit splice   => q{CORE::splice @foo, 0, 1;},           q{CORE::splice(@foo, 0, 1);};
# testit splice   => q{CORE::splice @foo, 0, 1, 'a';},      q{CORE::splice(@foo, 0, 1, 'a');};
# testit splice   => q{CORE::splice @foo, 0, 1, 'a', 'b';}, q{CORE::splice(@foo, 0, 1, 'a', 'b');};

# note that the test does '() = split...' which is why the
# 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: $!");
	$pass = 0;
    }
    # insanity check
    if ($count < 200) {
	diag("Saw $count keywords: less than 200!");
	$pass = 0;
    }
    ok($pass, "sanity checks");
}


done_testing();