Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
First tests for file ops, plus fixes on JVM.
  • Loading branch information
donaldh committed Aug 25, 2013
1 parent d3cfdd6 commit ee3f55a
Show file tree
Hide file tree
Showing 7 changed files with 88 additions and 11 deletions.
1 change: 1 addition & 0 deletions src/vm/jvm/QAST/Compiler.nqp
Expand Up @@ -1890,6 +1890,7 @@ QAST::OperationsJAST.map_classlib_core_op('getstdout', $TYPE_OPS, 'getstdout', [
QAST::OperationsJAST.map_classlib_core_op('getstderr', $TYPE_OPS, 'getstderr', [], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('setencoding', $TYPE_OPS, 'setencoding', [$RT_OBJ, $RT_STR], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('tellfh', $TYPE_OPS, 'tellfh', [$RT_OBJ], $RT_INT, :tc);
QAST::OperationsJAST.map_classlib_core_op('writefh', $TYPE_OPS, 'writefh', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
QAST::OperationsJAST.map_classlib_core_op('printfh', $TYPE_OPS, 'printfh', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('sayfh', $TYPE_OPS, 'sayfh', [$RT_OBJ, $RT_STR], $RT_STR, :tc);
QAST::OperationsJAST.map_classlib_core_op('readlinefh', $TYPE_OPS, 'readlinefh', [$RT_OBJ], $RT_STR, :tc);
Expand Down
29 changes: 21 additions & 8 deletions src/vm/jvm/runtime/org/perl6/nqp/io/FileHandle.java
Expand Up @@ -76,7 +76,8 @@ public void seek(ThreadContext tc, long offset, long whence) {

public long tell(ThreadContext tc) {
try {
return chan.position();
long position = chan.position();
return readBuffer != null ? position - readBuffer.remaining() : position;
} catch (IOException e) {
throw ExceptionHandling.dieInternal(tc, e);
}
Expand All @@ -95,8 +96,8 @@ public synchronized String slurp(ThreadContext tc) {
int total = 0;
int read;
if (readBuffer != null) {
buffers.add(ByteBuffer.wrap(readBuffer.array(), readBuffer.position(),
readBuffer.limit() - readBuffer.position()));
total = readBuffer.limit() - readBuffer.position();
buffers.add(ByteBuffer.wrap(readBuffer.array(), readBuffer.position(), total));
readBuffer = null;
}
while ((read = chan.read(curBuffer)) != -1) {
Expand Down Expand Up @@ -127,6 +128,7 @@ public synchronized String readline(ThreadContext tc) {
/* End of file, so what we have is fine. */
eof = true;
foundLine = true;
readBuffer.flip();
break;
}
readBuffer.flip();
Expand Down Expand Up @@ -165,8 +167,11 @@ private String decodeBuffers(ArrayList<ByteBuffer> buffers, int total) throws IO
// Copy to a single buffer and decode (could be smarter, but need
// to be wary as UTF-8 chars may span a buffer boundary).
ByteBuffer allBytes = ByteBuffer.allocate(total);
for (ByteBuffer bb : buffers)
allBytes.put(bb.array(), 0, bb.limit());
for (ByteBuffer bb : buffers) {
int amount = total < bb.limit() ? total : bb.limit();
allBytes.put(bb.array(), 0, amount);
total -= amount;
}
allBytes.rewind();
return dec.decode(allBytes).toString();
}
Expand All @@ -175,9 +180,8 @@ public boolean eof(ThreadContext tc) {
return eof;
}

public void print(ThreadContext tc, String s) {
public void write(ThreadContext tc, ByteBuffer buffer) {
try {
ByteBuffer buffer = enc.encode(CharBuffer.wrap(s));
int toWrite = buffer.limit();
int written = 0;
while (written < toWrite) {
Expand All @@ -186,7 +190,16 @@ public void print(ThreadContext tc, String s) {
}
} catch (IOException e) {
throw ExceptionHandling.dieInternal(tc, e);
}
}
}

public void print(ThreadContext tc, String s) {
try {
ByteBuffer buffer = enc.encode(CharBuffer.wrap(s));
write(tc, buffer);
} catch (IOException e) {
throw ExceptionHandling.dieInternal(tc, e);
}
}

public void say(ThreadContext tc, String s) {
Expand Down
3 changes: 3 additions & 0 deletions src/vm/jvm/runtime/org/perl6/nqp/io/IIOSyncWritable.java
@@ -1,8 +1,11 @@
package org.perl6.nqp.io;

import java.nio.ByteBuffer;

import org.perl6.nqp.runtime.ThreadContext;

public interface IIOSyncWritable {
public void print(ThreadContext tc, String s);
public void say(ThreadContext tc, String s);
public void write(ThreadContext tc, ByteBuffer bb);
}
5 changes: 5 additions & 0 deletions src/vm/jvm/runtime/org/perl6/nqp/io/StandardWriteHandle.java
Expand Up @@ -40,6 +40,11 @@ public void setEncoding(ThreadContext tc, Charset cs) {
dec = cs.newDecoder();
}

public void write(ThreadContext tc, ByteBuffer buffer) {
byte[] bytes = buffer.array();
ps.write(bytes, 0, buffer.limit());
}

public void print(ThreadContext tc, String s) {
try {
ByteBuffer buffer = enc.encode(CharBuffer.wrap(s));
Expand Down
25 changes: 24 additions & 1 deletion src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java
Expand Up @@ -403,6 +403,23 @@ public static long tellfh(SixModelObject obj, ThreadContext tc) {
}
}

public static SixModelObject writefh(SixModelObject obj, SixModelObject buf, ThreadContext tc) {
ByteBuffer bb = decode8(buf, tc);
if (obj instanceof IOHandleInstance) {
IOHandleInstance h = (IOHandleInstance)obj;
if (h.handle instanceof IIOSyncWritable)
((IIOSyncWritable)h.handle).write(tc, bb);
else
throw ExceptionHandling.dieInternal(tc,
"This handle does not support print");
}
else {
throw ExceptionHandling.dieInternal(tc,
"printfh requires an object with the IOHandle REPR");
}
return buf;
}

public static String printfh(SixModelObject obj, String data, ThreadContext tc) {
if (obj instanceof IOHandleInstance) {
IOHandleInstance h = (IOHandleInstance)obj;
Expand Down Expand Up @@ -3005,7 +3022,7 @@ else if (encoding.equals("utf32")) {
}
}

public static String decode8(SixModelObject buf, String csName, ThreadContext tc) {
protected static ByteBuffer decode8(SixModelObject buf, ThreadContext tc) {
ByteBuffer bb;
if (buf instanceof VMArrayInstance_i8) {
VMArrayInstance_i8 bufi8 = (VMArrayInstance_i8)buf;
Expand All @@ -3021,8 +3038,14 @@ public static String decode8(SixModelObject buf, String csName, ThreadContext tc
bb.put((byte)tc.native_i);
}
}
return bb;
}

public static String decode8(SixModelObject buf, String csName, ThreadContext tc) {
ByteBuffer bb = decode8(buf, tc);
return Charset.forName(csName).decode(bb).toString();
}

public static String decode(SixModelObject buf, String encoding, ThreadContext tc) {
if (encoding.equals("utf8")) {
return decode8(buf, "UTF-8", tc);
Expand Down
33 changes: 33 additions & 0 deletions t/nqp/19-file-ops.t
@@ -0,0 +1,33 @@
#! nqp

# Test nqp::op file operations.

plan(20);

ok( nqp::stat('CREDITS', nqp::const::STAT_EXISTS) == 1, 'nqp::stat exists');
ok( nqp::stat('AARDVARKS', nqp::const::STAT_EXISTS) == 0, 'nqp::stat not exists');

ok( nqp::stat('t', nqp::const::STAT_ISDIR) == 1, 'nqp::stat is directory');
ok( nqp::stat('CREDITS', nqp::const::STAT_ISDIR) == 0, 'nqp::stat not directory');

ok( nqp::stat('CREDITS', nqp::const::STAT_ISREG) == 1, 'nqp::stat is regular file');
ok( nqp::stat('t', nqp::const::STAT_ISREG) == 0, 'nqp::stat not regular file');

my $credits := nqp::open('CREDITS', 'r');
ok( $credits, 'nqp::open for read');
ok( nqp::tellfh($credits) == 0, 'nqp::tellfh start of file');
my $line := nqp::readlinefh($credits);
ok( nqp::chars($line) == nqp::chars($line), 'nqp::readlinefh line to read');
ok( nqp::tellfh($credits) == 5, 'nqp::tellfh line two');
my $rest := nqp::readallfh($credits);
ok( nqp::chars($rest) > 100, 'nqp::readallfh lines to read');
ok( nqp::tellfh($credits) == nqp::chars($line) + nqp::chars($rest), 'nqp::tellfh end of file');
ok( nqp::chars(nqp::readlinefh($credits)) == 0, 'nqp::readlinefh end of file');
ok( nqp::chars(nqp::readlinefh($credits)) == 0, 'nqp::readlinefh end of file repeat');
ok( nqp::chars(nqp::readallfh($credits)) == 0, 'nqp::readallfh end of file');
ok( nqp::chars(nqp::readlinefh($credits)) == 0, 'nqp::readlinefh end of file repeat');
ok( nqp::defined(nqp::closefh($credits)), 'nqp::closefh');

ok( nqp::defined(nqp::getstdin()), 'nqp::getstdin');
ok( nqp::defined(nqp::getstdout()), 'nqp::getstdout');
ok( nqp::defined(nqp::getstderr()), 'nqp::getstderr');
3 changes: 1 addition & 2 deletions t/nqp/59-nqpop.t
Expand Up @@ -2,7 +2,7 @@

# Test nqp::op pseudo-functions.

plan(112);
plan(111);


ok( nqp::add_i(5,2) == 7, 'nqp::add_i');
Expand Down Expand Up @@ -108,7 +108,6 @@ ok( nqp::istrue(0.0) == 0, 'nqp::istrue');
ok( nqp::istrue(0.1) == 1, 'nqp::istrue');
ok( nqp::istrue(nqp::list()) == 0, 'nqp::istrue on empty list');
ok( nqp::istrue(nqp::list(1,2,3)) == 1, 'nqp::istrue on nonempty list');
ok( nqp::istrue(nqp::null()) == 0, 'nqp::istrue on null');

my $list := nqp::list(0, 'a', 'b', 3.0);
ok( nqp::elems($list) == 4, 'nqp::elems');
Expand Down

0 comments on commit ee3f55a

Please sign in to comment.