Fatalize the use of code points above 0xFF for bitwise operators.

This commit removes quite a number of tests, mostly from t/op/bop.t,
which test the behaviour of such code points in combination of
bitwise operators. Since it's now fatal, the tests are no longer useful.

9 files changed, 56 insertions, 206 deletions

diff --git a/doop.c b/doop.c
index 1b71402485..c97d9e3208 100644
--- a/doop.c
+++ b/doop.c
@@ -1029,7 +1029,6 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     const char *rsave;
     bool left_utf;
     bool right_utf;
-    bool do_warn_above_ff = ckWARN_d(WARN_DEPRECATED);
     STRLEN needlen = 0;
 
     PERL_ARGS_ASSERT_DO_VOP;
@@ -1110,11 +1109,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 		rulen -= ulen;
 		duc = luc & ruc;
 		dc = (char*)uvchr_to_utf8((U8*)dc, duc);
-                if (do_warn_above_ff && (luc > 0xff || ruc > 0xff)) {
-                    Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                                deprecated_above_ff_msg, PL_op_desc[optype]);
-                    /* Warn only once per operation */
-                    do_warn_above_ff = FALSE;
+                if (luc > 0xff || ruc > 0xff) {
+                    Perl_croak(aTHX_ fatal_above_ff_msg, PL_op_desc[optype]);
                 }
 	    }
 	    if (sv == left || sv == right)
@@ -1134,10 +1130,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 		rulen -= ulen;
 		duc = luc ^ ruc;
 		dc = (char*)uvchr_to_utf8((U8*)dc, duc);
-                if (do_warn_above_ff && (luc > 0xff || ruc > 0xff)) {
-                    Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                                deprecated_above_ff_msg, PL_op_desc[optype]);
-                    do_warn_above_ff = FALSE;
+                if (luc > 0xff || ruc > 0xff) {
+                    Perl_croak(aTHX_ fatal_above_ff_msg, PL_op_desc[optype]);
                 }
 	    }
 	    goto mop_up_utf;
@@ -1153,10 +1147,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
 		rulen -= ulen;
 		duc = luc | ruc;
 		dc = (char*)uvchr_to_utf8((U8*)dc, duc);
-                if (do_warn_above_ff && (luc > 0xff || ruc > 0xff)) {
-                    Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                                deprecated_above_ff_msg, PL_op_desc[optype]);
-                    do_warn_above_ff = FALSE;
+                if (luc > 0xff || ruc > 0xff) {
+                    Perl_croak(aTHX_ fatal_above_ff_msg, PL_op_desc[optype]);
                 }
 	    }
 	  mop_up_utf:
diff --git a/op.h b/op.h
index 5a29bfbe2c..ef85148bfd 100644
--- a/op.h
+++ b/op.h
@@ -1098,10 +1098,9 @@ C<sib> is non-null. For a higher-level interface, see C<L</op_sibling_splice>>.
 #define MDEREF_SHIFT           7
 
 #if defined(PERL_IN_DOOP_C) || defined(PERL_IN_PP_C)
-static const char * const deprecated_above_ff_msg
+static const char * const fatal_above_ff_msg
     = "Use of strings with code points over 0xFF as arguments to "
-      "%s operator is deprecated. This will be a fatal error in "
-      "Perl 5.28";
+      "%s operator is not allowed";
 #endif
 
 
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 58e71e1068..93d76782ff 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -91,6 +91,11 @@ Use C<B::Concise::b_terse> instead.
 
 This was deprecated in Perl 5.004.
 
+=head2 Use of strings with code points over 0xFF is not allowed for
+bitwise string operators
+
+Code points over 0xFF do not make sense for bitwise operators.
+
 =head1 Deprecations
 
 XXX Any deprecated features, syntax, modules etc. should be listed here.
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 3bbd476b14..60f32ecb30 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -7055,14 +7055,14 @@ its behavior may change or even be removed in any future release of perl.
 See the explanation under L<perlvar/$_>.
 
 =item Use of strings with code points over 0xFF as arguments to %s
-operator is deprecated. This will be a fatal error in Perl 5.28
+operator is not allowed
 
-(D deprecated) You tried to use one of the string bitwise operators
+(F) You tried to use one of the string bitwise operators
 (C<&> or C<|> or C<^> or C<~>) on a string containing a code point over
 0xFF.  The string bitwise operators treat their operands as strings of
 bytes, and values beyond 0xFF are nonsensical in this context.
 
