#! perl
# Copyright (C) 2001-2008, The Perl Foundation.
# $Id$

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );

use Test::More;
use Parrot::Test tests => 45;

=head1 NAME

t/pmc/io.t - IO Ops

=head1 SYNOPSIS

    % prove t/pmc/io.t

=head1 DESCRIPTION

Tests the Parrot IO operations.

=cut

sub file_content_is {
    my ( $file, $content, $name ) = @_;
    local $/ = undef;    # slurp mode
    open my $FOO, '<', "temp.file";

    is( <$FOO>, $content, $name );

    close $FOO;
}

TODO: {
    local $TODO = "IO on some invalid types";

    pir_output_is( <<'CODE', <<'OUTPUT', "IO on some invalid types" );
.sub main
    $P0 = null
    test($P0, "Undef")
    new $P0, 'Integer'
    test($P0, "null")
    new $P0, 'Undef'
    test($P0, "Integer")
    new $P0, 'String'
    test($P0, "String")
.end
.sub test
    .param pmc io
    .param string name

    print name
    read $S0, io, 1
    length $I0, $S0
    if $I0 == 0 goto ok1
    print " not"
ok1:
    print " ok 1\n"

    print name
    # what should happen here?
    close io
    print " ok 2\n"

    print name
    # what should happen here?
    print io, "not"
    print " ok 3\n"
.end
CODE
Undef ok 1
Undef ok 2
Undef ok 3
null ok 1
null ok 2
null ok 3
Integer ok 1
Integer ok 2
Integer ok 3
String ok 1
String ok 2
String ok 3
OUTPUT
}

pasm_output_is( <<'CODE', <<'OUTPUT', "open/close" );
    open P0, "temp.file", ">"
    print P0, "a line\n"
    close P0
    open P0, "temp.file", "<"
    read S0, P0, 20
    print S0
    end
CODE
a line
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "timely destruction" );
    interpinfo I0, 2	# DOD runs
    open P0, "temp.file", ">"
        needs_destroy P0
    print P0, "a line\n"
    null P0			# kill it
    sweep 0			# a lazy DOD has to close the PIO
    open P0, "temp.file", "<"
    read S0, P0, 20
    print S0
    end
CODE
a line
OUTPUT

# RT#46843
pir_output_is( <<'CODE', <<'OUTPUT', "get_fd()/fdopen" );
.sub main :main
    getstdout P0
    I0 = P0.get_fd()
    fdopen P1, I0, ">"
    defined I0, P1
    unless I0, nok
    print P1, "ok\n"
    close P1
    end
nok:
    print "fdopen failed\n"
.end
CODE
ok
OUTPUT

# RT#46843
pir_output_is( <<'CODE', <<'OUTPUT', 'fdopen - no close' );
.sub main :main
    getstdout P0
    I0 = P0.get_fd()
    fdopen P1, I0, ">"
    defined I0, P1
    unless I0, nok
    print P1, "ok\n"
    end
nok:
    print "fdopen failed\n"
.end
CODE
ok
OUTPUT

unlink "no_such_file" if ( -e "no_such_file" );

pasm_output_is( <<'CODE', <<'OUTPUT', "get_bool" );
    open P0, "no_such_file", "<"
    unless P0, ok1
    print "Huh: 'no_such_file' exists? - not "
ok1:
    print "ok 1\n"
    open P0, "temp.file", "<"
    if P0, ok2
    print "not "
ok2:    print "ok 2\n"
    read S0, P0, 1024
    read S0, P0, 1024
    unless P0, ok3
    print "not "
ok3:    print "ok 3\n"
    defined I0, P0
    if I0, ok4
    print "not "
ok4:    print "ok 4\n"
    close P0
    defined I0, P0		# closed file is still defined
    if I0, ok5
    print "not "
ok5:    print "ok 5\n"
    unless P0, ok6		# but false
    print "not "
ok6:    print "ok 6\n"
    end
CODE
ok 1
ok 2
ok 3
ok 4
ok 5
ok 6
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "read on invalid fh should throw exception" );
    open P0, "no_such_file", "<"
    unless P0, ok1
    print "Huh: 'no_such_file' exists? - not "
