^sub \w+\( results from the CPAN

^sub \w+\(

perl

view release on metacpan or search on metacpan

cpan/Pod-Simple/t/fcodes_s.t view on Meta::CPAN

    qq{\n<p><a href="http://www.perl.org" class="podlinkurl"\n>perl.org</a></p>\n}
);

is(
    x(qq{See L<perl.org|http://www.perl.org>\n}),
    qq{\n<p>See <a href="http://www.perl.org" class="podlinkurl"\n>perl.org</a></p>\n}
);

# Test link output in XHTML.
use Pod::Simple::XHTML;
sub o ($) {
    my $p = Pod::Simple::XHTML->new;
    $p->html_header("");
    $p->html_footer("");
    my $results = '';
    $p->output_string( \$results ); # Send the resulting output to a string
    $p->parse_string_document("=pod\n\n$_[0]");
    return $results;
}

is(

cpan/Scalar-List-Utils/t/prototype.t view on Meta::CPAN

is( prototype('f'), '$', 'prototype');
is( CORE::prototype('f'), '$', 'prototype from CORE');
is( $r,   \&f, 'return value');

set_prototype(undef, \&f);
is( prototype('f'), undef, 'remove prototype');

set_prototype('', \&f);
is( prototype('f'), '', 'empty prototype');

sub g (@) { }
is( prototype('g'), '@', '@ prototype');

set_prototype(undef, \&g);
is( prototype('g'), undef, 'remove prototype');

sub stub;
is( prototype('stub'), undef, 'non existing sub');

set_prototype('$$$', \&stub);
is( prototype('stub'), '$$$', 'change non existing sub');

cpan/Scalar-List-Utils/t/scalarutil-proto.t view on Meta::CPAN

my $r = set_prototype(\&f,'$');
is( prototype('f'), '$', 'set prototype');
is( $r, \&f, 'return value');

set_prototype(\&f,undef);
is( prototype('f'), undef, 'remove prototype');

set_prototype(\&f,'');
is( prototype('f'), '', 'empty prototype');

sub g (@) { }
is( prototype('g'), '@', '@ prototype');

set_prototype(\&g,undef);
is( prototype('g'), undef, 'remove prototype');

sub stub;
is( prototype('stub'), undef, 'non existing sub');

set_prototype(\&stub,'$$$');
is( prototype('stub'), '$$$', 'change non existing sub');

cpan/Test-Harness/t/source.t view on Meta::CPAN

use strict;
use warnings;

use Test::More tests => 45;
use File::Spec;

my $dir = 't/source_tests';

use_ok('TAP::Parser::Source');

sub ct($) {
    my $hash = shift;
    if ( $ENV{PERL_CORE} ) {
        delete $hash->{is_symlink};
        delete $hash->{lstat};
    }
    return $hash;
}

# Basic tests
{

cpan/Test-Simple/lib/Test2/Tools/Basic.pm view on Meta::CPAN


use Carp qw/croak/;
use Test2::API qw/context/;

our @EXPORT = qw{
    ok pass fail diag note todo skip
    plan skip_all done_testing bail_out
};
use base 'Exporter';

sub ok($;$@) {
    my ($bool, $name, @diag) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name, \@diag);
    $ctx->release;
    return $bool ? 1 : 0;
}

sub pass {
    my ($name) = @_;
    my $ctx = context();

cpan/Test-Simple/lib/Test2/Tools/ClassicCompare.pm view on Meta::CPAN

use Test2::Compare::OrderedSubset();
use Test2::Compare::Pattern();
use Test2::Compare::Ref();
use Test2::Compare::Regex();
use Test2::Compare::Scalar();
use Test2::Compare::Set();
use Test2::Compare::String();
use Test2::Compare::Undef();
use Test2::Compare::Wildcard();

sub is($$;$@) {
    my ($got, $exp, $name, @diag) = @_;
    my $ctx = context();

    my @caller = caller;

    my $delta = compare($got, $exp, \&is_convert);

    if ($delta) {
        $ctx->fail($name, $delta->diag, @diag);
    }

cpan/Test-Simple/lib/Test2/Tools/Compare.pm view on Meta::CPAN

        $module = 'Data::Dumper';
    }

    my $deparse = $Data::Dumper::Deparse;
    $deparse = !!$ENV{'T2_AUTO_DEPARSE'} if exists $ENV{'T2_AUTO_DEPARSE'};
    local $Data::Dumper::Deparse = $deparse;

    $ctx->diag($module->Dump([$got], ['GOT']));
};

sub is($$;$@) {
    my ($got, $exp, $name, @diag) = @_;
    my $ctx = context();

    my $delta = compare($got, $exp, \&strict_convert);

    if ($delta) {
        # Temporary thing.
        my $count = 0;
        my $implicit = 0;
        my @deltas = ($delta);

cpan/Test-Simple/lib/Test2/Tools/Compare.pm view on Meta::CPAN


sub D() {
    my @caller = caller;
    Test2::Compare::Custom->new(
        code => sub { defined $_ ? 1 : 0 }, name => 'DEFINED', operator => 'DEFINED()',
        file => $caller[1],
        lines => [$caller[2]],
    );
}

sub DF() {
    my @caller = caller;
    Test2::Compare::Custom->new(
        code => sub { defined $_ && ( ! ref $_ && ! $_ ) ? 1 : 0 }, name => 'DEFINED BUT FALSE', operator => 'DEFINED() && FALSE()',
        file => $caller[1],
        lines => [$caller[2]],
    );
}

sub DNE() {
    my @caller = caller;

cpan/Test-Simple/lib/Test2/Tools/Tiny.pm view on Meta::CPAN

use Test2::Hub::Interceptor::Terminator();

our $VERSION = '1.302210';

BEGIN { require Exporter; our @ISA = qw(Exporter) }
our @EXPORT = qw{
    ok is isnt like unlike is_deeply diag note skip_all todo plan done_testing
    warnings exception tests capture
};

sub ok($;$@) {
    my ($bool, $name, @diag) = @_;
    my $ctx = context();

    return $ctx->pass_and_release($name) if $bool;
    return $ctx->fail_and_release($name, @diag);
}

sub is($$;$@) {
    my ($got, $want, $name, @diag) = @_;
    my $ctx = context();

    my $bool;
    if (defined($got) && defined($want)) {
        $bool = "$got" eq "$want";
    }
    elsif (defined($got) xor defined($want)) {
        $bool = 0;
    }

cpan/Test-Simple/t/Test2/acceptance/try_it_done_testing.t view on Meta::CPAN

use Test2::API qw/context/;

sub done_testing {
    my $ctx = context();

    die "Test Already ended!" if $ctx->hub->ended;
    $ctx->hub->finalize($ctx->trace, 1);
    $ctx->release;
}

sub ok($;$) {
    my ($bool, $name) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name);
    $ctx->release;
}

ok(1, "First");
ok(1, "Second");

done_testing;

cpan/Test-Simple/t/Test2/acceptance/try_it_fork.t view on Meta::CPAN

use Test2::Util qw/CAN_REALLY_FORK/;
use Test2::IPC;
use Test2::API qw/context/;

sub plan {
    my $ctx = context();
    $ctx->plan(@_);
    $ctx->release;
}

sub ok($;$) {
    my ($bool, $name) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name);
    $ctx->release;
}

plan(0, skip_all => 'System cannot fork') unless CAN_REALLY_FORK();

plan(6);

cpan/Test-Simple/t/Test2/acceptance/try_it_no_plan.t view on Meta::CPAN

use warnings;

use Test2::API qw/context/;

sub plan {
    my $ctx = context();
    $ctx->plan(@_);
    $ctx->release;
}

sub ok($;$) {
    my ($bool, $name) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name);
    $ctx->release;
}

plan(0, 'no_plan');

ok(1, "First");
ok(1, "Second");

cpan/Test-Simple/t/Test2/acceptance/try_it_plan.t view on Meta::CPAN

use warnings;

use Test2::API qw/context/;

sub plan {
    my $ctx = context();
    $ctx->plan(@_);
    $ctx->release;
}

sub ok($;$) {
    my ($bool, $name) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name);
    $ctx->release;
}

plan(2);

ok(1, "First");
ok(1, "Second");

cpan/Test-Simple/t/Test2/acceptance/try_it_threads.t view on Meta::CPAN

use Test2::Util qw/CAN_THREAD/;
use Test2::IPC;
use Test2::API qw/context/;

sub plan {
    my $ctx = context();
    $ctx->plan(@_);
    $ctx->release;
}

sub ok($;$) {
    my ($bool, $name) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name);
    $ctx->release;
}

plan(0, skip_all => 'System does not have threads') unless CAN_THREAD();

plan(6);

cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t view on Meta::CPAN

use Test2::API qw/context test2_stack/;

sub done_testing {
    my $ctx = context();

    die "Test Already ended!" if $ctx->hub->ended;
    $ctx->hub->finalize($ctx->trace, 1);
    $ctx->release;
}

sub ok($;$) {
    my ($bool, $name) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name);
    $ctx->release;
}

sub diag {
    my $ctx = context();
    $ctx->diag( join '', @_ );
    $ctx->release;

cpan/Test-Simple/t/Test2/behavior/Taint.t view on Meta::CPAN

#!/usr/bin/env perl -T
# HARNESS-NO-FORMATTER

use Test2::API qw/context/;

sub ok($;$@) {
    my ($bool, $name) = @_;
    my $ctx = context();
    $ctx->ok($bool, $name);
    $ctx->release;
    return $bool ? 1 : 0;
}

sub done_testing {
    my $ctx = context();
    $ctx->hub->finalize($ctx->trace, 1);

cpan/Test-Simple/t/modules/Util/Times.t view on Meta::CPAN

use Test2::Bundle::Extended;

use Test2::Util::Times qw/render_bench/;

imported_ok qw{ render_bench };

sub TM() { 0.5 }

is(
    render_bench(0, 2.123456, TM, TM, TM, TM),
    "2.12346s on wallclock (0.50 usr 0.50 sys + 0.50 cusr 0.50 csys = 2.00 CPU)",
    "Got benchmark with < 10 second duration"
);

is(
    render_bench(0, 42.123456, TM, TM, TM, TM),
    "42.1235s on wallclock (0.50 usr 0.50 sys + 0.50 cusr 0.50 csys = 2.00 CPU)",

dist/Devel-PPPort/soak view on Meta::CPAN

  make    => $Config{make} || 'make',
  min     => '5.000',
  color   => 1,
);

GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@ color!)) or pod2usage(2);

$OPT{mmargs} = [''] unless exists $OPT{mmargs};
$OPT{min}    = parse_version($OPT{min}) - 1e-10;

sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }

my @GoodPerls = map  { $_->[0] }
                sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] }
                grep { $_->[1] >= $OPT{min} }
                map  { [$_ => perl_version($_)] }
                @ARGV ? SearchPerls(@ARGV) : FindPerls();

