create file{readable,writable,executable,islink} on jvm and parrot.

Raku · Jul 12, 2013 · 0d19655 · 0d19655
1 parent 5669b32
commit 0d19655
Show file tree

Hide file tree

Showing 3 changed files with 107 additions and 1 deletion.
diff --git a/src/vm/jvm/QAST/Compiler.nqp b/src/vm/jvm/QAST/Compiler.nqp
@@ -1879,6 +1879,10 @@ QAST::OperationsJAST.map_classlib_core_op('print', $TYPE_OPS, 'print', [$RT_STR]
 QAST::OperationsJAST.map_classlib_core_op('say', $TYPE_OPS, 'say', [$RT_STR], $RT_STR, :tc);
 QAST::OperationsJAST.map_classlib_core_op('stat', $TYPE_OPS, 'stat', [$RT_STR, $RT_INT], $RT_INT);
 QAST::OperationsJAST.map_classlib_core_op('open', $TYPE_OPS, 'open', [$RT_STR, $RT_STR], $RT_OBJ, :tc);
+QAST::OperationsJAST.map_classlib_core_op('filereadable', $TYPE_OPS, 'filereadable', [$RT_STR], $RT_INT, :tc);
+QAST::OperationsJAST.map_classlib_core_op('filewritable', $TYPE_OPS, 'filewritable', [$RT_STR], $RT_INT, :tc);
+QAST::OperationsJAST.map_classlib_core_op('fileexecutable', $TYPE_OPS, 'fileexecutable', [$RT_STR], $RT_INT, :tc);
+QAST::OperationsJAST.map_classlib_core_op('fileislink', $TYPE_OPS, 'fileislink', [$RT_STR], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('getstdin', $TYPE_OPS, 'getstdin', [], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('getstdout', $TYPE_OPS, 'getstdout', [], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('getstderr', $TYPE_OPS, 'getstderr', [], $RT_OBJ, :tc);

diff --git a/src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java b/src/vm/jvm/runtime/org/perl6/nqp/runtime/Ops.java
@@ -291,7 +291,63 @@ else if (mode.equals("wa")) {
 
         return h;
     }
-
+
+    public static long filereadable(String path, ThreadContext tc) {
+        Path path_o;
+        long res;
+        try {
+            path_o = Paths.get(path);
+            res = Files.isReadable(path_o) ? 1 : 0;
+        }
+        catch (Exception e) {
+            die_s(e.getMessage(), tc);
+            res = -1; /* unreachable */
+        }
+        return res;
+    }
+
+    public static long filewritable(String path, ThreadContext tc) {
+        Path path_o;
+        long res;
+        try {
+            path_o = Paths.get(path);
+            res = Files.isWritable(path_o) ? 1 : 0;
+        }
+        catch (Exception e) {
+            die_s(e.getMessage(), tc);
+            res = -1; /* unreachable */
+        }
+        return res;
+    }
+
+    public static long fileexecutable(String path, ThreadContext tc) {
+        Path path_o;
+        long res;
+        try {
+            path_o = Paths.get(path);
+            res = Files.isExecutable(path_o) ? 1 : 0;
+        }
+        catch (Exception e) {
+            die_s(e.getMessage(), tc);
+            res = -1; /* unreachable */
+        }
+        return res;
+    }
+
+    public static long fileislink(String path, ThreadContext tc) {
+        Path path_o;
+        long res;
+        try {
+            path_o = Paths.get(path);
+            res = Files.isSymbolicLink(path_o) ? 1 : 0;
+        }
+        catch (Exception e) {
+            die_s(e.getMessage(), tc);
+            res = -1; /* unreachable */
+        }
+        return res;
+    }
+
     public static SixModelObject getstdin(ThreadContext tc) {
         SixModelObject IOType = tc.curFrame.codeRef.staticInfo.compUnit.hllConfig.ioType; 
         IOHandleInstance h = (IOHandleInstance)IOType.st.REPR.allocate(tc, IOType.st);

diff --git a/src/vm/parrot/QAST/Operations.nqp b/src/vm/parrot/QAST/Operations.nqp
@@ -1516,6 +1516,52 @@ QAST::Operations.add_core_pirop_mapping('print', 'print', '0s', :inlinable(1));
 QAST::Operations.add_core_pirop_mapping('say', 'say', '0s', :inlinable(1));
 QAST::Operations.add_core_pirop_mapping('stat', 'stat', 'Isi', :inlinable(1));
 QAST::Operations.add_core_pirop_mapping('open', 'open', 'Pss', :inlinable(1));
+
+QAST::Operations.add_core_op('filereadable', -> $qastcomp, $op {
+    if +$op.list != 1 {
+        nqp::die("The 'filereadable' op expects one child");
+    }
+    $qastcomp.as_post(QAST::Op.new(
+        :op('callmethod'),
+        :name('can_read'),
+        QAST::VM.new( :pirop('new__Ps'),
+                      QAST::SVal.new( :value('OS') ) ),
+        $op[0],) );
+});
+QAST::Operations.add_core_op('filewritable', -> $qastcomp, $op {
+    if +$op.list != 1 {
+        nqp::die("The 'filewritable' op expects one child");
+    }
+    $qastcomp.as_post(QAST::Op.new(
+        :op('callmethod'),
+        :name('can_write'),
+        QAST::VM.new( :pirop('new__Ps'),
+                      QAST::SVal.new( :value('OS') ) ),
+        $op[0],) );
+});
+QAST::Operations.add_core_op('fileexecutable', -> $qastcomp, $op {
+    if +$op.list != 1 {
+        nqp::die("The 'fileexecutable' op expects one child");
+    }
+    $qastcomp.as_post(QAST::Op.new(
+        :op('callmethod'),
+        :name('can_execute'),
+        QAST::VM.new( :pirop('new__Ps'),
+                      QAST::SVal.new( :value('OS') ) ),
+        $op[0],) );
+});
+QAST::Operations.add_core_op('fileislink', -> $qastcomp, $op {
+    if +$op.list != 1 {
+        nqp::die("The 'fileislink' op expects one child");
+    }
+    $qastcomp.as_post(QAST::Op.new(
+        :op('callmethod'),
+        :name('is_link'),
+        QAST::VM.new( :pirop('new__Ps'),
+                      QAST::SVal.new( :value('File') ) ),
+        $op[0],) );
+});
+
 QAST::Operations.add_core_op('getstdin', -> $qastcomp, $op {
     if +$op.list != 0 {
         nqp::die("The 'getstdin' op expects no operands");