ok1:
    print "ok 1\n"

        push_eh _readline_handler
        readline S0, P0 # Currently segfaults
        print "not "
_readline_handler:
        print "ok 2\n"
    branch fin

        push_eh _read_handler
        read S0, P0, 1
        print "not "
_read_handler:
        print "ok 3\n"

        push_eh _print_handler
        print P0, "kill me now\n"
        print "not "
_print_handler:
fin:
        print "ok 4\n"

        end
CODE
ok 1
ok 2
ok 4
OUTPUT

SKIP: {
    skip( "clone not finished yet", 1 );
    pasm_output_is( <<'CODE', <<'OUTPUT', "clone" );
    open P0, "temp.file", "<"
    clone P1, P0
    read S0, P1, 1024
    print S0
    end
CODE
a line
OUTPUT
}

# It would be very embarrassing if these didnt work...
open my $FOO, '>', "temp.file" or die "can't open 'temp.file': $!";
print $FOO "2\n1\n";
close $FOO;
pasm_output_is( <<'CODE', <<'OUTPUT', "open and readline" );
    open P0, "temp.file"
    set S0, ""
    set S1, ""
    readline S0, P0
    readline S1, P0
    print S1
    print S0
    end
CODE
1
2
OUTPUT

open $FOO, '>', "temp.file" or die "can't open 'temp.file': $!";
print $FOO "12\n34";
close $FOO;
pasm_output_is( <<'CODE', <<'OUTPUT', "open and readline, no final newline" );
    open P0, "temp.file"
    set S0, ""
    set S1, ""
    readline S0, P0
    readline S1, P0
    print S1
    print S0
    end
CODE
3412
OUTPUT

open $FOO, '>', "temp.file";    # Clobber previous contents
close $FOO;

pasm_output_is( <<'CODE', <<'OUTPUT', "open & print" );
       set I0, -12
       set N0, 2.2
       set S0, "Foo"
       new P0, 'String'
       set P0, "Bar\n"

       open P1, "temp.file"
       print P1, I0
       print P1, N0
       print P1, S0
       print P1, P0
       close P1

       open P2, "temp.file"
       readline S1, P2
       close P2

       print S1
       end
CODE
-122.200000FooBar
OUTPUT

open $FOO, '>', "temp.file";    # Clobber previous contents
close $FOO;

# write to file opened for reading
pasm_output_is( <<'CODE', <<'OUTPUT', "3-arg open" );
       open P1, "temp.file", "<"
       print P1, "Foobar\n"
       close P1

       open P3, "temp.file", "<"
       readline S1, P3
       close P3

       print S1
       print "writing to file opened for reading\n"
       end
CODE
writing to file opened for reading
OUTPUT

unlink("temp.file");

pasm_output_is( <<'CODE', <<'OUTPUT', 'open and close' );
       open P1, "temp.file"
       print P1, "Hello, World!\n"
       close P1
       print "done\n"
       end
CODE
done
OUTPUT

file_content_is( "temp.file", <<'OUTPUT', 'file contents' );
Hello, World!
OUTPUT

pasm_output_is( <<'CODE', '', 'append' );
       open P1, "temp.file", ">>"
       print P1, "Parrot flies\n"
       close P1
       end
CODE

file_content_is( "temp.file", <<'OUTPUT', 'append file contents' );
Hello, World!
Parrot flies
OUTPUT

pasm_output_is( <<'CODE', '', 'write to file' );
       open P1, "temp.file", ">"
       print P1, "Parrot overwrites\n"
       close P1
       end
CODE

file_content_is( "temp.file", <<'OUTPUT', 'file contents' );
Parrot overwrites
OUTPUT

unlink("temp.file");

pasm_output_is( <<'CODE', '', "PIO_flush on buffer full" );
       set I0, 0
       set I1, 10000

       open P0, "temp.file", ">"

PRINT:
       ge I0, I1, END
       print P0, "words\n"
       inc I0
       branch PRINT

END:
       close P0
       end
CODE

file_content_is( "temp.file", <<'OUTPUT' x 10000, 'buffered file contents' );
words
OUTPUT

