Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 18f3b94af8
Fetching contributors…

Cannot retrieve contributors at this time

616 lines (491 sloc) 11.785 kb
#!./parrot
# Copyright (C) 2008-2011, Parrot Foundation.
=head1 NAME
t/op/io.t - Testing io opcodes
=head1 SYNOPSIS
% prove t/op/io.t
=head1 DESCRIPTION
Tests various io opcodes.
=cut
.loadlib 'io_ops'
.sub 'main' :main
.include 'test_more.pir'
plan(60)
read_on_null()
open_delegates_to_filehandle_pmc()
test_bad_open()
open_pipe_for_reading()
getfd_fdopen()
test_fdopen_p_i_sc()
test_fdopen_p_ic_s()
test_fdopen_p_ic_sc()
test_fdopen_p_i_s()
test_open_p_s_s()
test_seek_tell()
test_peek()
test_read()
printerr_tests()
stat_tests()
stdout_tests()
# must come after (these don't use test_more)
open_pipe_for_writing()
read_invalid_fh()
.end
.sub open_delegates_to_filehandle_pmc
load_bytecode 'P6object.pbc'
.local pmc p6meta, interp, classes, classid
p6meta = get_root_global ["parrot"], "P6metaclass"
p6meta.'new_class'('Testing')
interp = getinterp
classes = interp[0]
classid = classes['Testing']
$I0 = classes['FileHandle']
set classes['FileHandle'], classid
$P1 = open '/foo'
is($P1,42,'open opcode delegates to the open method on the FileHandle PMC')
# replace the original, so we don't break other tests
set classes['FileHandle'], $I0
.end
.sub 'test_bad_open'
null $S0
throws_substring(<<"CODE", "Invalid open", "bad open_p_s_s")
.sub main
$P0 = open $S0, $S0
.end
CODE
throws_substring(<<"CODE", "Invalid open", "bad open_p_sc_s")
.sub main
$P0 = open "", $S0
.end
CODE
throws_substring(<<"CODE", "Invalid open", "bad open_p_s_sc")
.sub main
$P0 = open $S0, ""
.end
CODE
# throws_substring(<<"CODE", "Invalid open", "bad open_p_sc_sc")
# .sub main
# $P0 = open "", ""
# .end
#CODE
throws_substring(<<"CODE", "Invalid open", "bad open_p_s")
.sub main
$P0 = open $S0
.end
CODE
# throws_substring(<<"CODE", "Invalid open", "bad open_p_sc")
# .sub main
# $P0 = open ""
# .end
#CODE
.end
.loadlib 'sys_ops'
.sub 'tt661_todo_test' :anon
# As of r41963, these tests need to be todo'ed at least on Win32. Add new
# platforms known to fail.
.include 'sysinfo.pasm'
$S0 = sysinfo .SYSINFO_PARROT_OS
if $S0 == 'MSWin32' goto tt661_todo
.return (0)
tt661_todo:
.return (1)
.end
.include 'iglobals.pasm'
.sub 'open_pipe_for_reading'
.local pmc interp
interp = getinterp
.local pmc conf
conf = interp[.IGLOBALS_CONFIG_HASH]
.local string command
command = '"'
$S0 = conf['build_dir']
command .= $S0
.local string aux
aux = conf['slash']
command .= aux
aux = conf['test_prog']
command .= aux
aux = conf['exe']
command .= aux
command .= '" -V'
.local pmc pipe
pipe = open command, 'rp'
unless pipe goto open_pipe_for_reading_failed
.local string line
line = readline pipe
line = substr line, 0, 14
is('This is Parrot', line, 'open pipe for reading')
.return ()
open_pipe_for_reading_failed:
nok(1, 'open pipe for reading')
.return ()
.end
.sub 'open_pipe_for_writing'
$I0 = tt661_todo_test()
if $I0 goto open_pipe_for_writing_todoed
.local pmc interp
interp = getinterp
.local pmc conf
conf = interp[.IGLOBALS_CONFIG_HASH]
.local string command
.local string aux
command = '"'
aux = conf['build_dir']
command .= aux
aux = conf['slash']
command .= aux
.local string filename
filename .= command
filename .= 'examples/pasm/cat.pasm'
aux = conf['test_prog']
command .= aux
aux = conf['exe']
command .= aux
command .= '" '
command .= filename
command .= '"'
.local pmc pipe
pipe = open command, 'wp'
unless pipe goto open_pipe_for_writing_failed
ok(1, 'open pipe for writing')
close pipe
.return ()
open_pipe_for_writing_failed:
nok(1, 'open pipe for writing')
.return ()
open_pipe_for_writing_todoed:
todo(0, 'Unimplemented in this platform, TT #661')
.end
# GH #465
.sub 'getfd_fdopen'
getstdout $P0
$I0 = $P0.'get_fd'()
fdopen $P1, $I0, 'w'
$I0 = defined $P1
ok($I0, 'fdopen - no close')
.end
.sub 'test_fdopen_p_i_sc'
$I0 = 1
fdopen $P0, $I0, 'w'
$I0 = defined $P0
ok($I0, 'fdopen_p_i_sc')
fdopen $P0, $I0, ''
$I0 = defined $P0
is($I0, 0, 'bad fdopen_p_i_sc')
.end
.sub 'test_fdopen_p_ic_s'
$S0 = 'w'
$S1 = ''
fdopen $P0, 1, $S0
$I0 = defined $P0
ok($I0, 'fdopen_p_ic_s')
fdopen $P0, 1, $S1
$I0 = defined $P0
is($I0, 0, 'bad fdopen_p_ic_s')
.end
.sub 'test_fdopen_p_ic_sc'
fdopen $P0, 1, 'w'
$I0 = defined $P0
ok($I0, 'fdopen_p_ic_sc')
fdopen $P0, 1, ''
$I0 = defined $P0
is($I0, 0, 'bad fdopen_p_ic_sc')
.end
.sub 'test_fdopen_p_i_s'
getstdout $P0
$S0 = 'w'
$S1 = ''
$I0 = $P0.'get_fd'()
fdopen $P1, $I0, $S0
$I0 = defined $P1
ok($I0, 'fdopen_p_i_s')
fdopen $P0, $I0, $S1
$I0 = defined $P0
is($I0, 0, 'bad fdopen_p_i_sc')
.end
.sub 'test_open_p_s_s'
$S0 = "README"
$S1 = "r"
$P0 = open $S0, $S1
$I0 = defined $P0
ok($I0, "open_p_s_s")
.end
.sub 'test_seek_tell'
$S0 = 'r'
$P0 = open "README", $S0
$I0 = tell $P0
is( $I0, 0, 'tell_i_p' )
$I0 = 4 # offset
$I1 = 1 # from current pos
$I4 = -10 # bad number
seek $P0, $I0, $I1
$I2 = tell $P0
is( $I2, $I0, 'seek_p_i_i' )
throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_i_i")
.sub main
seek $P0, $I4, $I4
.end
CODE
seek $P0, 4, $I1
$I2 = tell $P0
is( $I2, 8, 'seek_p_ic_i' )
throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_ic_i")
.sub main
seek $P0, -10, $I4
.end
CODE
seek $P0, $I0, 1
$I2 = tell $P0
is( $I2, 12, 'seek_p_i_ic' )
throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_i_ic")
.sub main
seek $P0, $I4, -10
.end
CODE
seek $P0, 4, 1
$I2 = tell $P0
is( $I2, 16, 'seek_p_ic_ic' )
throws_substring(<<"CODE", "seek failed (32bit)", "bad seek_p_ic_ic")
.sub main
seek $P0, -10, -10
.end
CODE
seek $P0, 0, $I0, $I1
$I2 = tell $P0
is( $I2, 20, 'seek_p_ic_i_i' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_ic_i_i")
.sub main
seek $P0, -10, $I4, $I4
.end
CODE
$I3 = 0 # high order intval
seek $P0, $I3, $I0, $I1
$I2 = tell $P0
is( $I2, 24, 'seek_p_i_i_i' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_i_i")
.sub main
seek $P0, $I4, $I4, $I4
.end
CODE
seek $P0, $I3, 4, $I1
$I2 = tell $P0
is( $I2, 28, 'seek_p_i_ic_i' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_ic_i")
.sub main
seek $P0, $I4, -10, $I4
.end
CODE
seek $P0, 0, 4, $I1
$I2 = tell $P0
is( $I2, 32, 'seek_p_ic_ic_i' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_ic_ic_i")
.sub main
seek $P0, -10, -10, $I4
.end
CODE
seek $P0, $I3, $I0, 1
$I2 = tell $P0
is( $I2, 36, 'seek_p_i_i_ic' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_i_ic")
.sub main
seek $P0, $I4, $I4, -10
.end
CODE
seek $P0, 0, $I0, 1
$I2 = tell $P0
is( $I2, 40, 'seek_p_ic_i_ic' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_ic_i_ic")
.sub main
seek $P0, -10, $I4, -10
.end
CODE
seek $P0, $I3, 4, 1
$I2 = tell $P0
is( $I2, 44, 'seek_p_i_ic_ic' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_ic_ic")
.sub main
seek $P0, $I4, -10, -10
.end
CODE
seek $P0, 0, 4, 1
$I2 = tell $I5, $P0
is( $I5, 48, 'seek_p_i_ic_ic' )
throws_substring(<<"CODE", "seek failed (64bit)", "bad seek_p_i_ic_ic")
.sub main
seek $P0, -10, -10, -10
.end
CODE
.end
.sub 'test_peek'
.include 'stat.pasm'
$I0 = stat 'README', .STAT_FILESIZE
$P0 = open 'README', 'r'
close $P0
$P1 = getstdin
setstdin $P0
$S0 = peek
$I1 = isnull $S0
ok($I1, 'can peek_s closed file')
$S0 = peek $P0
$I1 = isnull $S0
ok($I1, 'can peek_s_p closed file')
setstdin $P1
.end
.sub 'test_read'
getstdin $P1
$P0 = open 'README', 'r'
$I0 = 4
setstdin $P0
ok(1, 'can setstdin')
$S0 = read $I0
$I1 = tell $P0
is( $I1, 4, 'read_s_i' )
$S0 = read 4
$I1 = tell $P0
is( $I1, 8, 'read_s_ic' )
setstdin $P1
$S0 = read $P0, $I0
$I1 = tell $P0
is( $I1, 12, 'read_s_p_i' )
$S0 = read $P0, 4
$I1 = tell $P0
is( $I1, 16, 'read_s_p_i' )
.end
.sub 'read_on_null'
.const string description = "read on null PMC throws exception"
push_eh eh
null $P1
$S0 = read $P1, 1
ok(0, description)
goto ret
eh:
ok(1, description)
ret:
pop_eh
.return ()
.end
.sub 'read_invalid_fh'
$P0 = new ['FileHandle']
push_eh _readline_handler
$S0 = readline $P0
print "not "
_readline_handler:
ok(1, '_readline_handler')
pop_eh
push_eh _read_handler
$S0 = read $P0, 1
print "not "
_read_handler:
ok(1, '_read_handler')
pop_eh
push_eh _print_handler
print $P0, "kill me now\n"
print "not "
_print_handler:
ok(1, '_print_handler')
pop_eh
.end
.sub 'printerr_tests'
# temporarily capture stderr
$P0 = getstderr
$P1 = new ['StringHandle']
$S0 = null
$P1.'open'($S0, 'w')
setstderr $P1
$I1 = 10
$N1 = 1.0
$S1 = "foo"
$P2 = new ['String']
$P2 = "This is a test\n"
printerr 10
printerr "\n"
printerr $I1
printerr "\n"
printerr 1.0
printerr "\n"
printerr $N1
printerr "\n"
printerr "foo"
printerr "\n"
printerr $S1
printerr "\n"
printerr $P2
# restore stderr
setstderr $P0
$S0 = $P1.'readall'()
is($S0, <<'OUTPUT', 'printerr opcode')
10
10
1
1
foo
foo
This is a test
OUTPUT
.end
.sub 'stat_tests'
.const string description = 'stat failed'
.include "stat.pasm"
$S0 = sysinfo .SYSINFO_PARROT_OS
if $S0 == 'MSWin32' goto run_win32_stat_tests
goto run_unix_stat_tests
run_win32_stat_tests:
$I0 = stat "parrot.exe", .STAT_FILESIZE
ok(1, 'can stat_i_sc_ic')
$S0 = 'parrot.exe'
$I0 = stat $S0, $I1
ok(1, 'can stat_i_s_i')
$I1 = .STAT_FILESIZE
$I0 = stat 'parrot.exe', $I1
ok(1, 'can stat_i_sc_i')
goto done_stat_filename_tests
run_unix_stat_tests:
$I0 = stat "parrot", .STAT_FILESIZE
ok(1, 'can stat_i_sc_ic')
$S0 = 'parrot'
$I0 = stat $S0, $I1
ok(1, 'can stat_i_s_i')
$I1 = .STAT_FILESIZE
$I0 = stat 'parrot', $I1
ok(1, 'can stat_i_sc_i')
done_stat_filename_tests:
throws_substring(<<"CODE", description, "bad stat_i_sc_ic")
.sub main
$I0 = stat 'no_such_file', .STAT_FILESIZE
.end
CODE
throws_substring(<<"CODE", description, "bad stat_i_s_i")
.sub main
$I1 = .STAT_FILESIZE
$S0 = 'no_such_file'
$I0 = stat $S0, $I1
.end
CODE
.end
.sub stdout_tests
.local pmc oslib
.local pmc os
oslib = loadlib 'os'
os = new ['OS']
$P0 = getstdout
$P1 = open 'test_file', 'w'
setstdout $P1
say 'test'
setstdout $P0
close $P1
$P1 = open 'test_file', 'r'
$S0 = $P1.'read'(4)
close $P1
os.'rm'('test_file')
is($S0, 'test', 'setstdout')
.end
.namespace ["Testing"]
.sub open :method
.param pmc args :slurpy
.return(42)
.end
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir:
Jump to Line
Something went wrong with that request. Please try again.