-Such usage will be a fatal error in Perl 5.28.
+This became fatal in Perl 5.28.
 
 =item Use of strings with code points over 0xFF as arguments to C<vec>
 is deprecated. This will be a fatal error in Perl 5.32
diff --git a/pp.c b/pp.c
index 75d526768a..0bb1d61e71 100644
--- a/pp.c
+++ b/pp.c
@@ -2641,10 +2641,11 @@ S_scomplement(pTHX_ SV *targ, SV *sv)
 	  STRLEN targlen = 0;
 	  STRLEN l;
 	  UV nchar = 0;
-	  UV nwide = 0;
 	  U8 * const send = tmps + len;
 	  U8 * const origtmps = tmps;
 	  const UV utf8flags = UTF8_ALLOW_ANYUV;
+	  U8 *result;
+	  U8 *p;
 
 	  while (tmps < send) {
 	    const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
@@ -2652,45 +2653,23 @@ S_scomplement(pTHX_ SV *targ, SV *sv)
 	    targlen += UVCHR_SKIP(~c);
 	    nchar++;
 	    if (c > 0xff)
-		nwide++;
+                Perl_croak(aTHX_
+                           fatal_above_ff_msg, PL_op_desc[PL_op->op_type]);
 	  }
 
 	  /* Now rewind strings and write them. */
 	  tmps = origtmps;
 
-	  if (nwide) {
-	      U8 *result;
-	      U8 *p;
-
-              Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
-                        deprecated_above_ff_msg, PL_op_desc[PL_op->op_type]);
-	      Newx(result, targlen + 1, U8);
-	      p = result;
-	      while (tmps < send) {
-		  const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
-		  tmps += l;
-		  p = uvchr_to_utf8_flags(p, ~c, UNICODE_ALLOW_ANY);
-	      }
-	      *p = '\0';
-	      sv_usepvn_flags(TARG, (char*)result, targlen,
-			      SV_HAS_TRAILING_NUL);
-	      SvUTF8_on(TARG);
-	  }
-	  else {
-	      U8 *result;
-	      U8 *p;
-
-	      Newx(result, nchar + 1, U8);
-	      p = result;
-	      while (tmps < send) {
-		  const U8 c = (U8)utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
-		  tmps += l;
-		  *p++ = ~c;
-	      }
-	      *p = '\0';
-	      sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
-	      SvUTF8_off(TARG);
-	  }
+	  Newx(result, nchar + 1, U8);
+	  p = result;
+	  while (tmps < send) {
+              const U8 c = (U8)utf8n_to_uvchr(tmps, send-tmps, &l, utf8flags);
+              tmps += l;
+              *p++ = ~c;
+          }
+          *p = '\0';
+          sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
+          SvUTF8_off(TARG);
 	  return;
 	}
 #ifdef LIBERAL
diff --git a/t/lib/warnings/doop b/t/lib/warnings/doop
index d5624ce2f1..09db146737 100644
--- a/t/lib/warnings/doop
+++ b/t/lib/warnings/doop
@@ -5,37 +5,6 @@ $_ = "\x80  \xff" ;
 chop ;
 EXPECT
 ########
-# NAME deprecation of logical bit operations with above ff code points
-$_ = "\xFF" & "\x{100}";        # Above ff second
-$_ = "\xFF" | "\x{101}";
-$_ = "\xFF" ^ "\x{102}";
-$_ = "\x{100}" & "\x{FF}";      # Above ff first
-$_ = "\x{101}" | "\x{FF}";
-$_ = "\x{102}" ^ "\x{FF}";
-$_ = "\x{100}" & "\x{103}";     # both above ff has just one message raised
-$_ = "\x{101}" | "\x{104}";
-$_ = "\x{102}" ^ "\x{105}";
-no warnings 'deprecated';
-$_ = "\xFF" & "\x{100}";
-$_ = "\xFF" | "\x{101}";
-$_ = "\xFF" ^ "\x{101}";
-$_ = "\x{100}" & "\x{FF}";
-$_ = "\x{101}" | "\x{FF}";
-$_ = "\x{102}" ^ "\x{FF}";
-$_ = "\x{100}" & "\x{103}";
-$_ = "\x{101}" | "\x{104}";
-$_ = "\x{102}" ^ "\x{105}";
-EXPECT
-Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 1.
-Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 2.
-Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 3.
-Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 4.
-Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 5.
-Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 6.
-Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 7.
-Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 8.
-Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 9.
-########
 # NAME vec with above ff code points is deprecated
 my $foo = "\x{100}" . "\xff\xfe";
 eval { vec($foo, 1, 8) };
