1#!perl -w 2 3use strict; 4use utf8; 5use Tie::Hash; 6use Test::More; 7 8BEGIN {use_ok('XS::APItest')}; 9 10sub preform_test; 11sub test_present; 12sub test_absent; 13sub test_delete_present; 14sub test_delete_absent; 15sub brute_force_exists; 16sub test_store; 17sub test_fetch_present; 18sub test_fetch_absent; 19 20my $utf8_for_258 = chr 258; 21utf8::encode $utf8_for_258; 22 23my @testkeys = ('N', chr utf8::unicode_to_native(198), chr 256); 24my @keys = (@testkeys, $utf8_for_258); 25 26foreach (@keys) { 27 utf8::downgrade $_, 1; 28} 29main_tests (\@keys, \@testkeys, ''); 30 31foreach (@keys) { 32 utf8::upgrade $_; 33} 34main_tests (\@keys, \@testkeys, ' [utf8 hash]'); 35 36{ 37 my %h = (a=>'cheat'); 38 tie %h, 'Tie::StdHash'; 39 # is bug 36327 fixed? 40 my $result = ($] > 5.009) ? undef : 1; 41 42 is (XS::APItest::Hash::store(\%h, chr 258, 1), $result); 43 44 ok (!exists $h{$utf8_for_258}, 45 "hv_store doesn't insert a key with the raw utf8 on a tied hash"); 46} 47 48{ 49 my $strtab = strtab(); 50 is (ref $strtab, 'HASH', "The shared string table quacks like a hash"); 51 my $wibble = "\0"; 52 eval { 53 $strtab->{$wibble}++; 54 }; 55 my $prefix = "Cannot modify shared string table in hv_"; 56 my $what = $prefix . 'fetch'; 57 like ($@, qr/^$what/,$what); 58 eval { 59 XS::APItest::Hash::store($strtab, 'Boom!', 1) 60 }; 61 $what = $prefix . 'store'; 62 like ($@, qr/^$what/, $what); 63 if (0) { 64 A::B->method(); 65 } 66 # DESTROY should be in there. 67 eval { 68 delete $strtab->{DESTROY}; 69 }; 70 $what = $prefix . 'delete'; 71 like ($@, qr/^$what/, $what); 72 # I can't work out how to get to the code that flips the wasutf8 flag on 73 # the hash key without some ikcy XS 74} 75 76{ 77 is_deeply([&XS::APItest::Hash::test_hv_free_ent], [2,2,1,1], 78 "hv_free_ent frees the value immediately"); 79 is_deeply([&XS::APItest::Hash::test_hv_delayfree_ent], [2,2,2,1], 80 "hv_delayfree_ent keeps the value around until FREETMPS"); 81} 82 83foreach my $in ("", "N", "a\0b") { 84 my $got = XS::APItest::Hash::test_share_unshare_pvn($in); 85 is ($got, $in, "test_share_unshare_pvn"); 86} 87 88{ 89 foreach ([\&XS::APItest::Hash::rot13_hash, \&rot13, "rot 13"], 90 [\&XS::APItest::Hash::bitflip_hash, \&bitflip, "bitflip"], 91 ) { 92 my ($setup, $mapping, $name) = @$_; 93 my %hash; 94 my %placebo = (a => 1, p => 2, i => 4, e => 8); 95 $setup->(\%hash); 96 $hash{a}++; @hash{qw(p i e)} = (2, 4, 8); 97 98 test_U_hash(\%hash, \%placebo, [f => 9, g => 10, h => 11], $mapping, 99 $name); 100 } 101 foreach my $upgrade_o (0, 1) { 102 foreach my $upgrade_n (0, 1) { 103 my (%hash, %placebo); 104 XS::APItest::Hash::bitflip_hash(\%hash); 105 foreach my $new (["7", utf8::unicode_to_native(65), 106 utf8::unicode_to_native(67), 107 utf8::unicode_to_native(80) 108 ], 109 ["8", utf8::unicode_to_native(163), 110 utf8::unicode_to_native(171), 111 utf8::unicode_to_native(215) 112 ], 113 ["U", 2603, 2604, 2604], 114 ) { 115 foreach my $code (utf8::unicode_to_native(78), 116 utf8::unicode_to_native(240), 117 256, 118 1336 119 ) { 120 my $key = chr $code; 121 # This is the UTF-8 byte sequence for the key. 122 my $key_utf8 = $key; 123 utf8::encode($key_utf8); 124 if ($upgrade_o) { 125 $key .= chr 256; 126 chop $key; 127 } 128 $hash{$key} = $placebo{$key} = $code; 129 $hash{$key_utf8} = $placebo{$key_utf8} = "$code as UTF-8"; 130 } 131 my $name = 'bitflip ' . shift @$new; 132 my @new_kv; 133 foreach my $code (@$new) { 134 my $key = chr $code; 135 if ($upgrade_n) { 136 $key .= chr 256; 137 chop $key; 138 } 139 push @new_kv, $key, $_; 140 } 141 142 $name .= ' upgraded(orig) ' if $upgrade_o; 143 $name .= ' upgraded(new) ' if $upgrade_n; 144 test_U_hash(\%hash, \%placebo, \@new_kv, \&bitflip, $name); 145 } 146 } 147 } 148} 149 150sub test_precomputed_hashes { 151 my $what = shift; 152 my $hash_it = shift; 153 my $ord = shift; 154 my $key_copy = $_[0]; 155 $key_copy .= ''; 156 157 my %hash; 158 is (XS::APItest::Hash::common({hv => \%hash, 159 "key$what" => $_[0], 160 val => $ord, 161 "hash_$what" => $hash_it, 162 action => XS::APItest::HV_FETCH_ISSTORE}), 163 $ord, "store $ord with $what \$hash_it = $hash_it"); 164 is_deeply ([each %hash], [$_[0], $ord], "First key read is good"); 165 is_deeply ([each %hash], [], "No second key good"); 166 167 is ($hash{$_[0]}, $ord, "Direct hash read finds $ord"); 168 169 is_deeply ([each %hash], [$key_copy, $ord], 170 "First key read is good with a copy"); 171 is_deeply ([each %hash], [], "No second key good"); 172 173 is ($hash{$key_copy}, $ord, "Direct hash read finds $ord"); 174} 175 176{ 177 my $as_utf8 = "\241" . chr 256; 178 chop $as_utf8; 179 my $as_bytes = "\243"; 180 foreach my $key ('N', $as_bytes, $as_utf8, "\x{2623}") { 181 my $ord = ord $key; 182 foreach my $hash_it (0, 1) { 183 foreach my $what (qw(pv sv)) { 184 test_precomputed_hashes($what, $hash_it, $ord, $key); 185 } 186 # Generate a shared hash key scalar 187 my %h = ($key => 1); 188 test_precomputed_hashes('sv', $hash_it, $ord, (keys %h)[0]); 189 } 190 } 191} 192 193{ 194 no warnings 'experimental::builtin'; 195 use builtin 'weaken'; 196 my %h; 197 fill_hash_with_nulls(\%h); 198 my @objs; 199 for("a".."z","A".."Z") { 200 weaken($objs[@objs] = $h{$_} = []); 201 } 202 undef %h; 203 no warnings 'uninitialized'; 204 local $" = ""; 205 is "@objs", "", 206 'explicitly undeffing a hash with nulls frees all entries'; 207 208 my $h = {}; 209 fill_hash_with_nulls($h); 210 @objs = (); 211 for("a".."z","A".."Z") { 212 weaken($objs[@objs] = $$h{$_} = []); 213 } 214 undef $h; 215 is "@objs", "", 'freeing a hash with nulls frees all entries'; 216} 217 218# Tests for HvENAME and UTF8 219{ 220 no strict; 221 no warnings 'void'; 222 my $hvref; 223 224 *{"\xff::bar"}; # autovivify %ÿ:: without UTF8 225 *{"\xff::bαr::"} = $hvref = \%foo::; 226 undef *foo::; 227 is HvENAME($hvref), "\xff::bαr", 228 'stash alias (utf8 inside bytes) does not create malformed UTF8'; 229 230 *{"é::foo"}; # autovivify %é:: with UTF8 231 *{"\xe9::\xe9::"} = $hvref = \%bar::; 232 undef *bar::; 233 is HvENAME($hvref), "\xe9::\xe9", 234 'stash alias (bytes inside utf8) does not create malformed UTF8'; 235 236 *{"\xfe::bar"}; *{"\xfd::bar"}; 237 *{"\xfe::bαr::"} = \%goo::; 238 *{"\xfd::bαr::"} = $hvref = \%goo::; 239 undef *goo::; 240 like HvENAME($hvref), qr/^[\xfe\xfd]::bαr\z/, 241 'multiple stash aliases (utf8 inside bytes) do not cause bad UTF8'; 242 243 *{"è::foo"}; *{"ë::foo"}; 244 *{"\xe8::\xe9::"} = $hvref = \%bear::; 245 *{"\xeb::\xe9::"} = \%bear::; 246 undef *bear::; 247 like HvENAME($hvref), qr"^[\xe8\xeb]::\xe9\z", 248 'multiple stash aliases (bytes inside utf8) do not cause bad UTF8'; 249} 250 251{ # newHVhv 252 use Tie::Hash; 253 tie my %h, 'Tie::StdHash'; 254 %h = 1..10; 255 is join(' ', sort %{newHVhv \%h}), '1 10 2 3 4 5 6 7 8 9', 256 'newHVhv on tied hash'; 257} 258 259# helem and hslice on entry with null value 260# This is actually a test for a Perl operator, not an XS API test. But it 261# requires a hash that can only be produced by XS (although recently it 262# could be encountered when tying hint hashes). 263{ 264 my %h; 265 fill_hash_with_nulls(\%h); 266 eval{ $h{84} = 1 }; 267 pass 'no crash when writing to hash elem with null value'; 268 eval{ no # silly 269 warnings; # thank you! 270 @h{85} = 1 }; 271 pass 'no crash when writing to hash elem with null value via slice'; 272 eval { delete local $h{86} }; 273 pass 'no crash during local deletion of hash elem with null value'; 274 eval { delete local @h{87,88} }; 275 pass 'no crash during local deletion of hash slice with null values'; 276} 277 278# [perl #111000] Bug number eleventy-one thousand: 279# hv_store should work on hint hashes 280eval q{ 281 BEGIN { 282 XS::APItest::Hash::store \%^H, "XS::APItest/hash.t", undef; 283 delete $^H{"XS::APItest/hash.t"}; 284 } 285}; 286pass("hv_store works on the hint hash"); 287 288{ 289 # [perl #79074] HeSVKEY_force loses UTF8ness 290 my %hash = ( "\xff" => 1, "\x{100}" => 1 ); 291 my @keys = sort ( XS::APItest::Hash::test_force_keys(\%hash) ); 292 is_deeply(\@keys, [ sort keys %hash ], "check HeSVKEY_force()"); 293} 294 295# Test that mg_copy is called when expected (and not called when not) 296# No (other) tests in core will fail if the implementation of `keys %tied_hash` 297# is (accidentally) changed to also call hv_iterval() and trigger mg_copy. 298# However, this behaviour is visible, and tested by Variable::Magic on CPAN. 299 300{ 301 my %h; 302 my $obj = tie %h, 'Tie::StdHash'; 303 sv_magic_mycopy(\%h); 304 305 is(sv_magic_mycopy_count(\%h), 0); 306 307 $h{perl} = "rules"; 308 309 is(sv_magic_mycopy_count(\%h), 1); 310 311 is($h{perl}, "rules", "found key"); 312 313 is(sv_magic_mycopy_count(\%h), 2); 314 315 # keys *doesn't* trigger copy magic, so the count is still 2 316 my @flat = keys %h; 317 318 is(sv_magic_mycopy_count(\%h), 2); 319 320 @flat = values %h; 321 322 is(sv_magic_mycopy_count(\%h), 3); 323 324 @flat = each %h; 325 326 is(sv_magic_mycopy_count(\%h), 4); 327} 328 329{ 330 # There are two API variants - hv_delete and hv_delete_ent. The Perl 331 # interpreter exclusively uses hv_delete_ent. Only XS code uses hv_delete. 332 # Hence the problem case could only be triggered by XS code called on 333 # symbol tables, and with particular non-ASCII keys: 334 335 # Deleting a key with WASUTF from a stash used to trigger a use-after free: 336 my $key = "\xFF\x{100}"; 337 chop $key; 338 ++$main::{$key}; 339 is(XS::APItest::Hash::delete(\%main::, $key), 1, 340 "hv_delete doesn't trigger a use-after free"); 341 342 # Perl code has always used this API, which never had the problem: 343 ++$main::{$key}; 344 is(XS::APItest::Hash::delete_ent(\%main::, $key), 1, 345 "hv_delete_ent never triggered a use-after free, but test it anyway"); 346} 347 348done_testing; 349exit; 350 351################################ The End ################################ 352 353sub test_U_hash { 354 my ($hash, $placebo, $new, $mapping, $message) = @_; 355 my @hitlist = keys %$placebo; 356 print "# $message\n"; 357 358 my @keys = sort keys %$hash; 359 is ("@keys", join(' ', sort($mapping->(keys %$placebo))), 360 "uvar magic called exactly once on store"); 361 362 is (keys %$hash, keys %$placebo); 363 364 my $victim = shift @hitlist; 365 is (delete $hash->{$victim}, delete $placebo->{$victim}); 366 367 is (keys %$hash, keys %$placebo); 368 @keys = sort keys %$hash; 369 is ("@keys", join(' ', sort($mapping->(keys %$placebo)))); 370 371 $victim = shift @hitlist; 372 is (XS::APItest::Hash::delete_ent ($hash, $victim, 373 XS::APItest::HV_DISABLE_UVAR_XKEY), 374 undef, "Deleting a known key with conversion disabled fails (ent)"); 375 is (keys %$hash, keys %$placebo); 376 377 is (XS::APItest::Hash::delete_ent ($hash, $victim, 0), 378 delete $placebo->{$victim}, 379 "Deleting a known key with conversion enabled works (ent)"); 380 is (keys %$hash, keys %$placebo); 381 @keys = sort keys %$hash; 382 is ("@keys", join(' ', sort($mapping->(keys %$placebo)))); 383 384 $victim = shift @hitlist; 385 is (XS::APItest::Hash::delete ($hash, $victim, 386 XS::APItest::HV_DISABLE_UVAR_XKEY), 387 undef, "Deleting a known key with conversion disabled fails"); 388 is (keys %$hash, keys %$placebo); 389 390 is (XS::APItest::Hash::delete ($hash, $victim, 0), 391 delete $placebo->{$victim}, 392 "Deleting a known key with conversion enabled works"); 393 is (keys %$hash, keys %$placebo); 394 @keys = sort keys %$hash; 395 is ("@keys", join(' ', sort($mapping->(keys %$placebo)))); 396 397 my ($k, $v) = splice @$new, 0, 2; 398 $hash->{$k} = $v; 399 $placebo->{$k} = $v; 400 is (keys %$hash, keys %$placebo); 401 @keys = sort keys %$hash; 402 is ("@keys", join(' ', sort($mapping->(keys %$placebo)))); 403 404 ($k, $v) = splice @$new, 0, 2; 405 is (XS::APItest::Hash::store_ent($hash, $k, $v), $v, "store_ent"); 406 $placebo->{$k} = $v; 407 is (keys %$hash, keys %$placebo); 408 @keys = sort keys %$hash; 409 is ("@keys", join(' ', sort($mapping->(keys %$placebo)))); 410 411 ($k, $v) = splice @$new, 0, 2; 412 is (XS::APItest::Hash::store($hash, $k, $v), $v, "store"); 413 $placebo->{$k} = $v; 414 is (keys %$hash, keys %$placebo); 415 @keys = sort keys %$hash; 416 is ("@keys", join(' ', sort($mapping->(keys %$placebo)))); 417 418 @hitlist = keys %$placebo; 419 $victim = shift @hitlist; 420 is (XS::APItest::Hash::fetch_ent($hash, $victim), $placebo->{$victim}, 421 "fetch_ent"); 422 is (XS::APItest::Hash::fetch_ent($hash, $mapping->($victim)), undef, 423 "fetch_ent (missing)"); 424 425 $victim = shift @hitlist; 426 is (XS::APItest::Hash::fetch($hash, $victim), $placebo->{$victim}, 427 "fetch"); 428 is (XS::APItest::Hash::fetch($hash, $mapping->($victim)), undef, 429 "fetch (missing)"); 430 431 $victim = shift @hitlist; 432 ok (XS::APItest::Hash::exists_ent($hash, $victim), "exists_ent"); 433 ok (!XS::APItest::Hash::exists_ent($hash, $mapping->($victim)), 434 "exists_ent (missing)"); 435 436 $victim = shift @hitlist; 437 die "Need a victim" unless defined $victim; 438 ok (XS::APItest::Hash::exists($hash, $victim), "exists"); 439 ok (!XS::APItest::Hash::exists($hash, $mapping->($victim)), 440 "exists (missing)"); 441 442 is (XS::APItest::Hash::common({hv => $hash, keysv => $victim}), 443 $placebo->{$victim}, "common (fetch)"); 444 is (XS::APItest::Hash::common({hv => $hash, keypv => $victim}), 445 $placebo->{$victim}, "common (fetch pv)"); 446 is (XS::APItest::Hash::common({hv => $hash, keysv => $victim, 447 action => XS::APItest::HV_DISABLE_UVAR_XKEY}), 448 undef, "common (fetch) missing"); 449 is (XS::APItest::Hash::common({hv => $hash, keypv => $victim, 450 action => XS::APItest::HV_DISABLE_UVAR_XKEY}), 451 undef, "common (fetch pv) missing"); 452 is (XS::APItest::Hash::common({hv => $hash, keysv => $mapping->($victim), 453 action => XS::APItest::HV_DISABLE_UVAR_XKEY}), 454 $placebo->{$victim}, "common (fetch) missing mapped"); 455 is (XS::APItest::Hash::common({hv => $hash, keypv => $mapping->($victim), 456 action => XS::APItest::HV_DISABLE_UVAR_XKEY}), 457 $placebo->{$victim}, "common (fetch pv) missing mapped"); 458} 459 460sub main_tests { 461 my ($keys, $testkeys, $description) = @_; 462 foreach my $key (@$testkeys) { 463 my $lckey = ($key eq chr utf8::unicode_to_native(198)) ? chr utf8::unicode_to_native(230) : lc $key; 464 my $unikey = $key; 465 utf8::encode $unikey; 466 467 utf8::downgrade $key, 1; 468 utf8::downgrade $lckey, 1; 469 utf8::downgrade $unikey, 1; 470 main_test_inner ($key, $lckey, $unikey, $keys, $description); 471 472 utf8::upgrade $key; 473 utf8::upgrade $lckey; 474 utf8::upgrade $unikey; 475 main_test_inner ($key, $lckey, $unikey, $keys, 476 $description . ' [key utf8 on]'); 477 } 478 479 # hv_exists was buggy for tied hashes, in that the raw utf8 key was being 480 # used - the utf8 flag was being lost. 481 perform_test (\&test_absent, (chr 258), $keys, ''); 482 483 perform_test (\&test_fetch_absent, (chr 258), $keys, ''); 484 perform_test (\&test_delete_absent, (chr 258), $keys, ''); 485} 486 487sub main_test_inner { 488 my ($key, $lckey, $unikey, $keys, $description) = @_; 489 perform_test (\&test_present, $key, $keys, $description); 490 perform_test (\&test_fetch_present, $key, $keys, $description); 491 perform_test (\&test_delete_present, $key, $keys, $description); 492 493 perform_test (\&test_store, $key, $keys, $description, [a=>'cheat']); 494 perform_test (\&test_store, $key, $keys, $description, []); 495 496 perform_test (\&test_absent, $lckey, $keys, $description); 497 perform_test (\&test_fetch_absent, $lckey, $keys, $description); 498 perform_test (\&test_delete_absent, $lckey, $keys, $description); 499 500 return if $unikey eq $key; 501 502 perform_test (\&test_absent, $unikey, $keys, $description); 503 perform_test (\&test_fetch_absent, $unikey, $keys, $description); 504 perform_test (\&test_delete_absent, $unikey, $keys, $description); 505} 506 507sub perform_test { 508 my ($test_sub, $key, $keys, $message, @other) = @_; 509 my $printable = join ',', map {ord} split //, $key; 510 511 my (%hash, %tiehash); 512 tie %tiehash, 'Tie::StdHash'; 513 514 @hash{@$keys} = @$keys; 515 @tiehash{@$keys} = @$keys; 516 517 &$test_sub (\%hash, $key, $printable, $message, @other); 518 &$test_sub (\%tiehash, $key, $printable, "$message tie", @other); 519} 520 521sub test_present { 522 my ($hash, $key, $printable, $message) = @_; 523 524 ok (exists $hash->{$key}, "hv_exists_ent present$message $printable"); 525 ok (XS::APItest::Hash::exists ($hash, $key), 526 "hv_exists present$message $printable"); 527} 528 529sub test_absent { 530 my ($hash, $key, $printable, $message) = @_; 531 532 ok (!exists $hash->{$key}, "hv_exists_ent absent$message $printable"); 533 ok (!XS::APItest::Hash::exists ($hash, $key), 534 "hv_exists absent$message $printable"); 535} 536 537sub test_delete_present { 538 my ($hash, $key, $printable, $message) = @_; 539 540 my $copy = {}; 541 my $class = tied %$hash; 542 if (defined $class) { 543 tie %$copy, ref $class; 544 } 545 $copy = {%$hash}; 546 ok (brute_force_exists ($copy, $key), 547 "hv_delete_ent present$message $printable"); 548 is (delete $copy->{$key}, $key, "hv_delete_ent present$message $printable"); 549 ok (!brute_force_exists ($copy, $key), 550 "hv_delete_ent present$message $printable"); 551 $copy = {%$hash}; 552 ok (brute_force_exists ($copy, $key), 553 "hv_delete present$message $printable"); 554 is (XS::APItest::Hash::delete ($copy, $key), $key, 555 "hv_delete present$message $printable"); 556 ok (!brute_force_exists ($copy, $key), 557 "hv_delete present$message $printable"); 558} 559 560sub test_delete_absent { 561 my ($hash, $key, $printable, $message) = @_; 562 563 my $copy = {}; 564 my $class = tied %$hash; 565 if (defined $class) { 566 tie %$copy, ref $class; 567 } 568 $copy = {%$hash}; 569 is (delete $copy->{$key}, undef, "hv_delete_ent absent$message $printable"); 570 $copy = {%$hash}; 571 is (XS::APItest::Hash::delete ($copy, $key), undef, 572 "hv_delete absent$message $printable"); 573} 574 575sub test_store { 576 my ($hash, $key, $printable, $message, $defaults) = @_; 577 my $HV_STORE_IS_CRAZY = 1; 578 579 # We are cheating - hv_store returns NULL for a store into an empty 580 # tied hash. This isn't helpful here. 581 582 my $class = tied %$hash; 583 584 # It's important to do this with nice new hashes created each time round 585 # the loop, rather than hashes in the pad, which get recycled, and may have 586 # xhv_array non-NULL 587 my $h1 = {@$defaults}; 588 my $h2 = {@$defaults}; 589 if (defined $class) { 590 tie %$h1, ref $class; 591 tie %$h2, ref $class; 592 if ($] > 5.009) { 593 # bug 36327 is fixed 594 $HV_STORE_IS_CRAZY = undef; 595 } else { 596 # HV store_ent returns 1 if there was already underlying hash storage 597 $HV_STORE_IS_CRAZY = undef unless @$defaults; 598 } 599 } 600 is (XS::APItest::Hash::store_ent($h1, $key, 1), $HV_STORE_IS_CRAZY, 601 "hv_store_ent$message $printable"); 602 ok (brute_force_exists ($h1, $key), "hv_store_ent$message $printable"); 603 is (XS::APItest::Hash::store($h2, $key, 1), $HV_STORE_IS_CRAZY, 604 "hv_store$message $printable"); 605 ok (brute_force_exists ($h2, $key), "hv_store$message $printable"); 606} 607 608sub test_fetch_present { 609 my ($hash, $key, $printable, $message) = @_; 610 611 is ($hash->{$key}, $key, "hv_fetch_ent present$message $printable"); 612 is (XS::APItest::Hash::fetch ($hash, $key), $key, 613 "hv_fetch present$message $printable"); 614} 615 616sub test_fetch_absent { 617 my ($hash, $key, $printable, $message) = @_; 618 619 is ($hash->{$key}, undef, "hv_fetch_ent absent$message $printable"); 620 is (XS::APItest::Hash::fetch ($hash, $key), undef, 621 "hv_fetch absent$message $printable"); 622} 623 624sub brute_force_exists { 625 my ($hash, $key) = @_; 626 foreach (keys %$hash) { 627 return 1 if $key eq $_; 628 } 629 return 0; 630} 631 632sub rot13 { 633 my @results = map {my $a = $_; $a =~ tr/A-Za-z/N-ZA-Mn-za-m/; $a} @_; 634 wantarray ? @results : $results[0]; 635} 636 637sub bitflip { 638 my $flip_bit = ord("A") ^ ord("a"); 639 my @results = map {join '', map {chr($flip_bit ^ ord $_)} split '', $_} @_; 640 wantarray ? @results : $results[0]; 641} 642