unless (@GoodPerls) {
  print "Sorry, got no Perl binaries for testing.\n\n";
  exit 0;

dist/Devel-PPPort/soak view on Meta::CPAN

our @ISA = qw(Tie::Handle);

sub TIEHANDLE { bless \(my $s = ''), shift }
sub PRINT {}
sub WRITE {}

package Soak::Reporter;

use strict;

sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) }

sub new
{
  my $class = shift;
  bless {
    tests   => undef,
    color   => 1,
    verbose => 0,
    @_,
    _cur    => 0,

dist/Math-Complex/lib/Math/Complex.pm view on Meta::CPAN

#
# Used in log10().
#
sub _uplog10 () { 1 / CORE::log(10) }

#
# i
#
# The number defined as i*i = -1;
#
sub i () {
        return $i if ($i);
	$i = bless {};
	$i->{'cartesian'} = [0, 1];
	$i->{'polar'}     = [1, pip2];
	$i->{c_dirty} = 0;
	$i->{p_dirty} = 0;
	return $i;
}

#

dist/threads/t/problems.t view on Meta::CPAN


print("ok 1 - Loaded\n");

use Hash::Util 'lock_keys';

my $test :shared = 2;

# Note that we can't use Test::More here, as we would need to call is()
# from within the DESTROY() function at global destruction time, and
# parts of Test::* may have already been freed by then
sub is($$$)
{
    my ($got, $want, $desc) = @_;
    lock($test);
    if ($got ne $want) {
        print("# EXPECTED: $want\n");
        print("# GOT:      $got\n");
        print("not ");
    }
    print("ok $test - $desc\n");
    $test++;

ext/XS-APItest/t/pad_scalar.t view on Meta::CPAN

our $foo = "wibble";
my $bar = "wobble";
is pad_scalar(1, "foo"), "NOT_MY";
is pad_scalar(2, "foo"), "NOT_MY";
is pad_scalar(3, "foo"), "NOT_MY";
is pad_scalar(4, "foo"), "NOT_MY";
is pad_scalar(1, "bar"), "wobble";
is pad_scalar(2, "bar"), "wobble";
is pad_scalar(3, "bar"), "wobble";

sub aa($);
sub aa($) {
    my $xyz;
    ok \pad_scalar(1, "xyz") == \$xyz;
    ok \pad_scalar(2, "xyz") == \$xyz;
    ok \pad_scalar(3, "xyz") == \$xyz;
    aa(0) if $_[0];
    ok \pad_scalar(1, "xyz") == \$xyz;
    ok \pad_scalar(2, "xyz") == \$xyz;
    ok \pad_scalar(3, "xyz") == \$xyz;
    is pad_scalar(1, "bar"), "wobble";
    is pad_scalar(2, "bar"), "wobble";
    is pad_scalar(3, "bar"), "wobble";
}
aa(1);

sub bb() {
    my $counter = 0;
    my $foo = \$counter;
    return sub {
	ok pad_scalar(1, "foo") == \pad_scalar(1, "counter");
	ok pad_scalar(2, "foo") == \pad_scalar(1, "counter");
	ok pad_scalar(3, "foo") == \pad_scalar(1, "counter");
	ok pad_scalar(4, "foo") == \pad_scalar(1, "counter");
	if(pad_scalar(1, "counter") % 3 == 0) {
	    return pad_scalar(1, "counter")++;
	} elsif(pad_scalar(1, "counter") % 3 == 0) {

lib/unicore/mktables view on Meta::CPAN

# feasible properties; a few aren't currently feasible; see
# is_code_point_usable() in mktables for details.

# Standard test packages are not used because this manipulates SIG_WARN.  It
# exits 0 if every non-skipped test succeeded; -1 if any failed.

my $Tests = 0;
my $Fails = 0;

# loc_tools.pl requires this function to be defined
sub ok($pass, @msg) {
    print "not " unless $pass;
    print "ok ";
    print ++$Tests;
    print " - ", join "", @msg if @msg;
    print "\n";
}

sub Expect($expected, $ord, $regex, $warning_type='') {
    my $line   = (caller)[2];

t/comp/form_scope.t view on Meta::CPAN

#!./perl

print "1..14\n";

# Tests bug #22977.  Test case from Dave Mitchell.
sub f ($);
sub f ($) {
my $test = $_[0];
write;
format STDOUT =
ok @<<<<<<<
$test
.
}

f(1);
f(2);

t/comp/retainedlines.t view on Meta::CPAN

    print "# Failed test at $caller[1] line $caller[2]\n";
    if (defined $got) {
	print "# Got '$got'\n";
    } else {
	print "# Got undef\n";
    }
    print "# Expected $expected\n";
    return;
}

sub is($$$) {
    my ($got, $expect, $name) = @_;
    $test = $test + 1;
    if (defined $expect) {
	if (defined $got && $got eq $expect) {
	    print "ok $test - $name\n";
	    return 1;
	}
	failed($got, "'$expect'", $name);
    } else {
	if (!defined $got) {

t/comp/use.t view on Meta::CPAN


sub like ($$;$) {
    _ok ('like', @_);
}
sub is ($$;$) {
    _ok ('is', @_);
}
sub isnt ($$;$) {
    _ok ('isnt', @_);
}
sub ok($;$) {
    _ok ('ok', shift, undef, @_);
}

eval "use 5";           # implicit semicolon
is ($@, '');

eval "use 5;";
is ($@, '');

eval "{use 5}";         # [perl #70884]

t/lib/warnings/op view on Meta::CPAN

# op.c github #20742
use constant fred => 1, 2;
use constant fred => 2, 3;
EXPECT
OPTIONS regex
Constant subroutine main::fred redefined at .*lib/constant\.pm line \d+
########
# op.c related to github #20742
# produced an assertion failure
use constant x => 1, 2;
sub x () { 1 }
EXPECT
Constant subroutine x redefined at - line 4.
########
# op.c
use feature "lexical_subs", "state";
my sub fred () { 1 }
sub fred { 2 };
my sub george { 1 }
sub george () { 2 } # should *not* produce redef warnings by default
state sub phred () { 1 }

t/lib/warnings/toke view on Meta::CPAN

########
use utf8;
use open qw( :utf8 :std );
use warnings;
BEGIN { eval "sub foo (@\x{30cb}) {}"; }
EXPECT
Prototype after '@' for main::foo : @\x{30cb} at (eval 1) line 1.
Illegal character in prototype for main::foo : @\x{30cb} at (eval 1) line 1.
########
use warnings;
sub f ([);
sub f :prototype([)
EXPECT
Missing ']' in prototype for main::f : [ at - line 2.
Missing ']' in prototype for main::f : [ at - line 3.
########
use warnings;
package bar { sub bar { eval q"sub foo ([)" } }
bar::bar
EXPECT
Missing ']' in prototype for bar::foo : [ at (eval 1) line 1.

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

}
squog();
sub squag;
sub squag {
    grep { is &CORE::__SUB__, \&squag,
          '& in grep block in sub with forw decl'
    } 1;
}
squag();

sub f () { __SUB__ }
is f, \&f, 'sub named () { __SUB__ } returns self ref';
my $f = sub () { __SUB__ };
is &$f, $f, 'anonymous sub(){__SUB__} returns self ref';
my $f2 = sub () { $f++ if 0; __SUB__ };
is &$f2, $f2, 'sub(){__SUB__} anonymous closure returns self ref';
$f = sub () { eval ""; __SUB__ };
is &$f, $f, 'anonymous sub(){eval ""; __SUB__} returns self ref';
{
    local $ENV{PERL5DB} = 'sub DB::DB {}';
    is runperl(

t/re/reg_pmod.t view on Meta::CPAN

    [ '(?p)', "345",    "012-", "345",  "-6789"],
    [ '(?p:)',"345",    "012-", "345",  "-6789"],
    [ '',     "(345)",  undef,  undef,  undef ],
    [ '',     "345",    undef,  undef,  undef ],
);

plan tests => 14 * @tests + 4;
my $W = "";

$SIG{__WARN__} = sub { $W.=join("",@_); };
sub _u($$) { "$_[0] is ".(defined $_[1] ? "'$_[1]'" : "undef") }

foreach my $test (@tests) {
    my ($p, $pat,$l,$m,$r) = @$test;
    my $qr = qr/$pat/;
    for my $sub (0,1) {
	my $test_name = $p eq '/p'   ? "/$pat/p"
		      : $p eq '/$r/p'? $p
		      : $p eq '(?p)' ? "/(?p)$pat/"
		      : $p eq '(?p:)'? "/(?p:$pat)/"
		      :                "/$pat/";

t/run/fresh_perl.t view on Meta::CPAN

# moved to op/lc.t
EXPECT
########
sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next }
my $x = "foo";
{ f } continue { print $x, "\n" }
EXPECT
foo
########
# [perl #3066]
sub C () { 1 }
sub M { print "$_[0]\n" }
eval "C";
M(C);
EXPECT
1
########
print qw(ab a\b a\\b);
EXPECT
aba\ba\b
########

( run in 4.094 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )