t/lib/universal.t

   1 #!./perl
   2
   3 # Test the Internal::* functions and other tibits in universal.c
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8     require './test.pl';
   9     plan( tests => 16 );
  10 }
  11
  12 for my $arg ('', 'q[]', qw( 1 undef )) {
  13     fresh_perl_is(<<"----", <<'====', {}, "Internals::* functions check their argument under func() AND &func() [perl #77776]");
  14 sub tryit { eval shift or warn \$@ }
  15 tryit "&Internals::SvREADONLY($arg)";
  16 tryit "&Internals::SvREFCNT($arg)";
  17 tryit "&Internals::hv_clear_placeholders($arg)";
  18 ----
  19 Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1.
  20 Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1.
  21 Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1.
  22 ====
  23 }
  24
  25 # Various conundrums with SvREADONLY
  26
  27 $x = *foo;
  28 Internals::SvREADONLY $x, 1;
  29 ok Internals::SvREADONLY($x),
  30          'read-only glob copies are read-only acc. to Internals::';
  31 eval { $x = [] };
  32 like $@, qr/Modification of a read-only value attempted at/,
  33     'read-only glob copies';
  34 Internals::SvREADONLY($x,0);
  35 $x = 42;
  36 is $x, 42, 'Internals::SvREADONLY can turn off readonliness on globs';
  37
  38 # Same thing with regexps
  39 $x = ${qr//};
  40 Internals::SvREADONLY $x, 1;
  41 ok Internals::SvREADONLY($x),
  42          'read-only regexps are read-only acc. to Internals::';
  43 eval { $x = [] };
  44 like $@, qr/Modification of a read-only value attempted at/,
  45     'read-only regexps';
  46 Internals::SvREADONLY($x,0);
  47 $x = 42;
  48 is $x, 42, 'Internals::SvREADONLY can turn off readonliness on regexps';
  49
  50 $h{a} = __PACKAGE__;
  51 Internals::SvREADONLY $h{a}, 1;
  52 eval { $h{a} = 3 };
  53 like $@, qr/Modification of a read-only value attempted at/,
  54     'making a COW scalar into a read-only one';
  55
  56 $h{b} = __PACKAGE__;
  57 ok !Internals::SvREADONLY($h{b}),
  58        'cows are not read-only acc. to Internals::';
  59 Internals::SvREADONLY($h{b},0);
  60 $h{b} =~ y/ia/ao/;
  61 is __PACKAGE__, 'main',
  62   'turning off a cow’s readonliness did not affect sharers of the same PV';
  63
  64 &Internals::SvREADONLY(\!0, 0);
  65 eval { ${\!0} = 7 };
  66 like $@, qr "^Modification of a read-only value",
  67     'protected values still croak on assignment after SvREADONLY(..., 0)';
  68 is ${\3} == 3, "1", 'attempt to modify failed';
  69
  70 eval { { my $x = ${qr//}; Internals::SvREADONLY $x, 1; () } };
  71 is $@, "", 'read-only lexical regexps on scope exit [perl #115254]';