[perl5.git] / t / op / qq.t

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
}

print q(1..21
);

# This is() function is written to avoid ""
my $test = 1;
sub is {
    my($left, $right) = @_;

    if ($left eq $right) {
      printf 'ok %d
', $test++;
      return 1;
    }
    foreach ($left, $right) {
      # Comment out these regexps to map non-printables to ord if the perl under
      # test is so broken that it's not helping
      s/([^-+A-Za-z_0-9])/sprintf q{'.chr(%d).'}, ord $1/ge;
      $_ = sprintf q('%s'), $_;
      s/^''\.//;
      s/\.''$//;
    }
    printf q(not ok %d - got %s expected %s
), $test++, $left, $right;

    printf q(# Failed test at line %d
), (caller)[2];

    return 0;
}

is ("\x53", chr 83);
is ("\x4EE", chr (78) . 'E');
is ("\x4i", chr (4) . 'i');	# This will warn
is ("\xh", chr (0) . 'h');	# This will warn
is ("\xx", chr (0) . 'x');	# This will warn
is ("\xx9", chr (0) . 'x9');	# This will warn. \x9 is tab in EBCDIC too?
is ("\x9_E", chr (9) . '_E');	# This will warn

is ("\x{4E}", chr 78);
is ("\x{6_9}", chr 105);
is ("\x{_6_3}", chr 99);
is ("\x{_6B}", chr 107);

is ("\x{9__0}", chr 9);		# multiple underscores not allowed.
is ("\x{77_}", chr 119);	# trailing underscore warns.
is ("\x{6FQ}z", chr (111) . 'z');

is ("\x{0x4E}", chr 0);
is ("\x{x4E}", chr 0);

is ("\x{0065}", chr 101);
is ("\x{000000000000000000000000000000000000000000000000000000000000000072}",
    chr 114);
is ("\x{0_06_5}", chr 101);
is ("\x{1234}", chr 4660);
is ("\x{10FFFD}", chr 1114109);
Commit	Line	Data
a4c04bdc NC	1	#!./perl
	2
	3	BEGIN {
	4	chdir 't' if -d 't';
	5	@INC = '../lib';
	6	}
	7
	8	print q(1..21
	9	);
	10
	11	# This is() function is written to avoid ""
	12	my $test = 1;
	13	sub is {
	14	my($left, $right) = @_;
	15
	16	if ($left eq $right) {
	17	printf 'ok %d
	18	', $test++;
	19	return 1;
	20	}
	21	foreach ($left, $right) {
	22	# Comment out these regexps to map non-printables to ord if the perl under
	23	# test is so broken that it's not helping
	24	s/([^-+A-Za-z_0-9])/sprintf q{'.chr(%d).'}, ord $1/ge;
	25	$_ = sprintf q('%s'), $_;
	26	s/^''\.//;
	27	s/\.''$//;
	28	}
	29	printf q(not ok %d - got %s expected %s
	30	), $test++, $left, $right;
	31
	32	printf q(# Failed test at line %d
	33	), (caller)[2];
	34
	35	return 0;
	36	}
	37
	38	is ("\x53", chr 83);
	39	is ("\x4EE", chr (78) . 'E');
	40	is ("\x4i", chr (4) . 'i'); # This will warn
	41	is ("\xh", chr (0) . 'h'); # This will warn
	42	is ("\xx", chr (0) . 'x'); # This will warn
	43	is ("\xx9", chr (0) . 'x9'); # This will warn. \x9 is tab in EBCDIC too?
	44	is ("\x9_E", chr (9) . '_E'); # This will warn
	45
	46	is ("\x{4E}", chr 78);
	47	is ("\x{6_9}", chr 105);
	48	is ("\x{_6_3}", chr 99);
	49	is ("\x{_6B}", chr 107);
	50
	51	is ("\x{9__0}", chr 9); # multiple underscores not allowed.
	52	is ("\x{77_}", chr 119); # trailing underscore warns.
	53	is ("\x{6FQ}z", chr (111) . 'z');
	54
	55	is ("\x{0x4E}", chr 0);
	56	is ("\x{x4E}", chr 0);
	57
	58	is ("\x{0065}", chr 101);
	59	is ("\x{000000000000000000000000000000000000000000000000000000000000000072}",
	60	chr 114);
	61	is ("\x{0_06_5}", chr 101);
	62	is ("\x{1234}", chr 4660);
b851fbc1	63	is ("\x{10FFFD}", chr 1114109);