unlink("temp.file");

pasm_output_is( <<'CODE', '0', "turn off buffering" );
       open P0, "temp.file", ">"

#                     PIOCTL_CMDSETBUFTYPE, PIOCTL_NONBUF
       pioctl I0, P0, 3, 0
#                     PIOCTL_CMDGETBUFTYPE, <dummy value>
       pioctl I0, P0, 4, 0
       print I0

       print P0, "Howdy World\n"

       close P0
       end
CODE

file_content_is( "temp.file", <<'OUTPUT', 'unbuffered file contents' );
Howdy World
OUTPUT

unlink("temp.file");

pir_output_is( <<'CODE', <<'OUTPUT', 'I/O buffering' );
.sub main
    .local string filename
    filename = "temp.file"
    $P1 = open filename, ">"
    .local int count, max, nltest
    count = 0
    max = 10000
  LOOP:
    if count > max goto DONE
    $S1 = count
    $S1 = concat $S1, " "
    print $P1, $S1
    inc count
    nltest = mod count, 20
    if nltest goto LOOP
    print $P1, "\n"
    goto LOOP
  DONE:
    print $P1, "\n"
    close $P1

  PART_2:
    $P1 = open filename
    $I0 = 0
  LINE:
    $S1 = readline $P1
    unless $S1 goto SUCCESS
    chopn $S1, 1

  NEXT_NR:
    $I1 = length $S1
    if $I1 <= 1 goto LINE
    $S2 = ""
  SPLIT:
    $S3 = substr $S1, 0, 1
    $S1 = substr 0, 1, ""
    if $S3 == " " goto GOT_NR
    $S2 = concat $S2, $S3
    goto SPLIT
  GOT_NR:
    $I1 = $S2
    if $I0 != $I1 goto FAILED
    inc $I0
    goto NEXT_NR

  FAILED:
    print "Failed\n"
    goto EXIT
  SUCCESS:
    print "Successful\n"
  EXIT:
    end
.end
CODE
Successful
OUTPUT

unlink("temp.file");

# RT#46843
pir_output_is( <<'CODE', <<'OUT', 'standard file descriptors' );
.sub main :main
       getstdin P0
       I0 = P0.get_fd()
       # I0 is 0 on Unix and non-Null on stdio and win32
       print "ok 1\n"
       getstdout P1
       I1 = P1.get_fd()
       if I1, OK_2
       print "not "
OK_2:  print "ok 2\n"
       getstderr P2
       I2 = P2.get_fd()
       if I2, OK_3
       print "not "
OK_3:  print "ok 3\n"
.end
CODE
ok 1
ok 2
ok 3
OUT

pasm_output_is( <<'CODE', <<'OUTPUT', 'printerr' );
       new P0, 'String'
       set P0, "This is a test\n"
       printerr 10
       printerr "\n"
       printerr 1.0
       printerr "\n"
       printerr "foo"
       printerr "\n"
       printerr P0
       end
CODE
10
1.000000
foo
This is a test
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', 'puts method' );
       getstdout P2
       can I0, P2, "puts"
       if I0, ok1
       print "not "
ok1:   print "ok 1\n"
       set_args "0,0", P2, "ok 2\n"
       callmethodcc P2, "puts"
       end
CODE
ok 1
ok 2
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', 'puts method - PIR' );

.sub main :main
       .local string s
       s = "ok 2\n"
       .local pmc io
       io = getstdout
       $I0 = can io, "puts"
       if $I0 goto ok1
       print "not "
ok1:   print "ok 1\n"
       io."puts"(s)
.end

CODE
ok 1
ok 2
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', 'callmethod puts' );
       getstderr P2	# the object
       set S0, "puts"	# method
       set S5, "ok 1\n"	# 2nd param
       set_args "0,0", P2, S5
       callmethodcc P2, S0
       set S5, "ok 2\n"
       set_args "0,0", P2, S5
       callmethodcc P2, S0
       end
