view release on metacpan or  search on metacpan

lib/Scalar/Quote.pm  view on Meta::CPAN

    exists $esc{$char} ? $esc{$char} : char_to_hex($char)
}

# converts unprintable chars to \x{XX} and also escapes '"' and '\' if
# required
sub Q ($ ) {
  my $s=shift;
  defined $s or return 'undef';
  if ($s=~s/([^!#&()*+,\-.\/0123456789:;<=>?ABCDEFGHIJKLMNOPQRSTUVWXYZ\[\]\^_`abcdefghijklmnopqrstuvwxyz{|}~ ])/escape_char($1)/ge) {
    return qq("$s");
  }

lib/Scalar/Quote.pm  view on Meta::CPAN

}


# escape and quote string start operator, like Q but truncates the
# string if it is to long.
sub S ($;$ ) {
  my $len=defined $_[1] ? $_[1] : 32;
  quote_cut ($_[0], 0, $len);
}
*quote_start=\&S;

my $number_re=qr/^\s*[+-]?(?:\d+|\d*\.\d*)(?i:E[+-]?\d+)?\s*$/;

# quote number
sub N ($ ) {
  no warnings;
  if (defined $_[0]) {
    if ($_[0]=~/$number_re/o) {
      return sprintf("%f", $_[0]);
    }

lib/Scalar/Quote.pm  view on Meta::CPAN

  'undef'
}
*quote_number=\&N;

# D computes the difference between two strings.
sub D ($$;$$ ) {
    no warnings 'uninitialized';
    return () if $_[0] eq $_[1];

    my $len=defined $_[3] ? $_[3] : 32;
    my $start=(defined $_[2] ? $_[2] : -8)

 view release on metacpan or  search on metacpan

t/context.t  view on Meta::CPAN

BEGIN { use_ok "Scope::Cleanup", qw(establish_cleanup); }

my @events;

sub aa(@) {
	push @events, [ "aa0", @_ ];
	establish_cleanup sub { push @events, [ "bb0", wantarray ] };
	push @events, [ "aa1" ];
	"aa2";
}

 view release on metacpan or  search on metacpan

t/block.t  view on Meta::CPAN

	[ "aa5", [ "aa2a", "aa2b" ] ],
	[ "bb0", [ "aa6a", "aa6b" ] ],
];

@events = ();
sub cc($) {
	block b;
	push @events, [ "cc0" ];
	$_[0]->();
	push @events, [ "cc1" ];
}

 view release on metacpan or  search on metacpan

t/cross_stacks.t  view on Meta::CPAN

BEGIN { Scope::Escape::_set_sanity_checking(1); }

my @events;
my $cont;

sub aa(@) {
	push @events, [ "aa0", @_ ];
	push @events, [ "aa1", $cont->(), "z" ];
	push @events, [ "aa2" ];
	return "aa3";
}

sub bb(@) {
	push @events, [ "bb0", @_ ];
	push @events, [ "bb1", $cont->("bb2"), "z" ];
	push @events, [ "bb3" ];
	return "bb4";
}

sub cc(@) {
	push @events, [ "cc0", @_ ];
	push @events, [ "cc1", $cont->("cc2", "cc3"), "z" ];
	push @events, [ "cc4" ];
	return "cc5";
}

sub dd($@) {
	my $aa = shift;
	$cont = current_escape_function;
	push @events, [ "dd0", @_ ];
	push @events, [ "dd1", (sort { $aa->(@_); 0 } 0, 0), "z" ];
	push @events, [ "dd2" ];
	return "dd3";
}

sub ee($@) {
	my $aa = shift;
	push @events, [ "ee0", @_ ];
	push @events, [ "ee1", dd($aa, @_), "z" ];
	push @events, [ "ee2", scalar(dd($aa, @_)), "z" ];
	push @events, [ "ee3", do { dd($aa, @_); "v" }, "z" ];

 view release on metacpan or  search on metacpan

t/10_Stat.t  view on Meta::CPAN

############################### TEST 29-30 #####################################
$F->File("> /tmp/__KEY__", "a,b,AAA\n");
$F->File("/tmp/__KEY__",   "a,c,BBB\n");

sub LC($) {
	my ($i) = @_;
	my @O;
	foreach my $l ( @{$i} )
	{
		push @O, lc $l;

 view release on metacpan or  search on metacpan

share/seislib/Test.pm  view on Meta::CPAN

        print "\n";
    }
    return $cond;
}

sub ok($cond, $desc) is export {
    proclaim(?$cond, $desc);
}

sub nok($cond, $desc=undef) is export {
    proclaim(!$cond, $desc);
}

sub is($x,$y, $desc=undef) is export {
    if (!proclaim($x eq $y, $desc)) {
        print "  GOT:      $x\n";
        print "  EXPECTED: $y\n";
    }
}

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

 view release on metacpan or  search on metacpan

t/01-number.t  view on Meta::CPAN

use Test::More tests => 188;

use Sidef;

sub re($) {
    qr/^\Q$_[0]\E\z/;
}

###############################################################################
# general tests

 view release on metacpan or  search on metacpan

lib/Silicon/Chip.pm  view on Meta::CPAN

Call as a sub not as a method
END
  "${c}_$i"
 }

sub nn(*$$)                                                                     # Gate name from double index.
 {my ($c, $i, $j) = @_;                                                         # Gate name, word number, bit number
  !@_ or !ref($_[0]) or confess confess <<"END";
Call as a sub not as a method
END
 "${c}_${i}_$j"

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

 view release on metacpan or  search on metacpan

xs/sc_ssl/openssl/source/crypto/aes/asm/aes-x86_64.pl  view on Meta::CPAN

$t2="%r12d";
$rnds="%r13d";
$sbox="%r14";
$key="%r15";

sub hi() { my $r=shift;	$r =~ s/%[er]([a-d])x/%\1h/;	$r; }
sub lo() { my $r=shift;	$r =~ s/%[er]([a-d])x/%\1l/;
			$r =~ s/%[er]([sd]i)/%\1l/;
			$r =~ s/%(r[0-9]+)[d]?/%\1b/;	$r; }
sub _data_word()
{ my $i;
    while(defined($i=shift)) { $code.=sprintf".long\t0x%08x,0x%08x\n",$i,$i; }

 view release on metacpan or  search on metacpan

scripts/iost+  view on Meta::CPAN

use Solaris::Kstat;
use POSIX qw(uname strftime);

################################################################################

sub ns($$)
{
my ($val, $width) = @_;
my $prec = $width - length(int($val)) - 1;
return(sprintf("%*.*f ", $width, $prec, $val));
}

 view release on metacpan or  search on metacpan

lib/Spreadsheet/Edit.pm  view on Meta::CPAN

  my $title_rx = $$self->{title_rx};
  my $r = defined($title_rx) ? $$self->{rows}->[$title_rx] : undef;
  log_methcall $self, [], [$r] if $$self->{verbose};
  $r
}
sub rx() { ${ &__selfmustonly }->{current_rx} }
sub crow() {
  my $self = &__selfmustonly;
  ${ $self->_onlyinapply("crow() method") }->{rows}->[$$self->{current_rx}]
}
sub linenum() {

 view release on metacpan or  search on metacpan

inc/Test/Base.pm  view on Meta::CPAN

    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

 view release on metacpan or  search on metacpan

example/gen-sample.pl  view on Meta::CPAN

USAGE
	exit 1;
};

# some useful functions absent in perl
sub pi() { 4*atan2 1,1};
sub atan($;$) {$_[1] = 1 unless defined $_[1]; return atan2 $_[0],$_[1]};

my @todo;
while (@ARGV) {
	my $n = shift;

 view release on metacpan or  search on metacpan

lib/Statistics/GammaDistribution.pm  view on Meta::CPAN

use strict;
use warnings;
use vars qw ( $VERSION );
$VERSION = 0.02;

sub PI(){ 3.14159265358979323846264338328; }
sub E() { 2.71828182845904523536028747135; }

sub new
{
    my ($caller,%args) = @_;

 view release on metacpan or  search on metacpan

lib/Statistics/RserveClient/REXP/List.pm  view on Meta::CPAN

}

# * Get the value for a given name entry, if list is not named, get the indexed element
# * @param string $name

sub at($) {
    my $self = shift;
    my $name = shift;

    if ( $self->is_named ) {
        my $i = array_search( $name, $self->names );

 view release on metacpan or  search on metacpan

t/06-aux-utility.t  view on Meta::CPAN

}
eval 'use Test::More tests => 6+6;';
use warnings;
no warnings 'once';
our $msg;
sub tt(&);
sub tt(&){
    my $sub = shift;
    my $s = ref_mem_safe( $sub );
    $msg = $s;
    return ($s)if $s;
    return undef;

 view release on metacpan or  search on metacpan

t/interpolate.t  view on Meta::CPAN

print "1..28\n";

my $testno;

sub t ($) {
    print "not " unless shift;
    print "ok ",++$testno,"\n";
}

my $i = String::Interpolate->new;

 view release on metacpan or  search on metacpan

lib/String/Smart.pm  view on Meta::CPAN

'absolute'. A path of transformations that will convert the string from
whatever its current encoding is will be computed and applied.

=cut

sub as($$) {
  my ( $desired, $str ) = @_;

  my @desired
   = map { split /_/ } 'ARRAY' eq ref $desired ? @$desired : $desired;

 view release on metacpan or  search on metacpan

lib/String/TT.pm  view on Meta::CPAN

    sub _build_tt_engine {
        return $engine ||= Template->new;
    }
}

sub tt($) {
    my $template = shift;
    confess 'Whoa there, I need a template' if !defined $template;

    my %vars = %{peek_my(1)||{}};
    my %transformed_vars;

 view release on metacpan or  search on metacpan

lib/Sub/Go.pm  view on Meta::CPAN

    my $self = ${ $self_ref };
    $self->{yielded} = 1;
    $self->{rest}->{code}->( @_ );
}

sub go(&;@) {
    my $code = shift;
    my $rest = shift;
    
    return bless { code => $code, rest => $rest }, __PACKAGE__;
}

sub by(&;@) {
    my ( $code, $rest ) = @_;
    return bless { code => $code, rest => $rest, by => 1 }, __PACKAGE__;
}

1;

 view release on metacpan or  search on metacpan

t/is_constant.t  view on Meta::CPAN

ok !sub_is_constant(\&t0);
ok !sub_is_constant(\&t1);
ok !sub_is_constant(\&t2);
ok sub_is_constant(\&t3);

sub mc($) { my $c = $_[0]; return sub () { $c } }

ok +(("$]" >= 5.019003 && "$]" < 5.020) xor sub_is_constant(mc(123)));

1;

 view release on metacpan or  search on metacpan

t/10_lexer.t  view on Meta::CPAN

    my $parser = FakeYappParser->new($text);
    return Sub::Multi::Tiny::SigParse::_next_token($parser);
} #FirstToken()

# Make a hashref representing a parameter
sub _p($$$) {
    +{ name=>$_[0], named=>!!$_[1], reqd=>!!$_[2] }
}

# --- Success tests ---------------------------------------------------

 view release on metacpan or  search on metacpan

t/is_constant.t  view on Meta::CPAN

ok !sub_is_constant(\&t0);
ok !sub_is_constant(\&t1);
ok !sub_is_constant(\&t2);
ok sub_is_constant(\&t3);

sub mc($) { my $c = $_[0]; return sub () { $c } }

ok +(("$]" >= 5.019003 && "$]" < 5.020) xor sub_is_constant(mc(123)));

1;

 view release on metacpan or  search on metacpan

t/11-existing.t  view on Meta::CPAN

sub foo { ok $call_foo, 'the preexistent foo was called' }

our $call_bar;
sub bar () { ok $call_bar, 'the preexistent bar was called' }

sub X () { 1 }

our $call_blech;
sub blech { ok $call_blech, 'initial blech was called' };

our $called;