Merge branch 'nom' into newio

docs/release_guide.pod

@@ -209,10 +209,17 @@ If there are any problems, fix them and go back to step 10.
 
 Tag the release by its release month ("YYYY.MM") and its code name.
 
-  $ git tag -a -m"tag release #nn" YYYY.MM    # e.g., 2013.08
-  $ git tag -a -m"tag release #nn" CODENAME   # e.g., "Bratislava"
+  $ git tag -s -a -m"tag release #nn" YYYY.MM    # e.g., 2013.08
+  $ git tag -s -a -m"tag release #nn" CODENAME   # e.g., "Bratislava"
   $ git push --tags
 
+The C<-s> tells git to sign the release with your PGP/GPG key, so it will
+likely ask you for the passphrase of your secrect key.
+
+If you have no PGP key, you might need to
+L<create one first|https://fedoraproject.org/wiki/Creating_GPG_Keys>. Should
+that prove impossible, you can omit the C<-s> from the command line.
+
 =item 14.
 
 Upload the tarball to L<http://rakudo.org/downloads/rakudo>:

lib/NativeCall.pm

@@ -373,6 +373,10 @@ sub nativecast($target-type, $source) is export(:DEFAULT) {
         nqp::decont(map_return_type($target-type)), nqp::decont($source));
 }
 