diff --git a/t/lib/warnings/pp b/t/lib/warnings/pp
index 33d438b541..d94a480a99 100644
--- a/t/lib/warnings/pp
+++ b/t/lib/warnings/pp
@@ -21,8 +21,6 @@
   Constant subroutine (anonymous) undefined
 	$foo = sub () { 3 }; undef &$foo;
 
-  Use of strings with code points over 0xFF as arguments to 1's complement (~) operator is deprecated. This will be a fatal error in Perl 5.28
-
   Invalid negative number (%s) in chr
 
 __END__
@@ -133,14 +131,6 @@ $_ = "\x80  \xff" ;
 reverse ;
 EXPECT
 ########
-# NAME deprecation of complement with above ff code points
-$_ = ~ "\xff";
-$_ = ~ "\x{100}";
-EXPECT
-OPTION regex
-Use of strings with code points over 0xFF as arguments to 1's complement \(~\) operator is deprecated. This will be a fatal error in Perl 5.28 at - line \d+.
-Use of code point 0xFF+EFF is not allowed; the permissible max is 0x7F+ at - line 2\.
-########
 # NAME chr -1
 use warnings 'utf8';
 my $chr = chr(-1);
diff --git a/t/op/bop.t b/t/op/bop.t
index 1704fddc98..45ebb00e3b 100644
--- a/t/op/bop.t
+++ b/t/op/bop.t
@@ -19,7 +19,7 @@ BEGIN {
 # If you find tests are failing, please try adding names to tests to track
 # down where the failure is, and supply your new names as a patch.
 # (Just-in-time test naming)
-plan tests => 187 + (10*13*2) + 5 + 31;
+plan tests => 334;
 
 # numerics
 ok ((0xdead & 0xbeef) == 0x9ead);
@@ -109,34 +109,6 @@ is ("ok \x{FF}\x{FF}\n" & "ok 22\n", "ok 22\n");
 is ("ok 23\n" | "ok \x{0}\x{0}\n", "ok 23\n");
 is ("o\x{0} \x{0}4\x{0}" ^ "\x{0}k\x{0}2\x{0}\n", "ok 24\n");
 
-#
-is (sprintf("%vd", v4095 & v801), 801);
-is (sprintf("%vd", v4095 | v801), 4095);
-is (sprintf("%vd", v4095 ^ v801), 3294);
-
-#
-is (sprintf("%vd", v4095.801.4095 & v801.4095), '801.801');
-is (sprintf("%vd", v4095.801.4095 | v801.4095), '4095.4095.4095');
-is (sprintf("%vd", v801.4095 ^ v4095.801.4095), '3294.3294.4095');
-#
-is (sprintf("%vd", v120.300 & v200.400), '72.256');
-is (sprintf("%vd", v120.300 | v200.400), '248.444');
-is (sprintf("%vd", v120.300 ^ v200.400), '176.188');
-#
-{
-    my $a = v120.300;
-    my $b = v200.400;
-    $a ^= $b;
-    is (sprintf("%vd", $a), '176.188');
-}
-{
-    my $a = v120.300;
-    my $b = v200.400;
-    $a |= $b;
-    is (sprintf("%vd", $a), '248.444');
-}
-
-
 # More variations on 19 and 22.
 is ("ok \xFF\x{FF}\n" & "ok 41\n", "ok 41\n");
 is ("ok \x{FF}\xFF\n" & "ok 42\n", "ok 42\n");
@@ -314,77 +286,6 @@ SKIP: {
     ok($b =~ /b+$/, 'Unicode "b" is NUL-terminated');
 }
 
-{
-    $a = chr(0x101) x 0x101;
-    $b = chr(0x0FF) x 0x0FF;
-
-    $c = $a | $b;
-    is($c, chr(0x1FF) x 0xFF . chr(0x101) x 2);
-
-    $c = $b | $a;
-    is($c, chr(0x1FF) x 0xFF . chr(0x101) x 2);
-
-    $c = $a & $b;
-    is($c, chr(0x001) x 0x0FF);
-
-    $c = $b & $a;
-    is($c, chr(0x001) x 0x0FF);
-
-    $c = $a ^ $b;
-    is($c, chr(0x1FE) x 0x0FF . chr(0x101) x 2);
-
-    $c = $b ^ $a;
-    is($c, chr(0x1FE) x 0x0FF . chr(0x101) x 2);
-}
-
-{
-    $a = chr(0x101) x 0x101;
-    $b = chr(0x0FF) x 0x0FF;
-
-    $a |= $b;
-    is($a, chr(0x1FF) x 0xFF . chr(0x101) x 2);
-}
-
-{
-    $a = chr(0x101) x 0x101;
-    $b = chr(0x0FF) x 0x0FF;
-
-    $b |= $a;
-    is($b, chr(0x1FF) x 0xFF . chr(0x101) x 2);
-}
-
-{
-    $a = chr(0x101) x 0x101;
-    $b = chr(0x0FF) x 0x0FF;
-
-    $a &= $b;
-    is($a, chr(0x001) x 0x0FF);
-}
-
-{
-    $a = chr(0x101) x 0x101;
-    $b = chr(0x0FF) x 0x0FF;
-
-    $b &= $a;
-    is($b, chr(0x001) x 0x0FF);
-}
-
-{
-    $a = chr(0x101) x 0x101;
-    $b = chr(0x0FF) x 0x0FF;
-
-    $a ^= $b;
-    is($a, chr(0x1FE) x 0x0FF . chr(0x101) x 2);
-}
-
-{
-    $a = chr(0x101) x 0x101;
-    $b = chr(0x0FF) x 0x0FF;
-
-    $b ^= $a;
-    is($b, chr(0x1FE) x 0x0FF . chr(0x101) x 2);
-}
-
 
 # New string- and number-specific bitwise ops
 {
@@ -478,7 +379,7 @@ for (
 ) {
     my ($val, $orig, $type) = @$_;
 
-    for (["x", "string"], ["\x{100}", "utf8"]) {
+    for (["x", "string"]) {
         my ($str, $desc) = @$_;
 
         $warn = 0;
@@ -632,3 +533,26 @@ is $byte, "\0", "utf8 &. appends null byte";
 fresh_perl_is('$x = "UUUUUUUV"; $y = "xxxxxxx"; $x |= $y; print $x',
               ( $::IS_EBCDIC) ? 'XXXXXXXV' : '}}}}}}}V',
               {}, "[perl #129995] access to freed memory");
+
+
+#
+# Using code points above 0xFF is fatal
+#
+foreach my $op_info ([and => "&"], [or => "|"], [xor => "^"]) {
+    my ($op_name, $op) = @$op_info;
+    local $@;
+    eval '$_ = "\xFF" ' . $op . ' "\x{100}";';
+    like $@, qr /^Use of strings with code points over 0xFF as arguments (?#
+                 )to bitwise $op_name \Q($op)\E operator is not allowed/,
+         "Use of code points above 0xFF as arguments to bitwise " .
+         "$op_name ($op) is not allowed";
+}
+
+{
+    local $@;
+    eval '$_ = ~ "\x{100}";';
+    like $@, qr /^Use of strings with code points over 0xFF as arguments (?#
+                 )to 1's complement \(~\) operator is not allowed/,
+         "Use of code points above 0xFF as argument to 1's complement " .
+         "(~) is not allowed";
+}
diff --git a/t/op/substr.t b/t/op/substr.t
index 3c7f0eb158..3d850f51e1 100644
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -22,7 +22,7 @@ $SIG{__WARN__} = sub {
      }
 };
 
-plan(393);
+plan(392);
 
 run_tests() unless caller;
 
@@ -711,14 +711,6 @@ is($x, "\x{100}\x{200}\xFFb");
 
 }
 
-# [perl #23765]
-{
-    my $a = pack("C", 0xbf);
-    no warnings 'deprecated';
-    substr($a, -1) &= chr(0xfeff);
-    is($a, "\xbf");
-}
-
 # [perl #34976] incorrect caching of utf8 substr length
 {
     my  $a = "abcd\x{100}";