[perl5.git] / ext / XS-APItest / t / pmflag.t

#!perl
use strict;
use Test::More 'no_plan';

my @warnings;
$SIG{__WARN__} = sub {
    push @warnings, "@_";
};

use XS::APItest 'pmflag';

foreach (["\0", 0],
	 ['Q', 0],
	 ['c', 0x00004000],
	) {
    my ($char, $val) = @$_;
    my $ord = ord $char;
    foreach my $before (0, 1) {
	my $got = pmflag($ord, $before);
	is($got, $before | $val, "Flag $ord, before $before");
	is(@warnings, 1);
	like($warnings[0],
	     qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/);
	@warnings = ();

	no warnings 'deprecated';

	$got = pmflag($ord, $before);
	is($got, $before | $val, "Flag $ord, before $before");
	is(@warnings, 0);
	@warnings = ();

	use warnings;
	$got = pmflag($ord, $before);
	is($got, $before | $val, "Flag $ord, before $before");
	is(@warnings, 1);
	like($warnings[0],
	     qr/^Perl_pmflag\(\) is deprecated, and will be removed from the XS API/);
	@warnings = ();
    }
}
Commit	Line	Data
879d0c72 NC	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	}