Merge branch 'bitwise'

dist.ini

@@ -50,6 +50,7 @@ push_to     = github
 [Git::NextVersion]
 
 [Meta::Contributors]
+contributor = Slaven Rezić <[email protected]>
 contributor = Mike Jones <[email protected]>
 contributor = Aristotle Pagaltzis <[email protected]>
 contributor = Rafael Garcia-Suarez <[email protected]>

lib/perlsecret.pod

@@ -213,6 +213,8 @@ greeting.
 
     ~~
 
+Incompatible with L<feature/"The 'bitwise' feature"> introduced in Perl 5.028.
+
 This operator is basically a shorter C<scalar> (shaves 4 characters!)
 using the same idea as the secret bang bang operator.
 
@@ -523,6 +525,7 @@ This operator is also a container. So the X-Wing can have a pilot!
 
 Discovered by Philippe Bruhat, 2012.
 (Alternate nickname: "sperm")
+Incompatible with L<feature/"The 'bitwise' feature"> introduced in Perl 5.028.
 
 This operator is actually a combination of the inchworm and the diamond
 operator. It provides scalar context to the C<readline()> builtin, thus
@@ -795,6 +798,30 @@ Under Unix, will be equal to the real user home directory (by using C<glob>).
 On Win32 it will expand to C<$ENV{HOME}> if it is set (which is quite uncommon)
 or return C<'~'> else.
 
