view release on metacpan or  search on metacpan

t/testc.sh  view on Meta::CPAN

result[329]='ok
axxxx aaa a aaa aa'
tests[330]='"\x{101}a" =~ qr/\x{100}/i && print "ok\n"'
tests[331]='package Count;sub getline {print "ok\n"};BEGIN { *The::Count:: = \*Count::; };exists &The::Count::getline ? The::Count->getline() : do {eval "require Devel::Peek;"; Dump(\%The::Count::)}'
tests[3310]='use 5.010; use charnames ":full"; my $char = q/\N{LATIN CAPITAL LETTER A WITH MACRON}/; my $a = eval qq ["$char"]; print length($a) == 1 ? "ok\n" : "$a\n".length($a)."\n"'
tests[332]='#TODO re-eval no_modify, probably WONTFIX
use re "eval"; our ( $x, $y, $z ) = 1..3; $x =~ qr/$x(?{ $y = $z++ })/; undef $@; print "ok\n"'
tests[333]='use encoding "utf8";
my @hiragana =  map {chr} ord("ぁ")..ord("ん"); my @katakana =  map {chr} ord("ァ")..ord("ン"); my $hiragana = join(q{} => @hiragana); my $katakana = join(q{} => @katakana); my %h2k; @h2k{@hiragana} = @katakana; $str = $hiragana; $str =~ s/([ぁ-...
tests[335]='use POSIX (); print POSIX::M_SQRT2;'
result[335]='1.41421356237309'
tests[338]='use utf8; my $l = "ñ"; my $re = qr/ñ/; print $l =~ $re ? qq{ok\n} : length($l)."\n".ord($l)."\n";'
tests[340]='eval q/use Net::DNS/; my $new = "IO::Socket::INET6"->can("new") or die "die at new"; my $inet = $new->("IO::Socket::INET6", LocalAddr => q/localhost/, Proto => "udp", LocalPort => undef); print q(ok) if ref($inet) eq "IO::Socket::INET6";'
tests[342]='use IO::Socket::INET6 (); my $sock = IO::Socket::INET6->new( Blocking => 1, PeerAddr => q/127.0.0.1/, PeerPort => 22 ); print "ok\n";'
# used to fail in the inc-i340 branches CORE/base/lex.t 54
tests[3401]='sub foo::::::bar { print "ok\n"; } foo::::::bar;'
# wontfix on -O3: static string *end for "main::bar"
tests[345]='eval q/use Sub::Name; 1/ or die "no Sub::Name"; subname("main::bar", sub { 42 } ); print "ok\n";'
# those work fine:
tests[3451]='eval q/use Sub::Name; 1/ or die "no Sub::Name"; subname("bar", sub { 42 } ); print "ok\n";'
tests[3452]='eval q/use Sub::Name; 1/ or die "no Sub::Name"; $bar="main::bar"; subname($bar, sub { 42 } ); print "ok\n";'
tests[348]='package Foo::Bar; sub baz { 1 }
package Foo; sub new { bless {}, shift } sub method { print "ok\n"; }
package main; Foo::Bar::baz();
my $foo = sub {
  Foo->new
}->();
$foo->method;'
tests[350]='#TODO 5.18-5.22 dbg
package Foo::Moose; use Moose; has bar => (is => "rw", isa => "Int");
package main; my $moose = Foo::Moose->new; print "ok" if 32 == $moose->bar(32);'
tests[351]='{ BEGIN { *Mover:: = *Mover2::; *Mover2:: = *foo;} 
package Mover;
@ISA = "door"; sub door::dohtem { "dohtem" } print "ok\n";}'
tests[352]='package Foo;my $rand = 0;INIT { *reader = sub () { $rand };}
print qq/ok\n/;'
tests[354]='BEGIN { push @INC, "t"; }
use Ccode354i ();
my $token = { expansion => "abcd", };
print Ccode354i::check($token);'
tests[368]='use EV; print q(ok)'
tests[369]='
use EV;
use Coro;
use Coro::Timer;
my @a;
push @a, async {
  while() {
    warn $c++;
    Coro::Timer::sleep 1;
  };
};
push @a, async {
  while() {
    warn $d++;
    Coro::Timer::sleep 0.5;
  };
};
schedule;
print q(ok)'
tests[1960]='use EV; my $w = EV::timer 1, 1,sub{print"ok\n";exit}; EV::loop'
tests[371]='package foo;use Moose;
has "x" => (isa => "Int", is => "rw", required => 1);
has "y" => (isa => "Int", is => "rw", required => 1);
sub clear { my $self = shift; $self->x(0); $self->y(0); }
__PACKAGE__->meta->make_immutable;
package main;
my $f = foo->new( x => 5, y => 6);
print $f->x . "\n";'
result[371]='5'

if [[ $v518 -gt 0 ]]; then
  tests[372]='use utf8; require mro; my $f_gen = mro::get_pkg_gen('ᕘ'); undef %ᕘ::; mro::get_pkg_gen('ᕘ'); delete $::{"ᕘ::"}; print "ok";'
  tests[373]='package foo; BEGIN {undef %foo::} sub doof { caller(0) } print qq/ok\n/ if +(doof())[3] =~ qr/::doof/'
fi
tests[2050]='use utf8;package 텟ţ::ᴼ; sub ᴼ_or_Ḋ { "ok" } print ᴼ_or_Ḋ;'
tests[2051]='use utf8;package ƂƂƂƂ; sub ƟK { "ok" } package ƦƦƦƦ; use base "ƂƂƂƂ"; my $x = bless {}, "ƦƦƦƦ"; print $x->ƟK();'
tests[2052]='{ package Diӑmond_A; sub fಓ { "ok" } } { package Diӑmond_B; use base q{Diӑmond_A}; use mro "c3"; sub fಓ { (shift)->next::method() } } print Diӑmond_B->fಓ();'
# silly compiler warnings test, only usable with -q
tests[2053]='use strict; BEGIN { $SIG{__WARN__} = sub { die "Dying on warning: ", @_ } } print q{ok}'
# empty keys multideref
tests[2054]='my %h; $h{""} = q/boom/; print qq{ok\n}'
tests[2055]='our %h; $h{""} = q/boom/; print qq{ok\n}'
# GH issues:
tests[2790]='*TIESCALAR = sub {}; tie my $var => "main", 42; <${var}>; print qq/ok\n/'
tests[2230]='# 5.22 SEGV with missing gv_list[0] svop_list[0]
<*.*> and print qq{ok\n}'
tests[3060]='INIT { $SIG{__WARN__} = sub { die } } print "ok\n";'
tests[3061]='END { $SIG{__WARN__} = sub { die } } print "ok\n";'
tests[2191]='sub foo1 ($\@); eval q{ foo1 "s" }; print $@ =~ /^Not enough/ ? "ok" : "";'
tests[2192]='sub foo1 ($\%); eval q{ foo1 "s" }; print $@ =~ /^Not enough/ ? "ok" : "";'
tests[2193]='{local $^W = 1; my $warn = "";
local $SIG{__WARN__} = sub { $warn .= join("",@_) };
eval q(sub badproto4 (@ $b ar) { 1; });
print $warn =~ /Prototype after .@. for main::badproto4/ ? "ok" : $warn;}'
# GH 330
tests[3300]='#WONTFIX
*STDOUT; sub IO::Handle::self { $_[0] };
(*STDOUT->self . "") =~ m/^GLOB/ and print "ok\n"'
tests[3301]='#WORKAROUND 3300
IO::Handle->new if $ENV{none}; *STDOUT; sub IO::Handle::self { $_[0] };
(*STDOUT->self . "") =~ m/^GLOB/ and print "ok\n"'
tests[367]='#BROKEN since 5.22 (METHOP for binc)
use Math::BigInt;
my $x = Math::BigInt->new('1' x 20);
print "ok" if ++$x eq "11111111111111111112";'
tests[390]='print test(); print test();
sub test() {
    *test = sub ()  { "k" };
    "o";
}'
tests[391]='use warnings "closed"; eval "warn qq(\n); print qq(ok\n)";'
tests[400]='#TODO
use Class::XSAccessor constructor => "new", accessors => [ "foo" ];
my $o = main::->new( foo => "ok" );
print $o->foo,"\n";'
tests[4001]='require Class::XSAccessor;
Class::XSAccessor->import(constructor => "new", accessors => [ "foo" ]);
my $o = main::->new( foo => "ok" );
print $o->foo,"\n";'
tests[4002]='use Class::XSAccessor;