view release on metacpan or  search on metacpan

t/testcc.sh  view on Meta::CPAN

$_ = $expected;
check;
undef $expected;
✓ # $_ not passed'
result[214]='ok
ok'
tests[215]='eval { $@ = "t1\n"; do { die "t3\n" }; 1; }; print ":$@:\n";'
result[215]=':t3
:'
tests[216]='eval { $::{q{@}}=42; }; print qq{ok\n}'
# priority, fails since 5.18
tests[219]='package OverloadTest; use overload qw("") => sub { ${$_[0]} }; package main;
my $foo = bless \(my $bar = "ok"), "OverloadTest"; print $foo."\n";'
tests[2190]='package Foo; use overload; sub import { overload::constant "integer" => sub { return shift }}; package main; BEGIN { $INC{"Foo.pm"} = "/lib/Foo.pm" }; use Foo; my $result = eval "5+6"; print "$result\n"'
result[2190]='11'
# old issue 220 see 904
tests[220]='BEGIN { $^H{dooot} = 1 }
sub hint_fetch {
    my $key = shift;
    my @results = caller(0);
    $results[10]->{$key};
}
print qq{ok\n} if hint_fetch("dooot");'
tests[2201]='BEGIN { $^H{dчастt} = 1 }
sub hint_fetch {
    my $key = shift;
    my @results = caller(0);
    $results[10]->{$key};
}
print qq{ok\n} if hint_fetch("dчастt");'
tests[2231]='use strict; eval q({ $x = sub }); print $@'
result[2231]='Illegal declaration of anonymous subroutine at (eval 1) line 1.'
tests[222]='my $qr = qr/(?{<<END})/;
boom
END
print "ok";
'
tests[223]='<*> and print qq{ok\n}'
tests[224]='use bytes; my $p = "\xB6"; my $u = "\x{100}"; my $pu = "\xB6\x{100}"; print ( $p.$u eq $pu ? "ko\n" : "ok\n" );'
tests[225]='$_ = $dx = "\x{10f2}"; s/($dx)/$dx$1/; $ok = 1 if $_ eq "$dx$dx"; $_ = $dx = "\x{10f2}"; print qq{end\n};'
result[225]='end'
tests[226]='# WontFix
@INC = (); dbmopen(%H, $file, 0666)'
result[226]='No dbm on this machine at -e line 1.'
tests[227]='open IN, "/dev/null" or die $!; *ARGV = *IN; foreach my $x (<>) { print $x; } close IN; print qq{ok\n}'
tests[229]='sub yyy () { "yyy" } print "ok\n" if( eval q{yyy} eq "yyy");'
#issue 30
tests[230]='sub f1 { my($self) = @_; $self->f2;} sub f2 {} sub new {} print "@ARGV\n";'
result[230]=' '
tests[232]='use Carp (); exit unless Carp::longmess(); print qq{ok\n}'
tests[234]='$c = 0; for ("-3" .. "0") { $c++ } ; print "$c"'
result[234]='4'
# t/testc.sh -O3 -Dp,-UCarp,-v 235
tests[235]='BEGIN{$INC{"Carp.pm"}="/dev/null"} $d = pack("U*", 0xe3, 0x81, 0xAF); { use bytes; $ol = bytes::length($d) } print $ol'
result[235]='6'
# -O3
tests[236]='sub t { if ($_[0] == $_[1]) { print "ok\n"; } else { print "not ok - $_[0] == $_[1]\n"; } } t(-1.2, " -1.2");'
tests[237]='print "\000\000\000\000_"'
result[237]='_'
tests[238]='sub f ($);
sub f ($) {
  my $test = $_[0];
  write;
  format STDOUT =
ok @<<<<<<<
$test
.
}
f("");
'
tests[2381]='sub is { $_[0] eq $_[1] and print "ok\n"}
use constant INIT => 5; is(INIT, 5)'
tests[239]='my $x="1";
format STDOUT =
ok @<<<<<<<
$x
.
write;print "\n";'
result[239]='ok 1'
tests[240]='my $a = "\x{100}\x{101}Aa";
print "ok\n" if "\U$a" eq "\x{100}\x{100}AA";
my $b = "\U\x{149}cD"; # no pb without that line'
tests[241]='package Pickup; use UNIVERSAL qw( can ); if (can( "Pickup", "can" ) != \&UNIVERSAL::can) { print "not " } print "ok\n";'
tests[242]='$xyz = ucfirst("\x{3C2}");
$a = "\x{3c3}foo.bar";
($c = $a) =~ s/(\p{IsWord}+)/ucfirst($1)/ge;
print "ok\n" if $c eq "\x{3a3}foo.Bar";'
tests[243]='use warnings "deprecated"; print hex(${^WARNINGS}) . " "; print hex(${^H})'
result[243]='0 598'
tests[244]='print "($_)\n" for q{-2}..undef;'
result[244]='(-2)
(-1)
(0)'
tests[245]='%INC = (); require XSLoader; XSLoader::load("Cwd"); print qq{ok}'
tests[2450]='sub foo {
    my ( $a, $b ) = @_;
    print "a: ".ord($a)." ; b: ".ord($b)." [ from foo ]\n";
}
print "a: ". ord(lc("\x{1E9E}"))." ; ";
print "b: ". ord("\x{df}")."\n";
foo(lc("\x{1E9E}"), "\x{df}");'
result[2450]='a: 223 ; b: 223
a: 223 ; b: 223 [ from foo ]'
tests[246]='no warnings "experimental::const_attr"; print qq{ok} if &{sub () : const { 42 }} == 42;'
# see t/issue235.t test 2
tests[2460]='sub foo($\@); eval q/foo "s"/; print $@'
result[2460]='Not enough arguments for main::foo at (eval 1) line 1, at EOF'
tests[247]='# WontFix
no warnings; $[ = 1; $big = "N\xabN\xab"; print qq{ok\n} if rindex($big, "N", 3) == 3'
tests[248]='#WONTFIX lexical $_ in re-eval
{my $s="toto";my $_="titi";{$s =~ /to(?{ print "-$_-$s-\n";})to/;}}'
result[248]='-titi-toto-'
tests[249]='use version; print version::is_strict(q{01}) ? 1 : q(ok)'
tests[2501]='#TODO version
use warnings qw/syntax/; use version; $withversion::VERSION = undef; eval q/package withversion 1.1_;/; print $@;'
result[2501]='Misplaced _ in number at (eval 1) line 1.
Invalid version format (no underscores) at (eval 1) line 1, near "package withversion "
syntax error at (eval 1) line 1, near "package withversion 1.1_"'
if [[ $v518 -gt 0 ]]; then
  tests[250]='use feature q/evalbytes/; print "ok\n" if evalbytes("1+7") == 8'
fi