view release on metacpan or  search on metacpan

t/1.t  view on Meta::CPAN

# $Id: test.pl,v 1.2 2002/09/03 18:26:11 jaldhar Exp $
#
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

use Test::More tests => 6;
BEGIN { use_ok('Acme::Brainfuck', qw/verbose/) };

my $a = +++[>+++<-]> ;
ok ( $a == 9, ' Do + - < > [ ] work?');

$a = "\t";
tie *STDIN, 'Tie::Handle::Scalar', \$a;
my $b = , ;
ok ( $b == 9, ' Does , work?');
untie *STDIN;

$a = '';
tie *STDOUT, 'Tie::Handle::Scalar', \$a;
..
ok ( $a eq "\t\t", ' Does . work?');
untie *STDOUT;

$a = '';
tie *STDERR, 'Tie::Handle::Scalar', \$a;
#
ok ( $a eq "\$p = 1 \$m[\$p]= 9\n", ' Does # work?');
untie *STDERR;

$a = ~ ;
ok ( $a == 0, ' Does ~ work?');

no Acme::Brainfuck;

#
#  This is Tie::Handle::Scalar
#  It is reproduced in full here as it isn't a core module so it may not
#  be installed everywhere.
#

package Tie::Handle::Scalar;
use base 'Tie::Handle';
use Carp;
use FileHandle;

sub TIEHANDLE {
	my $class = bless {}, shift;

	my ($stringref) = @_;

	if (! defined($stringref)) {
		my $temp_s = '';
		$stringref = \$temp_s;
	}

	if (ref($stringref) ne "SCALAR") {
		croak "need a reference to a scalar,";
	}

	$class->{position} = 0;
	$class->{data} = $stringref;
	$class->{end} = 0;
	my $tmpfile = $class->{tmpfile} = '.tmp.' . $$;
	$class->{fh} = new FileHandle "$tmpfile", 
		O_RDWR|O_CREAT or croak "$tmpfile: $!";
	$class->{FILENO} = $class->{fh}->fileno();
	$class;
}

sub FILENO {
	my $class = shift;
	return $class->{FILENO};
}

sub WRITE {
	my $class = shift;
	my($buf,$len,$offset) = @_;
        $offset = 0 if (! defined $offset);
    	my $data = substr($buf, $offset, $len);
    	my $n = length($data);
    	$class->print($data);
        return $n;
}

sub PRINT {
	my $class = shift;
        ${$class->{data}} .= join('', @_);
    	$class->{position} = length(${$class->{data}});
    	1;
}

sub PRINTF {
	my $class = shift;
	my $fmt = shift;
	$class->PRINT(sprintf $fmt, @_);
}

sub READ {
	my $class = shift;

	my ($buf,$len,$offset) = @_;
    	$offset = 0 if (! defined $offset);

    	my $data = ${ $class->{data} };

    	if ($class->{end} >= length($data)) {
		return 0;
	}
	$buf = substr($data,$offset,$len);
        $_[0] = $buf;
        $class->{end} += length($buf);
        return length($buf);
}

sub READLINE {
	my $class = shift;
	if ($class->{end} >= length(${ $class->{data} })) {
		return undef;
	}
	my $recsep = $/;
	my $rod = substr(${ $class->{data} }, $class->{end}, -1);
	$rod =~ m/^(.*)$recsep{0,1}/; # use 0,1 for line sep to include possible no \n on last line
	my $line = $1 . $recsep;
	$class->{end} += length($line);
	return $line;
}

sub CLOSE {
	my $class = shift;
	if (-e $class->{tmpfile}) {
		$class->{fh}->close();
		unlink $class->{tmpfile} or warn $!;
	}
	$class = undef;
	1;
}

sub DESTROY {
	my $class = shift;
	if (-e $class->{tmpfile}) {
		unlink $class->{tmpfile} or warn $!;
	}
	$class = undef;
	1;undef $class;
}