CODE
ok 1
ok 2
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', 'seek/tell' );
       open P0, "temp.file", ">"
       print P0, "Hello "
       tell I0, P0
       print P0, "World!"
       seek P0, I0, 0
       print P0, "Parrot!\n"
       close P0
       print "ok 1\n"
       open P0, "temp.file", "<"
       read S0, P0, 65635
       print S0
       end
CODE
ok 1
Hello Parrot!
OUTPUT

pasm_error_output_like( <<'CODE', <<'OUTPUT', '32bit seek: exception' );
       open P0, "temp.file", ">"
       seek P0, -1, 0
       print "error!\n"
       end
CODE
/seek failed \(32bit\)/
OUTPUT

pasm_error_output_like( <<'CODE', <<'OUTPUT', '64bit seek: exception' );
       open P0, "temp.file", ">"
       seek P0, -1, -1, 0
       print "error!\n"
       end
CODE
/seek failed \(64bit\)/
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "peek" );
        open P0, "temp.file", ">"
        print P0, "a line\n"
        close P0
        open P0, "temp.file", "<"
        peek S0, P0
        print S0
        peek S1, P0
        print S1
        print "\n"
        read S2, P0, 2
        peek S3, P0
        print S3
        print "\n"
        end
CODE
aa
l
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "peek on an empty file" );
        open P0, "temp.file", ">"
        close P0
        open P0, "temp.file", "<"
        peek S0, P0
        eq S0, "", OK1
        print "not "
OK1:    print "ok 1\n"
        end
CODE
ok 1
OUTPUT

unlink "temp.file";

pasm_output_like( <<'CODE', <<'OUTPUT', "layer names" );
    getstdin P0
    set S0, P0[0]
    print S0
    print "-"
    set S0, P0[1]
    print S0
    print "-"
    set S0, P0[-1]
    print S0
    print "-"
    set S0, P0[-2]
    print S0
    print "-"
    set S0, P0[-3]
    print S0
    print "-"
    end
CODE
/^(unix|win32|stdio)-buf-buf-\1--$/
OUTPUT

pasm_output_is( <<'CODE', <<'OUTPUT', "layer push, pop" );
    getstdin P0
    push P0, "utf8"
    set S0, P0[-1]
    print S0
    print "\n"
    pop S1, P0
    print S1
    print "\n"
    set S0, P0[-1]
    print S0
    print "\n"
    end
CODE
utf8
utf8
buf
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', "substr after reading from file" );

.sub _main
    # Write something into a file
    .local pmc out
    out = open "temp.file", ">"
    print out, "0123456789\n"
    close out

    # read file contents back in
    .local pmc in
    in = open "temp.file", "<"
    .local string from_file
    from_file = read in, 20

    # Extract part of the read in file
    .local string head_from_file
    substr head_from_file, from_file, 0, 5, ''
    print head_from_file
    print "\n"

    end
.end
CODE
01234
OUTPUT

pir_output_is( <<'CODE', <<'OUTPUT', "multiple substr after reading from file" );

.sub _main
    # Write something into a file
    .local pmc out
    out = open "temp.file", ">"
    print out, "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ\n"
    close out

    .local pmc in
    .local string line
    in = open 'temp.file', '<'
    line = read in, 50000
    close in

    .local string sub_1
    sub_1 = ''
    .local string sub_2
    sub_2 = ''
    .local string sub_3
    sub_3 = ''
    substr sub_1, line, 0, 3
    substr sub_2, line, 0, 3, ''
    substr sub_3, line, 0, 3, ''
    print "line: "
    print line
    print "sub_1: "
    print sub_1
    print "\n"
    print "sub_2: "
    print sub_2
    print "\n"
    print "sub_3: "
    print sub_3
    print "\n"

  end
.end
CODE
line: 6789ABCDEFGHIJKLMNOPQRSTUVWXYZ
sub_1: 012
sub_2: 012
sub_3: 345
OUTPUT

pir_output_like(
    <<'CODE', <<'OUT', 'read on null PMC throws exception', todo => 'not yet implemented' );
.sub main :main
	null $P1
	$S0 = read $P1, 1
	end
.end
CODE
/some crazy exception/
OUT

open $FOO, '>', "temp.file";    # write utf8
print $FOO "T\xc3\xb6tsch\n";
close $FOO;

