implements nqp::sleep

docs/LHF.md

@@ -32,9 +32,6 @@ Just add ops; they need to take the ThreadContext (use :tc in QASTCompilerJAST)
 and use the lexical name info as in the contextuals task (this may actually be
 a bit easier).
 
-## Process related opcodes
-Implement nqp::sleep (takes double number of seconds).
-
 ## Work out build stuff
 At the moment, there's nothing really set up for building the Java bit of
 the system. If you've got some ideas on how to sort something out here, go

lib/QAST/JASTCompiler.nqp

@@ -1150,6 +1150,7 @@ QAST::OperationsJAST.map_classlib_core_op('sethllconfig', $TYPE_OPS, 'sethllconf
 
 # process related opcodes
 QAST::OperationsJAST.map_classlib_core_op('exit', $TYPE_OPS, 'exit', [$RT_INT], $RT_INT);
+QAST::OperationsJAST.map_classlib_core_op('sleep', $TYPE_OPS, 'sleep', [$RT_NUM], $RT_NUM);
 
 class QAST::CompilerJAST {
     # Responsible for handling issues around code references, building the

src/org/perl6/nqp/runtime/Ops.java

@@ -1011,6 +1011,29 @@ public static long exit(final long status) {
         return status;
     }
 
+    public static double sleep(final double seconds) {
+        // Is this really the right behavior, i.e., swallowing all
+        // InterruptedExceptions?  As far as I can tell the original
+        // nqp::sleep could not be interrupted, so that behavior is
+        // duplicated here, but that doesn't mean it's the right thing
+        // to do on the JVM...
+
+        long now = System.currentTimeMillis();
+
+        final long awake = now + (long) (seconds * 1000);
+
+        while ((now = System.currentTimeMillis()) < awake) {
+            long millis = awake - now;
+            try {
+                Thread.sleep(millis);
+            } catch(InterruptedException e) {
+                // swallow
+            }
+        }
+
+        return seconds;
+    }
+
     /* HLL configuration and compiler related options. */
     public static SixModelObject sethllconfig(String language, SixModelObject configHash, ThreadContext tc) {
         HLLConfig config = tc.gc.getHLLConfigFor(language);

t/qast_process.t

@@ -1,6 +1,6 @@
 use helper;
 
-plan(1);
+plan(2);
 
 {
     my $expected-exit := 123;
@@ -42,3 +42,56 @@ plan(1);
     #unlink('QAST2JASTOutput.dump');
     #unlink('QAST2JASTOutput.class');
 }
+
+{
+    sub timed_qast_test($sleep) {
+        my $block := QAST::Block.new(
+            QAST::Op.new(
+                :op('say'),
+                QAST::Op.new(
+                    :op('sleep'),
+                    QAST::NVal.new( :value($sleep) )
+                )));
+        my $jast := QAST::CompilerJAST.jast(
+            QAST::CompUnit.new(
+                $block,
+                :main(QAST::Op.new(
+                    :op('call'),
+                    QAST::BVal.new( :value($block) )
+                )))
+            );
+        my $dump := $jast.dump();
+        spurt('QAST2JASTOutput.dump', $dump);
+        my $cps := is_windows() ?? ";" !! ":";
+        run('java',
+            '-cp bin' ~ $cps ~ '3rdparty/bcel/bcel-5.2.jar',
+            'org/perl6/nqp/jast2bc/JASTToJVMBytecode',
+            'QAST2JASTOutput.dump', 'QAST2JASTOutput.class');
+        my $before := pir::time__N;
+        run('java',
+            '-cp .' ~ $cps ~ 'bin' ~ $cps ~ '3rdparty/bcel/bcel-5.2.jar',
+            'QAST2JASTOutput');
+        my $after := pir::time__N;
+        my $slept := $after - $before;
+
+        #unlink('QAST2JASTOutput.dump');
+        #unlink('QAST2JASTOutput.class');
+
+        return $slept;
+    }
+
+    my $quick := timed_qast_test(0.0);
+
+    my $sleep := 1.0 + $quick;
+    my $slow := timed_qast_test($sleep);
+
+    if ($slow >= $sleep) {
+        ok(1, 'sleep');
+    }
+    else {
+        ok(0, 'sleep');
+        say("# got: $slow");
+        say("# expected: $sleep");
+    }
+}
+