152 lines
2.3 KiB
Perl
Executable File
152 lines
2.3 KiB
Perl
Executable File
#!./perl
|
|
|
|
BEGIN {
|
|
chdir 't' if -d 't';
|
|
unshift @INC, '../lib';
|
|
}
|
|
|
|
my @expect;
|
|
my $data = "";
|
|
my @data = ();
|
|
my $test = 1;
|
|
|
|
sub ok { print "not " unless shift; print "ok ",$test++,"\n"; }
|
|
|
|
package Implement;
|
|
|
|
BEGIN { *ok = \*main::ok }
|
|
|
|
sub compare {
|
|
return unless @expect;
|
|
return ok(0) unless(@_ == @expect);
|
|
|
|
my $i;
|
|
for($i = 0 ; $i < @_ ; $i++) {
|
|
next if $_[$i] eq $expect[$i];
|
|
return ok(0);
|
|
}
|
|
|
|
ok(1);
|
|
}
|
|
|
|
sub TIEHANDLE {
|
|
compare(TIEHANDLE => @_);
|
|
my ($class,@val) = @_;
|
|
return bless \@val,$class;
|
|
}
|
|
|
|
sub PRINT {
|
|
compare(PRINT => @_);
|
|
1;
|
|
}
|
|
|
|
sub PRINTF {
|
|
compare(PRINTF => @_);
|
|
2;
|
|
}
|
|
|
|
sub READLINE {
|
|
compare(READLINE => @_);
|
|
wantarray ? @data : shift @data;
|
|
}
|
|
|
|
sub GETC {
|
|
compare(GETC => @_);
|
|
substr($data,0,1);
|
|
}
|
|
|
|
sub READ {
|
|
compare(READ => @_);
|
|
substr($_[1],$_[3] || 0) = substr($data,0,$_[2]);
|
|
3;
|
|
}
|
|
|
|
sub WRITE {
|
|
compare(WRITE => @_);
|
|
$data = substr($_[1],$_[3] || 0, $_[2]);
|
|
length($data);
|
|
}
|
|
|
|
sub CLOSE {
|
|
compare(CLOSE => @_);
|
|
|
|
5;
|
|
}
|
|
|
|
package main;
|
|
|
|
use Symbol;
|
|
|
|
print "1..29\n";
|
|
|
|
my $fh = gensym;
|
|
|
|
@expect = (TIEHANDLE => 'Implement');
|
|
my $ob = tie *$fh,'Implement';
|
|
ok(ref($ob) eq 'Implement');
|
|
ok(tied(*$fh) == $ob);
|
|
|
|
@expect = (PRINT => $ob,"some","text");
|
|
$r = print $fh @expect[2,3];
|
|
ok($r == 1);
|
|
|
|
@expect = (PRINTF => $ob,"%s","text");
|
|
$r = printf $fh @expect[2,3];
|
|
ok($r == 2);
|
|
|
|
$text = (@data = ("the line\n"))[0];
|
|
@expect = (READLINE => $ob);
|
|
$ln = <$fh>;
|
|
ok($ln eq $text);
|
|
|
|
@expect = ();
|
|
@in = @data = qw(a line at a time);
|
|
@line = <$fh>;
|
|
@expect = @in;
|
|
Implement::compare(@line);
|
|
|
|
@expect = (GETC => $ob);
|
|
$data = "abc";
|
|
$ch = getc $fh;
|
|
ok($ch eq "a");
|
|
|
|
$buf = "xyz";
|
|
@expect = (READ => $ob, $buf, 3);
|
|
$data = "abc";
|
|
$r = read $fh,$buf,3;
|
|
ok($r == 3);
|
|
ok($buf eq "abc");
|
|
|
|
|
|
$buf = "xyzasd";
|
|
@expect = (READ => $ob, $buf, 3,3);
|
|
$data = "abc";
|
|
$r = sysread $fh,$buf,3,3;
|
|
ok($r == 3);
|
|
ok($buf eq "xyzabc");
|
|
|
|
$buf = "qwerty";
|
|
@expect = (WRITE => $ob, $buf, 4,1);
|
|
$data = "";
|
|
$r = syswrite $fh,$buf,4,1;
|
|
ok($r == 4);
|
|
ok($data eq "wert");
|
|
|
|
$buf = "qwerty";
|
|
@expect = (WRITE => $ob, $buf, 4);
|
|
$data = "";
|
|
$r = syswrite $fh,$buf,4;
|
|
ok($r == 4);
|
|
ok($data eq "qwer");
|
|
|
|
$buf = "qwerty";
|
|
@expect = (WRITE => $ob, $buf, 6);
|
|
$data = "";
|
|
$r = syswrite $fh,$buf;
|
|
ok($r == 6);
|
|
ok($data eq "qwerty");
|
|
|
|
@expect = (CLOSE => $ob);
|
|
$r = close $fh;
|
|
ok($r == 5);
|