view release on metacpan or  search on metacpan

t/op/coreamp.t  view on Meta::CPAN

test_proto 'connect';
$tests += 2;
SKIP:
{
  skip "connect() not available in Win32 miniperl", 2
    if $^O eq "MSWin32" && is_miniperl();
  is &CORE::connect('foo','bar'), undef, '&connect';
  lis [&myconnect('foo','bar')], [undef], '&connect in list context';
}

test_proto 'continue';
$tests ++;
no warnings 'deprecated';
CORE::given(1) {
  CORE::when(1) {
    &mycontinue();
  }
  pass "&continue";
}

test_proto 'cos';
test_proto 'crypt';

test_proto 'dbmclose';
test_proto 'dbmopen';
{
  last unless eval { require AnyDBM_File };
  $tests ++;
  my $filename = tempfile();
  &mydbmopen(\my %db, $filename, 0666);
  $db{1} = 2; $db{3} = 4;
  &mydbmclose(\%db);
  is scalar keys %db, 0, '&dbmopen and &dbmclose';
  my $Dfile = "$filename.pag";
  if (! -e $Dfile) {
    ($Dfile) = <$filename*>;
  }
  if ($^O eq 'VMS') {
    unlink "$filename.sdbm_dir", $Dfile;
  } else {
    unlink "$filename.dir", $Dfile;
  }
}

test_proto 'die';
eval { dier('quinquangle') };
is $@, "quinquangle at frob line 6.\n", '&CORE::die'; $tests ++;

test_proto $_ for qw(
  endgrent endhostent endnetent endprotoent endpwent endservent
);

test_proto 'evalbytes';
$tests += 4;
{
  my $U_100_bytes = byte_utf8a_to_utf8n("\xc4\x80");
  chop(my $upgraded = "use utf8; $U_100_bytes" . chr 256);
  is &myevalbytes($upgraded), chr 256, '&evalbytes';
  # Test hints
  require strict;
  strict->import;
  &myevalbytes('
    is someone, "someone", "run-time hint bits do not leak into &evalbytes"
  ');
  use strict;
  BEGIN { $^H{coreamp} = 42 }
  $^H{coreamp} = 75;
  &myevalbytes('
    BEGIN {
      is $^H{coreamp}, 42, "compile-time hh propagates into &evalbytes";
    }
    ${"frobnicate"}
  ');
  like $@, qr/strict/, 'compile-time hint bits propagate into &evalbytes';
}

test_proto 'exit';
$tests ++;
is runperl(prog => '&CORE::exit; END { print qq-ok\n- }'), "ok\n",
  '&exit with no args';

test_proto 'fork';

test_proto 'formline';
$tests += 3;
is &myformline(' @<<< @>>>', 1, 2), 1, '&myformline retval';
is $^A,        ' 1       2', 'effect of &myformline';
lis [&myformline('@')], [1], '&myformline in list context';

test_proto 'each';
$tests += 4;
is &myeach({ "a","b" }), "a", '&myeach(\%hash) in scalar cx';
lis [&myeach({qw<a b>})], [qw<a b>], '&myeach(\%hash) in list cx';
is &myeach([ "a","b" ]), 0, '&myeach(\@array) in scalar cx';
lis [&myeach([qw<a b>])], [qw<0 a>], '&myeach(\@array) in list cx';

test_proto 'exp';

test_proto 'fc';
$tests += 2;
{
  my $sharp_s = uni_to_native("\xdf");
  is &myfc($sharp_s), $sharp_s, '&fc, no unicode_strings';
  use feature 'unicode_strings';
  is &myfc($sharp_s), "ss", '&fc, unicode_strings';
}

test_proto 'fcntl';

test_proto 'fileno';
$tests += 2;
is &CORE::fileno(\*STDIN), fileno STDIN, '&CORE::fileno';
lis [&CORE::fileno(\*STDIN)], [fileno STDIN], '&CORE::fileno in list cx';

test_proto 'flock';
test_proto 'fork';

test_proto 'getc';
{
  last if is_miniperl;
  $tests += 3;