pir_output_is( <<'CODE', <<"OUTPUT", "utf8 read layer" );
.sub main :main
    .local pmc pio
    .local int len
    .include "stat.pasm"
    .local string f
    f = 'temp.file'
    len = stat f, .STAT_FILESIZE
    pio = open f, "<"
    push pio, "utf8"
    $S0 = read pio, len
    close pio
    $I1 = charset $S0
    $S2 = charsetname $I1
    print $S2
    print "\n"
    $I1 = encoding $S0
    $S2 = encodingname $I1
    print $S2
    print "\n"
    $I1 = find_charset 'iso-8859-1'
    trans_charset $S1, $S0, $I1
    print $S1
.end
CODE
unicode
utf8
T\xf6tsch
OUTPUT

pir_output_is( <<'CODE', <<"OUTPUT", "utf8 read layer - readline" );
.sub main :main
    .local pmc pio
    .local string f
    f = 'temp.file'
    pio = open f, "<"
    push pio, "utf8"
    $S0 = readline pio
    close pio
    $I1 = charset $S0
    $S2 = charsetname $I1
    print $S2
    print "\n"
    $I1 = encoding $S0
    $S2 = encodingname $I1
    print $S2
    print "\n"
    $I1 = find_charset 'iso-8859-1'
    trans_charset $S1, $S0, $I1
    print $S1
.end
CODE
unicode
utf8
T\xf6tsch
OUTPUT
pir_output_is( <<'CODE', <<"OUTPUT", "utf8 read layer, read parts" );
.sub main :main
    .local pmc pio
    .local int len
    .include "stat.pasm"
    .local string f
    f = 'temp.file'
    len = stat f, .STAT_FILESIZE
    pio = open f, "<"
    push pio, "utf8"
    $S0 = read pio, 2
    len -= 2
    $S1 = read pio, len
    $S0 .= $S1
    close pio
    $I1 = charset $S0
    $S2 = charsetname $I1
    print $S2
    print "\n"
    $I1 = encoding $S0
    $S2 = encodingname $I1
    print $S2
    print "\n"
    $I1 = find_charset 'iso-8859-1'
    trans_charset $S1, $S0, $I1
    print $S1
.end
CODE
unicode
utf8
T\xf6tsch
OUTPUT

pir_output_is( <<'CODE', <<"OUTPUT", "string read/write layer" );
.sub main :main
    .local pmc    pio
	.local string greeting
	.local string layer

    pio = getstdout
    push pio, "string"
	print "Hello"
	print ", "
	print "world!"
	print "\n"

	greeting = read pio, 1024
	pop layer, pio

	print greeting
	print layer
	print "\n"
.end
CODE
Hello, world!
string
OUTPUT

pir_output_is( <<'CODE', <<"OUTPUT", "PIO.slurp() - classmeth" );
.sub main :main
    $S0 = <<"EOS"
line 1
line 2
line 3
EOS
    .local pmc pio, cl
    pio = open	"temp.file", ">"
    print pio, $S0
    close pio
    cl = new 'ParrotIO'
    $S1 = cl.'slurp'('temp.file')
    if $S0 == $S1 goto ok
    print "not "
ok:
    print "ok\n"
.end
CODE
ok
OUTPUT

pir_output_is( <<'CODE', <<"OUTPUT", "PIO.slurp() - object" );
.sub main :main
    $S0 = <<"EOS"
line 1
line 2
line 3
EOS
    .local pmc pio, pio2
    pio = open	"temp.file", ">"
    print pio, $S0
    close pio
    pio2 = open	"temp.file", "<"
    $S1 = pio2.'slurp'('dummy')
    if $S0 == $S1 goto ok
    print "not "
ok:
    print "ok\n"
.end
CODE
ok
OUTPUT
unlink("temp.file");

pir_error_output_like( <<'CODE', <<"OUTPUT", "stat failed" );
.sub main :main
    .local pmc pio
    .local int len
    .include "stat.pasm"
    .local string f
    f = 'no_such_file'
    len = stat f, .STAT_FILESIZE
    print "never\n"
.end
CODE
/stat failed:/
OUTPUT

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: