Perl6-Pugs

 view release on metacpan or  search on metacpan

misc/old_pugs_perl5_backend/pilrun2-leftovers/api.pl  view on Meta::CPAN

    Carp::confess "bug >$name<";
}
sub p6_var_CODE {
    my($name)=@_;
    my $mn = p6_mangle($name);
    "(do{no strict;defined(\$$mn)?\$$mn:p6__lookup('$mn','$name')})";
}
sub p6_var { # XXX - not quite the right thing
    my($name)=@_;
    my $mn = p6_mangle($name);
    my $pkg = (caller)[0];
    #my $ret = eval "package $pkg;".<<'    END';
    #  no strict;defined($$mn)?$$mn:p6__lookup('$mn','$name')
    #END
    #die "p6_var: bug: $@" if $@;
    #$ret;
    my $look = "${pkg}::p6__lookup";
    no strict 'refs';
    &$look($mn,$name);
}
sub p6_setq  {

misc/pX/Common/Regexp-Test-Perl5Tests/t/op/pat.t  view on Meta::CPAN

my $test = 687;

# Force scalar context on the patern match
sub ok ($$) {
    my($ok, $name) = @_;

    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name;

    printf "# Failed test at line %d\n", (caller)[2] unless $ok;

    $test++;
    return $ok;
}

{
    # Check that \x## works. 5.6.1 and 5.005_03 fail some of these.
    $x = "\x4e" . "E";
    ok ($x =~ /^\x4EE$/, "Check only 2 bytes of hex are matched.");

misc/pX/Common/Regexp-Test-Perl5Tests/t/op/taint.t  view on Meta::CPAN

sub test ($;$) {
    my($ok, $diag) = @_;

    my $curr_test = curr_test();

    if ($ok) {
	print "ok $curr_test\n";
    } else {
	print "not ok $curr_test\n";
        printf "# Failed test at line %d\n", (caller)[2];
	for (split m/^/m, $diag) {
	    print "# $_";
	}
	print "\n" unless
	    $diag eq ''
	    or substr($diag, -1) eq "\n";
    }

    next_test();

perl5/Pugs-Compiler-Perl6/old/v6.pm  view on Meta::CPAN

package v6;

# invokes the Perl6-to-Perl5 compiler and creates a .pmc file

use strict;
use warnings;

my $filename = (caller)[1];
my $pmc = $filename;
$pmc =~ s/\.(pl|pm|t)$/\.pmc/;
die "this is not a .pl, .t or .pm file"
    unless $pmc =~ /\.pmc/;
# test file dates
my $pmc_is_uptodate = (-s $pmc and (-M $pmc <= -M $filename));
# print "up to date: $pmc_is_uptodate\n";
if ( $pmc_is_uptodate ) {
    do $pmc 
        unless $filename =~ /\.pm$/;

perl5/Pugs-Emitter-Perl6-Perl5/lib/Pugs/Emitter/Perl6/Perl5/node.pm  view on Meta::CPAN

sub root {
    'Pugs::Emitter::Perl6::Perl5::'
}

sub node {
    ( $_[0]->root . $_[1] )->new( { name => $_[2] } );
}

sub ::unicode_sub($&) {
    my $name = (caller)[0] . '::' . Pugs::Runtime::Common::mangle_ident($_[0]);
    #print "Name: $name \n";
    no strict 'refs';
    *{$name} = $_[1]; 
}

sub new {
    my $self = $_[1];  # { name => '$scalar5' }
    bless $self, $_[0];
    return $self;
}