Merge pull request #86 from hoelzro/master

Expose errno and POSIX errno values to NQP
Raku · Mar 20, 2013 · 737636f · 737636f
2 parents 5400ed8 + 8e1e040
commit 737636f
Show file tree

Hide file tree

Showing 7 changed files with 94 additions and 1 deletion.
diff --git a/.gitignore b/.gitignore
@@ -39,3 +39,4 @@ config.status
 config.default
 3rdparty/dyncall/ConfigVars
 3rdparty/dyncall/*/*.a
+/nqp_const.pir
diff --git a/src/HLL/Compiler.pm b/src/HLL/Compiler.pm
@@ -105,6 +105,7 @@ class HLL::Backend::Parrot {
         ~ ".include 'stat.pasm'\n"
         ~ ".include 'datatypes.pasm'\n"
         ~ ".include 'libpaths.pasm'\n"
+        ~ ".include 'nqp_const.pir'\n"
     }
 
     method pir($source, *%adverbs) {

diff --git a/src/QAST/Operations.nqp b/src/QAST/Operations.nqp
@@ -1750,6 +1750,7 @@ QAST::Operations.add_core_pirop_mapping('tonum_I', 'nqp_bigint_to_num', 'NP', :i
 QAST::Operations.add_core_pirop_mapping('buildnativecall', 'nqp_native_call_build', 'vPsssPP');
 QAST::Operations.add_core_pirop_mapping('nativecall', 'nqp_native_call', 'PPPP');
 QAST::Operations.add_core_pirop_mapping('nativecallrefresh', 'nqp_native_call_wb', 'vP');
+QAST::Operations.add_core_pirop_mapping('x_posixerrno', 'nqp_posixerrno', 'I');
 
 # boolean opcodes
 QAST::Operations.add_core_pirop_mapping('not_i', 'not', 'Ii', :inlinable(1));

diff --git a/src/ops/nqp.ops b/src/ops/nqp.ops
@@ -1,5 +1,7 @@
 BEGIN_OPS_PREAMBLE
 
+#include <errno.h>
+
 /* Parroty includes. */
 #include "parrot/parrot.h"
 #include "parrot/extend.h"
