lib/builtin.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require './test.pl';
   6     set_up_inc('../lib');
   7 }
   8
   9 use v5.36;
  10 no warnings 'experimental::builtin';
  11 use Config;
  12
  13 package FetchStoreCounter {
  14     sub TIESCALAR($class, @args) { bless \@args, $class }
  15
  16     sub FETCH($self)    { $self->[0]->$*++ }
  17     sub STORE($self, $) { $self->[1]->$*++ }
  18 }
  19
  20 # booleans
  21 {
  22     use builtin qw( true false is_bool );
  23
  24     ok(true, 'true is true');
  25     ok(!false, 'false is false');
  26
  27     ok(is_bool(true), 'true is bool');
  28     ok(is_bool(false), 'false is bool');
  29     ok(!is_bool(undef), 'undef is not bool');
  30     ok(!is_bool(1), '1 is not bool');
  31     ok(!is_bool(""), 'empty is not bool');
  32
  33     my $truevar  = (5 == 5);
  34     my $falsevar = (5 == 6);
  35
  36     ok(is_bool($truevar), '$truevar is bool');
  37     ok(is_bool($falsevar), '$falsevar is bool');
  38
  39     ok(is_bool(is_bool(true)), 'is_bool true is bool');
  40     ok(is_bool(is_bool(123)),  'is_bool false is bool');
  41
  42     # Invokes magic
  43
  44     tie my $tied, FetchStoreCounter => (\my $fetchcount, \my $storecount);
  45
  46     my $_dummy = is_bool($tied);
  47     is($fetchcount, 1, 'is_bool() invokes FETCH magic');
  48
  49     $tied = is_bool(false);
  50     is($storecount, 1, 'is_bool() invokes STORE magic');
  51
  52     is(prototype(\&builtin::is_bool), '$', 'is_bool prototype');
  53 }
  54
  55 # float constants
  56 {
  57     use builtin qw( inf nan );
  58
  59     if ($Config{d_double_has_inf}) {
  60         ok(inf, 'inf is true');
  61         ok(inf > 1E10, 'inf is bigger than 1E10');
  62         ok(inf == inf, 'inf is equal to inf');
  63         ok(inf == inf + 1, 'inf is equal to inf + 1');
  64
  65         # Invoke the real XSUB
  66         my $inf = ( \&builtin::inf )->();
  67         ok($inf == $inf + 1, 'inf returned by real xsub');
  68     } else {
  69         is(eval { inf }, undef, 'inf throws');
  70         my $e = $@;
  71         like($e, qr/^builtin::inf not implemented at/, 'inf fails with correct error');
  72     }
  73
  74     if ($Config{d_double_has_nan}) {
  75         ok(nan != nan, 'NaN is not equal to NaN');
  76
  77         my $nan = ( \&builtin::nan )->();
  78         ok($nan != $nan, 'NaN returned by real xsub');
  79     } else {
  80         is(eval { nan }, undef, 'nan throws');
  81         my $e = $@;
  82         like($e, qr/^builtin::nan not implemented at/, 'nan fails with correct error');
  83     }
  84 }
  85
  86 # weakrefs
  87 {
  88     use builtin qw( is_weak weaken unweaken );
  89
  90     my $arr = [];
  91     my $ref = $arr;
  92
  93     ok(!is_weak($ref), 'ref is not weak initially');
  94
  95     weaken($ref);
  96     ok(is_weak($ref), 'ref is weak after weaken()');
  97
  98     unweaken($ref);
  99     ok(!is_weak($ref), 'ref is not weak after unweaken()');
 100
 101     weaken($ref);
 102     undef $arr;
 103     is($ref, undef, 'ref is now undef after arr is cleared');
 104
 105     is(prototype(\&builtin::weaken), '$', 'weaken prototype');
 106     is(prototype(\&builtin::unweaken), '$', 'unweaken prototype');
 107     is(prototype(\&builtin::is_weak), '$', 'is_weak prototype');
 108 }
 109
 110 # reference queries
 111 {
 112     use builtin qw( refaddr reftype blessed );
 113
 114     my $arr = [];
 115     my $obj = bless [], "Object";
 116
 117     is(refaddr($arr),        $arr+0, 'refaddr yields same as ref in numeric context');
 118     is(refaddr("not a ref"), undef,  'refaddr yields undef for non-reference');
 119
 120     is(reftype($arr),        "ARRAY", 'reftype yields type string');
 121     is(reftype($obj),        "ARRAY", 'reftype yields basic container type for blessed object');
 122     is(reftype("not a ref"), undef,   'reftype yields undef for non-reference');
 123
 124     is(blessed($arr), undef, 'blessed yields undef for non-object');
 125     is(blessed($obj), "Object", 'blessed yields package name for object');
 126
 127     # blessed() as a boolean
 128     is(blessed($obj) ? "YES" : "NO", "YES", 'blessed in boolean context still works');
 129
 130     # blessed() appears false as a boolean on package "0"
 131     is(blessed(bless [], "0") ? "YES" : "NO", "NO", 'blessed in boolean context handles "0" cornercase');
 132
 133     is(prototype(\&builtin::blessed), '$', 'blessed prototype');
 134     is(prototype(\&builtin::refaddr), '$', 'refaddr prototype');
 135     is(prototype(\&builtin::reftype), '$', 'reftype prototype');
 136 }
 137
 138 # created_as_...
 139 {
 140     use builtin qw( created_as_string created_as_number );
 141
 142     # some literal constants
 143     ok(!created_as_string(undef), 'undef created as !string');
 144     ok(!created_as_number(undef), 'undef created as !number');
 145
 146     ok( created_as_string("abc"), 'abc created as string');
 147     ok(!created_as_number("abc"), 'abc created as number');
 148
 149     ok(!created_as_string(123),   '123 created as !string');
 150     ok( created_as_number(123),   '123 created as !number');
 151
 152     ok(!created_as_string(1.23),   '1.23 created as !string');
 153     ok( created_as_number(1.23),   '1.23 created as !number');
 154
 155     ok(!created_as_string([]),    '[] created as !string');
 156     ok(!created_as_number([]),    '[] created as !number');
 157
 158     ok(!created_as_string(builtin::true), 'true created as !string');
 159     ok(!created_as_number(builtin::true), 'true created as !number');
 160
 161     ok(builtin::is_bool(created_as_string(0)), 'created_as_string returns bool');
 162     ok(builtin::is_bool(created_as_number(0)), 'created_as_number returns bool');
 163
 164     # variables
 165     my $just_pv = "def";
 166     ok( created_as_string($just_pv), 'def created as string');
 167     ok(!created_as_number($just_pv), 'def created as number');
 168
 169     my $just_iv = 456;
 170     ok(!created_as_string($just_iv), '456 created as string');
 171     ok( created_as_number($just_iv), '456 created as number');
 172
 173     my $just_nv = 4.56;
 174     ok(!created_as_string($just_nv), '456 created as string');
 175     ok( created_as_number($just_nv), '456 created as number');
 176
 177     # variables reused
 178     my $originally_pv = "1";
 179     my $pv_as_iv = $originally_pv + 0;
 180     ok( created_as_string($originally_pv), 'PV reused as IV created as string');
 181     ok(!created_as_number($originally_pv), 'PV reused as IV created as !number');
 182     ok(!created_as_string($pv_as_iv), 'New number from PV created as !string');
 183     ok( created_as_number($pv_as_iv), 'New number from PV created as number');
 184
 185     my $originally_iv = 1;
 186     my $iv_as_pv = "$originally_iv";
 187     ok(!created_as_string($originally_iv), 'IV reused as PV created as !string');
 188     ok( created_as_number($originally_iv), 'IV reused as PV created as number');
 189     ok( created_as_string($iv_as_pv), 'New string from IV created as string');
 190     ok(!created_as_number($iv_as_pv), 'New string from IV created as !number');
 191
 192     my $originally_nv = 1.1;
 193     my $nv_as_pv = "$originally_nv";
 194     ok(!created_as_string($originally_nv), 'NV reused as PV created as !string');
 195     ok( created_as_number($originally_nv), 'NV reused as PV created as number');
 196     ok( created_as_string($nv_as_pv), 'New string from NV created as string');
 197     ok(!created_as_number($nv_as_pv), 'New string from NV created as !number');
 198
 199     # magic
 200     local $1;
 201     "hello" =~ m/(.*)/;
 202     ok(created_as_string($1), 'magic string');
 203
 204     is(prototype(\&builtin::created_as_string), '$', 'created_as_string prototype');
 205     is(prototype(\&builtin::created_as_number), '$', 'created_as_number prototype');
 206 }
 207
 208 # stringify
 209 {
 210     use builtin qw( stringify );
 211
 212     is(stringify("abc"), "abc", 'stringify a plain string');
 213     is(stringify(123),   "123", 'stringify a number');
 214
 215     my $aref = [];
 216     is(stringify($aref), "$aref", 'stringify an array ref');
 217
 218     use builtin qw( created_as_string );
 219     ok(!ref stringify($aref),               'stringified arrayref is not a ref');
 220     ok(created_as_string(stringify($aref)), 'stringified arrayref is created as string');
 221
 222     package WithOverloadedStringify {
 223         use overload '""' => sub { return "STRING" };
 224     }
 225
 226     is(stringify(bless [], "WithOverloadedStringify"), "STRING", 'stringify invokes "" overload');
 227 }
 228
 229 # ceil, floor
 230 {
 231     use builtin qw( ceil floor );
 232
 233     cmp_ok(ceil(1.5), '==', 2, 'ceil(1.5) == 2');
 234     cmp_ok(floor(1.5), '==', 1, 'floor(1.5) == 1');
 235
 236     # Invokes magic
 237
 238     tie my $tied, FetchStoreCounter => (\my $fetchcount, \my $storecount);
 239
 240     my $_dummy = ceil($tied);
 241     is($fetchcount, 1, 'ceil() invokes FETCH magic');
 242
 243     $tied = ceil(1.1);
 244     is($storecount, 1, 'ceil() TARG invokes STORE magic');
 245
 246     $fetchcount = $storecount = 0;
 247     tie $tied, FetchStoreCounter => (\$fetchcount, \$storecount);
 248
 249     $_dummy = floor($tied);
 250     is($fetchcount, 1, 'floor() invokes FETCH magic');
 251
 252     $tied = floor(1.1);
 253     is($storecount, 1, 'floor() TARG invokes STORE magic');
 254
 255     is(prototype(\&builtin::ceil), '$', 'ceil prototype');
 256     is(prototype(\&builtin::floor), '$', 'floor prototype');
 257 }
 258
 259 # imports are lexical; should not be visible here
 260 {
 261     my $ok = eval 'true()'; my $e = $@;
 262     ok(!$ok, 'true() not visible outside of lexical scope');
 263     like($e, qr/^Undefined subroutine &main::true called at /, 'failure from true() not visible');
 264 }
 265
 266 # lexical imports work fine in a variety of situations
 267 {
 268     sub regularfunc {
 269         use builtin 'true';
 270         return true;
 271     }
 272     ok(regularfunc(), 'true in regular sub');
 273
 274     my sub lexicalfunc {
 275         use builtin 'true';
 276         return true;
 277     }
 278     ok(lexicalfunc(), 'true in lexical sub');
 279
 280     my $coderef = sub {
 281         use builtin 'true';
 282         return true;
 283     };
 284     ok($coderef->(), 'true in anon sub');
 285
 286     sub recursefunc {
 287         use builtin 'true';
 288         return recursefunc() if @_;
 289         return true;
 290     }
 291     ok(recursefunc("rec"), 'true in self-recursive sub');
 292
 293     my sub recurselexicalfunc {
 294         use builtin 'true';
 295         return __SUB__->() if @_;
 296         return true;
 297     }
 298     ok(recurselexicalfunc("rec"), 'true in self-recursive lexical sub');
 299
 300     my $recursecoderef = sub {
 301         use builtin 'true';
 302         return __SUB__->() if @_;
 303         return true;
 304     };
 305     ok($recursecoderef->("rec"), 'true in self-recursive anon sub');
 306 }
 307
 308 {
 309     use builtin qw( true false );
 310
 311     my $val = true;
 312     cmp_ok($val, $_, !!1, "true is equivalent to !!1 by $_") for qw( eq == );
 313     cmp_ok($val, $_,  !0, "true is equivalent to  !0 by $_") for qw( eq == );
 314
 315     $val = false;
 316     cmp_ok($val, $_, !!0, "false is equivalent to !!0 by $_") for qw( eq == );
 317     cmp_ok($val, $_,  !1, "false is equivalent to  !1 by $_") for qw( eq == );
 318 }
 319
 320 # indexed
 321 {
 322     use builtin qw( indexed );
 323
 324     # We don't have Test::More's is_deeply here
 325
 326     ok(eq_array([indexed], [] ),
 327         'indexed on empty list');
 328
 329     ok(eq_array([indexed "A"], [0, "A"] ),
 330         'indexed on singleton list');
 331
 332     ok(eq_array([indexed "X" .. "Z"], [0, "X", 1, "Y", 2, "Z"] ),
 333         'indexed on 3-item list');
 334
 335     my @orig = (1..3);
 336     $_++ for indexed @orig;
 337     ok(eq_array(\@orig, [1 .. 3]), 'indexed copies values, does not alias');
 338
 339     {
 340         my $ok = 1;
 341         foreach my ($len, $s) (indexed "", "x", "xx") {
 342             length($s) == $len or undef $ok;
 343         }
 344         ok($ok, 'indexed operates nicely with multivar foreach');
 345     }
 346
 347     {
 348         my %hash = indexed "a" .. "e";
 349         ok(eq_hash(\%hash, { 0 => "a", 1 => "b", 2 => "c", 3 => "d", 4 => "e" }),
 350             'indexed can be used to create hashes');
 351     }
 352
 353     {
 354         no warnings 'scalar';
 355
 356         my $count = indexed 'i', 'ii', 'iii', 'iv';
 357         is($count, 8, 'indexed in scalar context yields size of list it would return');
 358     }
 359
 360     is(prototype(\&builtin::indexed), '@', 'indexed prototype');
 361 }
 362
 363 # indexed + foreach loop optimisation appears transparent
 364 {
 365     my @output;
 366     my @input = qw( zero one two three four five );
 367
 368     foreach my ( $idx, $val ) ( builtin::indexed @input ) {
 369         push @output, "[$idx]=$val";
 370     }
 371
 372     ok(eq_array(\@output, [qw( [0]=zero [1]=one [2]=two [3]=three [4]=four [5]=five )] ),
 373         'foreach + builtin::indexed ARRAY' );
 374
 375     undef @output;
 376
 377     use builtin qw( indexed );
 378
 379     foreach my ( $idx, $val ) ( indexed @input ) {
 380         push @output, "[$idx]=$val";
 381     }
 382
 383     ok(eq_array(\@output, [qw( [0]=zero [1]=one [2]=two [3]=three [4]=four [5]=five )] ),
 384         'foreach + imported indexed ARRAY' );
 385
 386     undef @output;
 387
 388     foreach my ( $idx, $val ) ( builtin::indexed qw( six seven eight nine ) ) {
 389         push @output, "[$idx]=$val";
 390     }
 391
 392     ok(eq_array(\@output, [qw( [0]=six [1]=seven [2]=eight [3]=nine )] ),
 393         'foreach + builtin::indexed LIST' );
 394 }
 395
 396 # Vanilla trim tests
 397 {
 398     use builtin qw( trim );
 399
 400     is(trim("    Hello world!   ")      , "Hello world!"  , 'trim spaces');
 401     is(trim("\tHello world!\t")         , "Hello world!"  , 'trim tabs');
 402     is(trim("\n\n\nHello\nworld!\n")    , "Hello\nworld!" , 'trim \n');
 403     is(trim("\t\n\n\nHello world!\n \t"), "Hello world!"  , 'trim all three');
 404     is(trim("Perl")                     , "Perl"          , 'trim nothing');
 405     is(trim('')                         , ""              , 'trim empty string');
 406
 407     is(prototype(\&builtin::trim), '$', 'trim prototype');
 408 }
 409
 410 TODO: {
 411     my $warn = '';
 412     local $SIG{__WARN__} = sub { $warn .= join "", @_; };
 413
 414     is(builtin::trim(undef), "", 'trim undef');
 415     like($warn    , qr/^Use of uninitialized value in subroutine entry at/,
 416          'trim undef triggers warning');
 417     local $main::TODO = "Currently uses generic value for the name of non-opcode builtins";
 418     like($warn    , qr/^Use of uninitialized value in trim at/,
 419          'trim undef triggers warning using actual name of builtin');
 420 }
 421
 422 # Fancier trim tests against a regexp and unicode
 423 {
 424     use builtin qw( trim );
 425     my $nbsp = chr utf8::unicode_to_native(0xA0);
 426
 427     is(trim("   \N{U+2603}       "), "\N{U+2603}", 'trim with unicode content');
 428     is(trim("\N{U+2029}foobar\x{2028} "), "foobar",
 429             'trim with unicode whitespace');
 430     is(trim("$nbsp foobar$nbsp    "), "foobar", 'trim with latin1 whitespace');
 431 }
 432
 433 # Test on a magical fetching variable
 434 {
 435     use builtin qw( trim );
 436
 437     my $str3 = "   Hello world!\t";
 438     $str3 =~ m/(.+Hello)/;
 439     is(trim($1), "Hello", "trim on a magical variable");
 440 }
 441
 442 # Inplace edit, my, our variables
 443 {
 444     use builtin qw( trim );
 445
 446     my $str4 = "\t\tHello world!\n\n";
 447     $str4 = trim($str4);
 448     is($str4, "Hello world!", "trim on an inplace variable");
 449
 450     our $str2 = "\t\nHello world!\t  ";
 451     is(trim($str2), "Hello world!", "trim on an our \$var");
 452 }
 453
 454 # Lexical export
 455 {
 456     my $name;
 457     BEGIN {
 458         use builtin qw( export_lexically );
 459
 460         $name = "message";
 461         export_lexically $name => sub { "Hello, world" };
 462     }
 463
 464     is(message(), "Hello, world", 'Lexically exported sub is callable');
 465     ok(!__PACKAGE__->can("message"), 'Exported sub is not visible via ->can');
 466
 467     is($name, "message", '$name argument was not modified by export_lexically');
 468
 469     our ( $scalar, @array, %hash );
 470     BEGIN {
 471         use builtin qw( export_lexically );
 472
 473         export_lexically
 474             '$SCALAR' => \$scalar,
 475             '@ARRAY'  => \@array,
 476             '%HASH'   => \%hash;
 477     }
 478
 479     $::scalar = "value";
 480     is($SCALAR, "value", 'Lexically exported scalar is accessible');
 481
 482     @::array = ('a' .. 'e');
 483     is(scalar @ARRAY, 5, 'Lexically exported array is accessible');
 484
 485     %::hash = (key => "val");
 486     is($HASH{key}, "val", 'Lexically exported hash is accessible');
 487 }
 488
 489 # load_module
 490 {
 491     use builtin qw( load_module );
 492     use feature qw( try );
 493     my ($ok, $e);
 494
 495     # Can't really test this sans string eval, as it's a compilation error:
 496     eval 'load_module();';
 497     $e = $@;
 498     ok($e, 'load_module(); fails');
 499     like($e, qr/^Not enough arguments for builtin::load_module at/, 'load_module(); fails with correct error');
 500     eval 'load_module;';
 501     $e = $@;
 502     ok($e, 'load_module; fails');
 503     like($e, qr/^Not enough arguments for builtin::load_module at/, 'load_module; fails with correct error');
 504
 505     # Failure to load module croaks
 506     try {
 507         load_module(undef);
 508     } catch ($e) {
 509         ok($e, 'load_module(undef) fails');
 510         like($e, qr/^Usage: builtin::load_module\(defined string\)/, 'load_module(undef) fails with correct error');
 511     };
 512     try {
 513         load_module(\"Foo");
 514     } catch ($e) {
 515         ok($e, 'load_module(\"Foo") fails');
 516         like($e, qr/^Usage: builtin::load_module\(defined string\)/, 'load_module(\"Foo") fails with correct error');
 517     };
 518     try {
 519         load_module(["Foo"]);
 520     } catch ($e) {
 521         ok($e, 'load_module(["Foo"]) fails');
 522         like($e, qr/^Usage: builtin::load_module\(defined string\)/, 'load_module(["Foo"]) fails with correct error');
 523     };
 524     try {
 525         load_module('5.36');
 526     }
 527     catch ($e) {
 528         ok($e, 'load_module("5.36") fails');
 529         like($e, qr/^Can't locate 5[.]36[.]pm in \@INC/, 'load_module("5.36") fails with correct error');
 530     };
 531     try {
 532         load_module('v5.36');
 533     }
 534     catch ($e) {
 535         ok($e, 'load_module("v5.36") fails');
 536         like($e, qr/^Can't locate v5[.]36[.]pm in \@INC/, 'load_module("v5.36") fails with correct error');
 537     };
 538     try {
 539         load_module("Dies");
 540         fail('load_module("Dies") succeeded!');
 541     }
 542     catch ($e) {
 543         ok($e, 'load_module("Dies") fails');
 544         like($e, qr/^Can't locate Dies[.]pm in \@INC/, 'load_module("Dies") fails with correct error');
 545     }
 546     my $module_name = 'Dies';
 547     try {
 548         load_module($module_name);
 549         fail('load_module($module_name) $module_name=Dies succeeded!');
 550     }
 551     catch ($e) {
 552         ok($e, 'load_module($module_name) $module_name=Dies fails');
 553         like($e, qr/^Can't locate Dies[.]pm in \@INC/, 'load_module($module_name) $module_name=Dies fails with correct error');
 554     }
 555     $module_name =~ m!(\w+)!;
 556     try {
 557         load_module($1);
 558         fail('load_module($1) from $module_name=Dies succeeded!');
 559     }
 560     catch ($e) {
 561         ok($e, 'load_module($1) from $module_name=Dies fails');
 562         like($e, qr/^Can't locate Dies[.]pm in \@INC/, 'load_module($1) from $module_name=Dies fails with correct error');
 563     }
 564     "Dies" =~ m!(\w+)!;
 565     try {
 566         load_module($1);
 567         fail('load_module($1) from "Dies" succeeded!');
 568     }
 569     catch ($e) {
 570         ok($e, 'load_module($1) from "Dies" fails');
 571         like($e, qr/^Can't locate Dies[.]pm in \@INC/, 'load_module($1) from "Dies" fails with correct error');
 572     }
 573
 574     # Loading module goes well
 575     my $ret;
 576     try {
 577         $ret = load_module("strict");
 578         pass('load_module("strict") worked');
 579         is($ret, "strict", 'load_module("strict") returned "strict"');
 580     }
 581     catch ($e) {
 582         fail('load_module("strict") errored: ' . $e);
 583     }
 584     $module_name = 'strict';
 585     try {
 586         $ret = load_module($module_name);
 587         pass('load_module($module_name) $module_name=strict worked');
 588         is($ret, "strict", 'load_module($module_name) returned "strict"');
 589     }
 590     catch ($e) {
 591         fail('load_module($module_name) $module_name=strict errored: ' . $e);
 592     }
 593     $module_name =~ m!(\w+)!;
 594     try {
 595         $ret = load_module($1);
 596         pass('load_module($1) from $module_name=strict worked');
 597         is($ret, "strict", 'load_module($1) from $module_name=strict returned "strict"');
 598     }
 599     catch ($e) {
 600         fail('load_module($1) from $module_name=strict errored: ' . $e);
 601     }
 602     "strict" =~ m!(\w+)!;
 603     try {
 604         $ret = load_module($1);
 605         pass('load_module($1) from "strict" worked');
 606         is($ret, "strict", 'load_module($1) from "strict" returned "strict"');
 607     }
 608     catch ($e) {
 609         fail('load_module($1) from "strict" errored: ' . $e);
 610     }
 611
 612     # Slightly more complex, based on tie
 613     {
 614         package BuiltinTestTie {
 615             sub TIESCALAR {
 616                 bless $_[1], $_[0];
 617             }
 618             sub FETCH {
 619                 ${$_[0]}
 620             }
 621         }
 622         my $x;
 623         tie my $y, BuiltinTestTie => \$x;
 624         $x = "strict";
 625         try {
 626             $ret = load_module($y);
 627             pass('load_module($y) from $y tied to $x=strict worked');
 628             is($ret, "strict", 'load_module($y) from $y tied to $x=strict worked and returned "strict"');
 629         }
 630         catch ($e) {
 631             fail('load_module($y) from $y tied to $x=strict failed: ' . $e);
 632         };
 633     }
 634
 635     # Can be used to import a symbol to the current namespace, too:
 636     {
 637         my $aref = [];
 638         my $aref_stringified = "$aref";
 639         my $got = eval '
 640             BEGIN {
 641                 load_module("builtin")->import("stringify");
 642             }
 643             stringify($aref);
 644         ';
 645         if (my $error = $@) {
 646             fail('load_module("builtin")->import("stringify") failed: ' . $error);
 647         }
 648         is($got, $aref_stringified, 'load_module("builtin")->import("stringify") works, stringifying $aref');
 649     }
 650 }
 651
 652 # version bundles
 653 {
 654     use builtin ':5.39';
 655     ok(true, 'true() is available from :5.39 bundle');
 656
 657     # parse errors
 658     foreach my $bundle (qw( :x :5.x :5.36x :5.36.1000 :5.1000 :5.36.1.2 ),
 659                         ":  +5.+39", ":  +5.+40. -10", ": 5.40", ":5 .40", ":5.+40",
 660                         ":5.40 .0", ":5.40.-10", ":5.40\0") {
 661         (my $pretty_bundle = $bundle) =~ s/([^[:print:]])/ sprintf("\\%o", ord $1) /ge;
 662         ok(!defined eval "use builtin '$bundle';", $pretty_bundle.' is invalid bundle');
 663         like($@, qr/^Invalid version bundle "\Q$pretty_bundle\E" at /);
 664     }
 665 }
 666
 667 # github #21981
 668 {
 669     fresh_perl_is(<<'EOS', "", {}, "github 21981: panic in intro_my");
 670 use B;
 671 BEGIN { B::save_BEGINs; }
 672 use v5.39;
 673 EOS
 674 }
 675
 676 # github #22542
 677 {
 678     # some of these functions don't error at this point, but they might be updated
 679     # and see the same problem we fix here
 680     for my $func (qw(is_bool is_weak blessed refaddr reftype ceil floor is_tainted
 681                      trim stringify created_as_string created_as_number)) {
 682         my $arg =
 683           $func =~ /ceil|floor|created_as/ ? "1.1" :
 684           $func =~ /(^ref|blessed|is_weak)/ ? "\\1" : '"abc"';
 685         fresh_perl_is(<<"EOS", "ok", {}, "goto $func");
 686 no warnings "experimental";
 687 sub f { goto &builtin::$func }
 688 f($arg);
 689 print "ok";
 690 EOS
 691     }
 692 }
 693
 694 # github #22784
 695 {
 696     use builtin qw( trim );
 697     sub f { 0+trim($_[0]) }
 698     is(f(4), 4, "populate TARG.iv");
 699     is(f(123), 123, "check TARG.IOK is reset properly");
 700 }
 701
 702 # vim: tabstop=4 shiftwidth=4 expandtab autoindent softtabstop=4
 703
 704 done_testing();