+=head1 DEPRECATION WARNING
+
+Perl continues to evolve an improve, and sometimes secret operators fall
+victim to the greater good. The C<bitwise> L<feature> introduced in Perl
+5.028 had an important (for Perl tricksters) side effect, as documented
+in this excerpt from L<perlop/"Symbolic Unary Operators">
+
+I<If the "bitwise" feature is enabled via S<C<use
+feature 'bitwise'>> or C<use v5.28>, then unary
+C<"~"> always treats its argument as a number, and an
+alternate form of the operator, C<"~.">, always treats its argument as a
+string.>
+
+With the C<bitwise> feature on, a single C<~> will force numeric
+context (in addition to scalar context) on its argument, thus turning
+any non-numeric string to C<0> (with a C<Argument isn't numeric in
+numeric 1's complement (~)> warning).
+
+This has the effect of breaking some of the C<~>-based secret operators,
+specifically C<~~> and C<< ~~<> >>, which will return C<0> for any
+non-numerical string, and the identity otherwise.
+
+=back
+
 =head1 AUTHOR
 
 Philippe Bruhat (BooK)
@@ -806,7 +833,8 @@ Karasik, Abigail, Yitzchak Scott-Thoennes, Zefram, Tye McQueen, Maxim
 Vuets, Aristotle Pagaltzis, Toby Inkster, Ævar Arnfjörð Bjarmason,
 Rafaël Garcia-Suarez, Andreas J. König, Andy Armstrong, Pau Amma,
 Keith C. Ivey, Michael R. Wolf, Olivier Mengué, Yves Orton, Damien Krotkine,
-Diab Jerius, Ivan Bessarabov, Daniel Bruder, Aaron Crane, Mike Jones
+Diab Jerius, Ivan Bessarabov, Daniel Bruder, Aaron Crane, Mike Jones,
+Slaven Rezić
 and the Fun With Perl mailing list for inspiration, suggestions and patches.
 
 =head1 CONTRIBUTING
@@ -961,6 +989,13 @@ On 2014-11-24, Daniel Bruder sent me an email describing C<~~!!>.
 He proposed to call it "Serpent to the truth" or "Inchworm Bang-Bang!",
 but immediately accepted "serpent of truth" when I suggested it.
 
+=item *
+
+On 2018-09-02, Slaven Rezić pointed to me (in L<RT
+#12701|https://rt.cpan.org/Public/Bug/Display.html?id=127021>) that
+"Inchworm" stopped working with Perl 5.28. This led to the warning about
+all secret operators composed out of C<~>.
+
 =back
 
 More secret operators didn't make it to this list, because they

t/bitwise.t

@@ -0,0 +1,135 @@
+#!./perl
+
+# this will be needed for inclusion in the core perl test suite
+#BEGIN {
+#    chdir 't' if -d 't';
+#    @INC = '../lib';
+#    require './test.pl';
+#}
+
+use Test::More;
+
+use strict;
+use warnings;
+use Config;
+
+plan skip_all =>
+  "'bitwise feature was introduced in Perl 5.022, this is only $]"
+  if $] < 5.022;
+
+my ( $UV_MAX, $UV_MIN, $IV_MAX, $IV_MIN );
+$UV_MAX += 2** $_ for 0 .. 8 * $Config{uvsize} - 1; # avoid overflowing
+$UV_MIN = 0;
+$IV_MAX = 2**( 8 * $Config{ivsize} - 1 ) - 1;
+$IV_MIN = -2**( 8 * $Config{ivsize} - 1 );
+# diag "$UV_MAX $UV_MIN $IV_MAX $IV_MIN";
+
+(my $uvuformat = "%" . $Config{uvuformat}) =~ tr/"//d;
+(my $ivdformat = "%" . $Config{ivdformat}) =~ tr/"//d;
+
+my ( $got, @got, %got );
+my $true  = 1;
+my $false = '';
+my $zero  = 0;
+my $undef = undef;
+
+# 'bitwise' feature was experimental until 5.028
+no if $] < 5.028, warnings => 'experimental';
+use feature 'bitwise';
+
+# key to the truth
+is( 0+!!$true,      $true, '0+!!' );
+is( 0+!!$false,     $zero, '0+!!' );
+is( 0+!!$zero,      $zero, '0+!!' );
+is( 0+!!'a string', $true, '0+!!' );
+is( 0+!!$undef,     $zero, '0+!!' );
+
+# serpent of truth
+is( ~~!!$true,      $true, '~~!!' );
+is( ~~!!$false,     $zero, '~~!!' );
+is( ~~!!$zero,      $zero, '~~!!' );
+is( ~~!!'a string', $true, '~~!!' );
+is( ~~!!$undef,     $zero, '~~!!' );
+
+# inchworm
+{
+    no warnings 'numeric';
+    $got = time;
+    is( ~~ localtime $got, 0, '~~' );
+}
+
+@got = localtime;
+is( ~~ @got, 9, '~~' );
+
+is( ~~ 1.23, 1, '~~ exception' );    # floating point
+
+$got = '1.23';                       # string
+is( ~~ $got, 1, '~~ exception' ) if $got != 0;    # used in numeric context
+
+$got = $UV_MAX + 1;
+is( ~~ $got, sprintf($uvuformat, $UV_MAX), '~~ exception' );
+$got = -1;
+is( ~~ $got, sprintf($uvuformat, $UV_MAX), '~~ exception' );
+
+$got = 2**( 8 * $Config{uvsize} - 1 );
+{
+    use integer;
+    is( ~~ $got, sprintf($ivdformat, $IV_MIN), '~~ exception' );
+}
+$got = -2**( 8 * $Config{uvsize} - 1 ) - 1;
+{
+    use integer;
+    is( ~~ $got, sprintf($ivdformat, $IV_MIN), '~~ exception' );
+}
+
+# backward inchworm on a stick
+for my $val ( $IV_MAX, $IV_MIN + 1, 0, 1, -1 ) {
+    $got = $val;
+    if( $val <= 0 ) {
+        use integer;
+        is( ~- $got, $val - 1, '~-' );
+    }
+    elsif( $Config{'use64bitint'} ) {
+        TODO: {
+            local $TODO = 'fails with use64bitint';
+            is( ~- $got, $val - 1, '~-' ); # TODO
+        }
+    }
+    else {
+        is( ~- $got, $val - 1, '~-' );
+    }
+}
+
+# forward inchworm on a stick
+for my $val ( $IV_MAX -1 , $IV_MIN, 0, 1, -1 ) {
+    $got = $val;
+    if( $val >= 0 ) {
+        use integer;
+        is( -~ $got, $val + 1, '-~' );
+    }
+    elsif( $Config{'use64bitint'} ) {
+        TODO: {
+            local $TODO = 'fails with use64bitint';
+            is( -~ $got, $val + 1, '-~' );
+        }
+    }
+    else {
+        is( -~ $got, $val + 1, '-~' );
+    }
+}
+
+# kite
+{
+    no warnings 'numeric';
+    @got = ( ~~<DATA>, ~~<DATA> );
+    is( "@got", "0 0", '~~<>' );
+    @got = ( ~~<DATA> );    # return '' instead of undef at EOF
+    is( "@got", '0', '~~<>' );
+}
+
+done_testing;
+
+__DATA__
+31337 is eleet
+camel
+llama

t/secret.t

@@ -89,7 +89,7 @@ if( $] >= 5.010 ) {
 
 # inchworm
 $got = time;
-is( scalar localtime $got, ~~ localtime $got, '~~' );
+is( ~~ localtime $got, scalar localtime $got, '~~' );
 @got = localtime;
 is( ~~ @got, 9, '~~' );