ext/XS-APItest/t/pmflag.t

   1 #!perl
   2 use strict;
   3 use Test::More 'no_plan';
   4
   5 my @warnings;
   6 $SIG{__WARN__} = sub {
   7     push @warnings, "@_";
   8 };
   9
  10 use XS::APItest 'pmflag';
  11
  12 foreach (["\0", 0],
  13          ['Q', 0],
  14          ['c', 0x00004000],
  15         ) {
  16     my ($char, $val) = @$_;
  17     my $ord = ord $char;
  18     foreach my $before (0, 1) {
  19         my $got = pmflag($ord, $before);
  20         is($got, $before | $val, "Flag $ord, before $before");
  21         is(@warnings, 1);
  22         like($warnings[0],
  23              qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/);
  24         @warnings = ();
  25
  26         no warnings 'deprecated';
  27
  28         $got = pmflag($ord, $before);
  29         is($got, $before | $val, "Flag $ord, before $before");
  30         is(@warnings, 0);
  31         @warnings = ();
  32
  33         use warnings;
  34         $got = pmflag($ord, $before);
  35         is($got, $before | $val, "Flag $ord, before $before");
  36         is(@warnings, 1);
  37         like($warnings[0],
  38              qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/);
  39         @warnings = ();
  40     }
  41 }