@@ -2906,6 +2908,19 @@ inline op nqp_fresh_stub(out PMC, invar PMC) :base_core {
 
 /*
 
+=item nqp_posixerrno
+
+Returns the value of errno.
+
+=cut
+
+*/
+inline op nqp_posixerrno(out INT) :base_core {
+    $1 = errno;
+}
+
+/*
+
 =item captureposprimspec
 
 Takes a CallContext in $2 and an index in $3, and returns the primitive

diff --git a/t/nqp/67-errno.t b/t/nqp/67-errno.t
@@ -0,0 +1,26 @@
+plan(3);
+
+sub mkdir($filename) {
+    pir::new__PS('OS').mkdir($filename, 0o777);
+    return True;
+    CATCH {
+        return False;
+    }
+}
+
+sub rmdir($filename) {
+    pir::new__PS('OS').rmdir($filename);
+    return True;
+    CATCH {
+        return False;
+    }
+}
+
+my $test-dir := 'errno-test-dir';
+
+rmdir($test-dir);
+ok(mkdir($test-dir) eq True, 'mkdir should succeed');
+ok(mkdir($test-dir) eq False, 'mkdir of an existing directory should fail');
+ok(nqp::x_posixerrno() == pir::const::POSIX_EEXIST, 'errno should be equal to EEXIST');
+
+rmdir($test-dir);
diff --git a/tools/build/Makefile.in b/tools/build/Makefile.in
@@ -493,6 +493,8 @@ DYNCALL_BIN = 3rdparty/dyncall/dyncall/libdyncall_s$(A) \
 DYNCALL_OPS        = nqp_dyncall_ops
 DYNCALL_OPS_SOURCE = nqp_dyncall.ops
 
+NQP_CONST_PIR = nqp_const.pir
+
 CLEANUPS = \
   *.manifest \
   *.pdb \
@@ -534,6 +536,7 @@ CLEANUPS = \
   3rdparty/libtommath/*$(O) \
   3rdparty/sha1/*$(O) \
   $(DYNEXT_DIR)/*$(LOAD_EXT) \
+  $(NQP_CONST_PIR) \
 
 all: $(NQP_EXE) $(P5QREGEX_PBC)
 
@@ -577,7 +580,7 @@ $(STAGE0_PBCS): $(DYNEXT_TARGET) $(STAGE0_SOURCES)
 
 $(STAGE1): $(STAGE1_PBCS)
 
-$(STAGE1)/$(NQP_MO_PBC): $(STAGE0_PBCS) $(NQP_MO_SOURCES)
+$(STAGE1)/$(NQP_MO_PBC): $(NQP_CONST_PIR) $(STAGE0_PBCS) $(NQP_MO_SOURCES)
 	$(MKPATH) $(STAGE1)/gen
 	$(PERL) tools/build/gen-cat.pl $(NQP_MO_SOURCES) > $(STAGE1)/$(NQP_MO_COMBINED)
 	$(PARROT) --library=$(STAGE0) $(STAGE0)/$(NQP_PBC) \
@@ -1063,6 +1066,9 @@ $(OPS_DIR)/$(DYNCALL_OPS)$(LOAD_EXT): $(OPS_DIR)/$(DYNCALL_OPS_SOURCE) $(DYNCALL
 	cd src/6model/reprs && $(CC) -c @cc_o_out@CStr$(O) -I../../../$(PMC_DIR) $(CINCLUDES) $(CFLAGS) CStr.c
 	cd $(OPS_DIR) && $(LD) @ld_out@$(DYNCALL_OPS)$(LOAD_EXT) $(DYNCALL_OPS)$(O) ../6model/reprs/NativeCall$(O) ../6model/reprs/CStruct$(O) ../6model/reprs/CPointer$(O) ../6model/reprs/CArray$(O) ../6model/reprs/CStr$(O) ../../3rdparty/dyncall/dyncall/libdyncall_s$(A) ../../3rdparty/dyncall/dyncallback/libdyncallback_s$(A) ../../3rdparty/dyncall/dynload/libdynload_s$(A) $(LINKARGS)
 
+$(NQP_CONST_PIR):
+	perl tools/build/generate-constants.pl > $@
+
 bootstrap-files: $(STAGE2_PBCS) src/stage2/$(CORE_SETTING_NQP)
 	$(PERL) tools/build/gen-bootstrap.pl src/stage2/$(NQP_MO_PIR) >src/stage0/NQPMO-s0.pir
 	$(PERL) tools/build/gen-bootstrap.pl src/stage2/gen/module_loader.pir >src/stage0/ModuleLoader-s0.pir

diff --git a/tools/build/generate-constants.pl b/tools/build/generate-constants.pl
@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use POSIX;
+
+print <<"END_HEADER";
+# DO NOT EDIT THIS FILE.
+#
+# This file is generated automatically from
+# $0
+#
+# Any changes made here will be lost.
+#
+END_HEADER
+
+my @errno_values;
+
+my $max_errno_name_len = 0;
+foreach my $name (sort grep { /^E[A-Z]+$/ } keys %POSIX::) {
+    my $code = POSIX->can($name);
+
+    next unless $code;
+
+    my $value = eval { $code->() };
+
+    next unless defined $value;
+
+    push @errno_values, [ $name, $value ];
+
+    if(length($name) > $max_errno_name_len) {
+        $max_errno_name_len = length($name);
+    }
+}
+
+my $format = ".macro_const POSIX_%-${max_errno_name_len}s %d\n";
+
+foreach my $pair (@errno_values) {
+    my ( $name, $value ) = @$pair;
+
+    printf $format, $name, $value;
+}