+sub nativesizeof($obj) is export(:DEFAULT) {
+    nqp::nativecallsizeof($obj)
+}
+
 sub cglobal($libname, $symbol, $target-type) is export {
     Proxy.new(
         FETCH => -> $ {

lib/Test.pm

@@ -539,4 +539,4 @@ the rest of the tests are skipped.
 
 =end pod
 
-# vim: ft=perl6
+# vim: expandtab shiftwidth=4 ft=perl6

src/core/Bool.pm

@@ -17,11 +17,11 @@ my class Bool { # declared in BOOTSTRAP
     method value() { self.Numeric }
 
     proto method pick(|) { * }
-    multi method pick(Bool:U:)    { nqp::p6bool(nqp::rand_n(2e0) >= 1) }
+    multi method pick(Bool:U:)    { nqp::p6bool(nqp::isge_n(nqp::rand_n(2e0), 1e0)) }
     multi method pick(Bool:U: $n) { (Bool::True,Bool::False).pick($n) }
 
     proto method roll(|) { * }
-    multi method roll(Bool:U:)    { nqp::p6bool(nqp::rand_n(2e0) >= 1) }
+    multi method roll(Bool:U:)    { nqp::p6bool(nqp::isge_n(nqp::rand_n(2e0), 1e0)) }
     multi method roll(Bool:U: $n) { (Bool::True,Bool::False).roll($n) }
 
     multi method ACCEPTS(Bool:D: Mu \topic ) { self }

src/core/IO.pm

@@ -96,7 +96,7 @@ sub MAKE-CLEAN-PARTS(Str $abspath) {
 
         # something to check
         elsif @parts.at_pos($index - 1) -> $part {
-            if $part.ord == 46 { # fast $part.substr(0,1) eq '.'
+            if $part.ord == 46 { # fast substr($part,0,1) eq '.'
                 if $part eq '..' {
                     return updirs($index - 1);
                 }

src/core/Parameter.pm

@@ -175,12 +175,18 @@ my class Parameter { # declared in BOOTSTRAP
         }
         $perl ~= " ::$_" for @($.type_captures);
         my $name = $.name;
-        if $!flags +& $SIG_ELEM_IS_CAPTURE {
-            $name = '|' ~ $name;
-        } elsif $!flags +& $SIG_ELEM_IS_PARCEL {
-            $name = '\\' ~ $name unless $name ~~ /^^ <[@$]>/;
-        } elsif !$name {
-            if $!flags +& $SIG_ELEM_ARRAY_SIGIL {
+        if $name {
+            if $!flags +& $SIG_ELEM_IS_CAPTURE {
+                $name = '|' ~ $name;
+            } elsif $!flags +& $SIG_ELEM_IS_PARCEL {
+                $name = '\\' ~ $name unless $name ~~ /^^ <[@$]>/;
+            }
+        } else {
+            if $!flags +& $SIG_ELEM_IS_CAPTURE {
+            $name = '|';
+            } elsif $!flags +& $SIG_ELEM_IS_PARCEL {
+            $name = '\\';
+            } elsif $!flags +& $SIG_ELEM_ARRAY_SIGIL {
             $name = '@';
             } elsif $!flags +& $SIG_ELEM_HASH_SIGIL {
             $name = '%';

src/core/Str.pm

@@ -1175,7 +1175,7 @@ my class Str does Stringy { # declared in BOOTSTRAP
           || !$to.defined              # or a type object
           || %n;                       # or any named params passed
 
-        return TRANSPOSE-ONE(self, $from, $to.substr(0,1))  # 1 char to 1 char
+        return TRANSPOSE-ONE(self, $from, substr($to,0,1))  # 1 char to 1 char
           if $from.chars == 1 && $to.chars;
 
         sub expand(Str:D \x) {
@@ -1556,65 +1556,112 @@ sub chrs(*@c) returns Str:D {
     @c.map({.chr}).join;
 }
 
-sub substr(\what, \from, $chars?) {
-    my str $str  = nqp::unbox_s(nqp::istype(what,Str) ?? what !! what.Str);
-    my int $max  = nqp::chars($str);
-    my int $from = nqp::unbox_i(
-      nqp::istype(from, Callable) ?? (from)(nqp::p6box_i($max)) !! from.Int
+sub SUBSTR-START-OOR(\from,\max) {
+    X::OutOfRange.new(
+      :what<Start argument to substr>,
+      :got(from),
+      :range("0.." ~ max),
+      :comment( nqp::istype(from, Callable) || -from > max
+        ?? ''
+        !! "use *{from} if you want to index relative to the end"),
+    );
+}
+sub SUBSTR-CHARS-OOR(\chars) {
+    X::OutOfRange.new(
+      :what<Number of characters argument to substr>,
+      :got(chars),
+      :range("0..Inf"),
+      :comment("use *{chars} if you want to index relative to the end"),
     );
+}
+sub SUBSTR-SANITY(Str \what, $start, $want, \from, \chars) is hidden_from_backtrace {
+    my Int $max := what.chars;
+    from = nqp::istype($start, Callable) ?? $start($max) !! $start.Int;
+    SUBSTR-START-OOR(from,$max).fail
+      if from < 0 || from > $max;
+
+    chars = $want.defined
+      ?? $want === Inf
+        ?? $max - from
+        !! nqp::istype($want,Callable)
+          ?? $want($max - from)
+          !! (nqp::istype($want,Int) ?? $want !! $want.Int)
+      !! $max - from;
+    chars < 0 ?? SUBSTR-CHARS-OOR(chars).fail !! 1;
+}
 
-    if $from < 0 {
-        if nqp::istype($from, Callable) || -$from > $max {
-            X::OutOfRange.new(
-              :what<Start argument to substr>,:got(from),:range("0..$max"),
-            ).fail;
-        }
-        else {
-            X::OutOfRange.new(
-              :what<Start argument to substr>,:got(from),:range<0..Inf>,
-              :comment("use *$from if you want to index relative to the end")
-            ).fail;
-        }
-    }
-    elsif $from > $max {
-        X::OutOfRange.new(
-          :what<Start of substr>,:got(from),:range("0..$max"),
-        ).fail;
-    }
+proto sub substr(|) { * }
+multi sub substr(Str:D \what, Int:D \start) {
+    my str $str  = nqp::unbox_s(what);
+    my int $max  = nqp::chars($str);
+    my int $from = nqp::unbox_i(start);
 
-    my int $length = nqp::unbox_i(
-      $chars.defined
-        ?? $chars === Inf
-          ?? $max - $from
-          !! nqp::istype($chars,Callable)
-            ?? $chars($max - $from)
-            !! (nqp::istype($chars,Int) ?? $chars !! $chars.Int)
-        !! $max - $from
-    );
-    X::OutOfRange.new(
-      :what<Length argument to substr>,:got($chars),:range<0..Inf>,
-      :comment("use *$length if you want to index relative to the end")
-    ).fail if $length < 0;
+    SUBSTR-START-OOR($from,$max).fail
+      if nqp::islt_i($from,0) || nqp::isgt_i($from,$max);
 
-    nqp::p6box_s(nqp::substr($str, $from, $length));
+    nqp::p6box_s(nqp::substr($str,$from));
 }
+multi sub substr(Str:D \what, Callable:D \start) {
+    my str $str  = nqp::unbox_s(what);
+    my int $max  = nqp::chars($str);
+    my int $from = nqp::unbox_i((start)(nqp::p6box_i($max)));
 
-sub substr-rw($s is rw, $from, $length?) {
-    my str $str   = nqp::unbox_s(nqp::istype($s,Str) ?? $s !! $s.Str);
-    my int $chars = nqp::unbox_i(
-      nqp::defined($length) ?? $length !! $from - nqp::chars($str)
-    );
-    my str $substr = nqp::substr($str,$from,$chars);
-    Proxy.new(
-        FETCH   => sub ($) { nqp::p6box_s($substr) },
-        STORE   => sub ($, $new) {
-            $s = nqp::p6box_s(
-              nqp::substr($str,0,$from)
-              ~ nqp::unbox_s($new)
-              ~ nqp::substr($str,$from + $chars)
-            );
-        }
-    );
+    SUBSTR-START-OOR($from,$max).fail
+      if nqp::islt_i($from,0) || nqp::isgt_i($from,$max);
+
+    nqp::p6box_s(nqp::substr($str,$from));
+}
+multi sub substr(Str:D \what, Int:D \start, Int:D \want) {
+    my str $str   = nqp::unbox_s(what);
+    my int $max   = nqp::chars($str);
+    my int $from  = nqp::unbox_i(start);
+
+    SUBSTR-START-OOR($from,$max).fail
+     if nqp::islt_i($from,0) || nqp::isgt_i($from,$max);
+
+    my int $chars = nqp::unbox_i(want);
+    SUBSTR-CHARS-OOR($chars).fail
+      if nqp::islt_i($chars,0);
+
+    nqp::p6box_s(nqp::substr($str,$from,$chars));
+}
+multi sub substr(Str() $what, \start, $want?) {
+
+    # should really be int, but \ then doesn't work for rw access
+    my $r := SUBSTR-SANITY($what, start, $want, my Int $from, my Int $chars);
+    $r.defined
+      ?? nqp::p6box_s(nqp::substr(
+           nqp::unbox_s($what),nqp::unbox_i($from),nqp::unbox_i($chars)
+         ))
+      !! $r;
+}
+
+sub substr-rw(\what, \start, $want?) {
+    my $Str := nqp::istype(what,Str) ?? what !! what.Str;
+
+    # should really be int, but \ then doesn't work for rw access
+    my $r := SUBSTR-SANITY($Str, start, $want, my Int $from, my Int $chars);
+    $r.defined
+      ?? Proxy.new(
+           FETCH => sub ($) {
+               nqp::p6box_s(nqp::substr(
+                 nqp::unbox_s($Str), nqp::unbox_i($from), nqp::unbox_i($chars)
+               ));
+           },
+           STORE => sub ($, $new) {
+               my $str = nqp::unbox_s($Str);
+               what = nqp::p6box_s(
+                 nqp::concat(
+                   nqp::substr($str,0,nqp::unbox_i($from)),
+                   nqp::concat(
+                     nqp::unbox_s($new),
+                     nqp::substr($str,nqp::unbox_i($from + $chars))
+                   )
+                 )
+               );
+           },
+         )
+      !! $r;
 }
 
 sub TRANSPOSE(Str \string, Str \original, Str \final) {

t/04-nativecall/12-sizeof.c

@@ -0,0 +1,62 @@
+#ifdef WIN32
+#define DLLEXPORT __declspec(dllexport)
+#else
+#define DLLEXPORT extern
+#endif
+
+typedef struct {
+    char  foo1;
+    int   foo2;
+    short foo3;
+    short foo4;
+} Foo;
+
+typedef struct {
+    char  bar1;
+    short bar2;
+    char  bar3;
+    int   bar4;
+    short bar5;
+} Bar;
+
+typedef struct {
+    char  bar1;
+    short bar2;
+    char  bar3;
+    int   bar4;
+    short bar5;
+    long  baz6;
+    int   bar7;
+} Baz;
+
+typedef struct {
+    char  buz1;
+} Buz;
+
+DLLEXPORT int SizeofFoo() {
+    return sizeof(Foo);
+}
+
+DLLEXPORT int SizeofBar() {
+    return sizeof(Bar);
+}
+
+DLLEXPORT int SizeofBaz() {
+    return sizeof(Baz);
+}
+
+DLLEXPORT int SizeofBuz() {
+    return sizeof(Buz);
+}
+
+DLLEXPORT int SizeofInt() {
+    return sizeof(int);
+}
+
+DLLEXPORT int SizeofLng() {
+    return sizeof(long);
+}
+
+DLLEXPORT int SizeofPtr() {
+    return sizeof(void *);
+}

t/04-nativecall/12-sizeof.t

@@ -0,0 +1,54 @@
+use lib 't/04-nativecall';
+use CompileTestLib;
+use lib 'lib';
+use NativeCall;
+use Test;
+
+plan 7;
+
+compile_test_lib('12-sizeof');
+
+class Foo is repr<CStruct> {
+    has int8  $.foo1;
+    has int32 $.foo2;
+    has int16 $.foo3;
+    has int16 $.foo4;
+}
+
+class Bar is repr<CStruct> {
+    has int8  $.bar1;
+    has int16 $.bar2;
+    has int8  $.bar3;
+    has int32 $.bar4;
+    has int16 $.bar5;
+}
+
+class Baz is repr<CStruct> {
+    has int8  $.bar1;
+    has int16 $.bar2;
+    has int8  $.bar3;
+    has int32 $.bar4;
+    has int16 $.bar5;
+    has long  $.bar6;
+    has int32 $.bar7;
+}
+
+class Buz is repr<CStruct> {
+    has int8  $.bar1;
+}
+
+sub SizeofFoo() returns int32 is native('./12-sizeof') { * }
+sub SizeofBar() returns int32 is native('./12-sizeof') { * }
+sub SizeofBaz() returns int32 is native('./12-sizeof') { * }
+sub SizeofBuz() returns int32 is native('./12-sizeof') { * }
+sub SizeofInt() returns int32 is native('./12-sizeof') { * }
+sub SizeofLng() returns int32 is native('./12-sizeof') { * }
+sub SizeofPtr() returns int32 is native('./12-sizeof') { * }
+
+is nativesizeof(Foo),           SizeofFoo(), 'sizeof(Foo)';
+is nativesizeof(Bar),           SizeofBar(), 'sizeof(Bar)';
+is nativesizeof(Baz),           SizeofBaz(), 'sizeof(Baz)';
+is nativesizeof(Buz),           SizeofBuz(), 'sizeof(Buz)';
+is nativesizeof(int32),         SizeofInt(), 'sizeof(int)';
+is nativesizeof(long),          SizeofLng(), 'sizeof(long)';
+is nativesizeof(OpaquePointer), SizeofPtr(), 'sizeof(void *)';

tools/build/NQP_REVISION

@@ -1 +1 @@
-2015.02
+2015.02-9-g0e62590