[p5sagit/p5-mst-13.2.git] / t / pragma / utf8.t

#!./perl 

BEGIN {
    chdir 't' if -d 't';
    unshift @INC, '../lib';
    $ENV{PERL5LIB} = '../lib';
    if ( ord("\t") != 9 ) { # skip on ebcdic platforms
        print "1..0 # Skip utf8 tests on ebcdic platform.\n";
        exit;
    }
}

print "1..60\n";

my $test = 1;

sub ok {
    my ($got,$expect) = @_;
    print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
    print "ok $test\n";
}

{
    use utf8;
    $_ = ">\x{263A}<"; 
    s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg; 
    ok $_, '>&#9786;<';
    $test++;

    $_ = ">\x{263A}<"; 
    my $rx = "\x{80}-\x{10ffff}";
    s/([$rx])/"&#".ord($1).";"/eg; 
    ok $_, '>&#9786;<';
    $test++;

    $_ = ">\x{263A}<"; 
    my $rx = "\\x{80}-\\x{10ffff}";
    s/([$rx])/"&#".ord($1).";"/eg; 
    ok $_, '>&#9786;<';
    $test++;

    $_ = "alpha,numeric"; 
    m/([[:alpha:]]+)/; 
    ok $1, 'alpha';
    $test++;

    $_ = "alphaNUMERICstring";
    m/([[:^lower:]]+)/; 
    ok $1, 'NUMERIC';
    $test++;

    $_ = "alphaNUMERICstring";
    m/(\p{Ll}+)/; 
    ok $1, 'alpha';
    $test++;

    $_ = "alphaNUMERICstring"; 
    m/(\p{Lu}+)/; 
    ok $1, 'NUMERIC';
    $test++;

    $_ = "alpha,numeric"; 
    m/([\p{IsAlpha}]+)/; 
    ok $1, 'alpha';
    $test++;

    $_ = "alphaNUMERICstring";
    m/([^\p{IsLower}]+)/; 
    ok $1, 'NUMERIC';
    $test++;

    $_ = "alpha123numeric456"; 
    m/([\p{IsDigit}]+)/; 
    ok $1, '123';
    $test++;

    $_ = "alpha123numeric456"; 
    m/([^\p{IsDigit}]+)/; 
    ok $1, 'alpha';
    $test++;

    $_ = ",123alpha,456numeric"; 
    m/([\p{IsAlnum}]+)/; 
    ok $1, '123alpha';
    $test++;
}
{
    use utf8;

    $_ = "\x{263A}>\x{263A}\x{263A}"; 

    ok length, 4;
    $test++;

    ok length((m/>(.)/)[0]), 1;
    $test++;

    ok length($&), 2;
    $test++;

    ok length($'), 1;
    $test++;

    ok length($`), 1;
    $test++;

    ok length($1), 1;
    $test++;

    ok length($tmp=$&), 2;
    $test++;

    ok length($tmp=$'), 1;
    $test++;

    ok length($tmp=$`), 1;
    $test++;

    ok length($tmp=$1), 1;
    $test++;

    ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
    $test++;

    ok $', pack("C*", 0342, 0230, 0272);
    $test++;

    ok $`, pack("C*", 0342, 0230, 0272);
    $test++;

    ok $1, pack("C*", 0342, 0230, 0272);
    $test++;

    {
	use bytes;
	no utf8;

	ok length, 10;
	$test++;

    	ok length((m/>(.)/)[0]), 1;
    	$test++;

    	ok length($&), 2;
    	$test++;

    	ok length($'), 5;
    	$test++;

    	ok length($`), 3;
    	$test++;

    	ok length($1), 1;
    	$test++;

	ok $&, pack("C*", ord(">"), 0342);
	$test++;

	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
	$test++;

	ok $`, pack("C*", 0342, 0230, 0272);
	$test++;

	ok $1, pack("C*", 0342);
	$test++;

    }


    {
	no utf8;
	$_="\342\230\272>\342\230\272\342\230\272";
    }

    ok length, 10;
    $test++;

    ok length((m/>(.)/)[0]), 1;
    $test++;

    ok length($&), 2;
    $test++;

    ok length($'), 1;
    $test++;

    ok length($`), 1;
    $test++;

    ok length($1), 1;
    $test++;

    ok length($tmp=$&), 2;
    $test++;

    ok length($tmp=$'), 1;
    $test++;

    ok length($tmp=$`), 1;
    $test++;

    ok length($tmp=$1), 1;
    $test++;

    ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
    $test++;

    ok $', pack("C*", 0342, 0230, 0272);
    $test++;

    ok $`, pack("C*", 0342, 0230, 0272);
    $test++;

    ok $1, pack("C*", 0342, 0230, 0272);
    $test++;

    {
	use bytes;
	no utf8;

	ok length, 10;
	$test++;

    	ok length((m/>(.)/)[0]), 1;
    	$test++;

    	ok length($&), 2;
    	$test++;

    	ok length($'), 5;
    	$test++;

    	ok length($`), 3;
    	$test++;

    	ok length($1), 1;
    	$test++;

	ok $&, pack("C*", ord(">"), 0342);
	$test++;

	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
	$test++;

	ok $`, pack("C*", 0342, 0230, 0272);
	$test++;

	ok $1, pack("C*", 0342);
	$test++;

    }
}
Commit	Line	Data
f96ec2a2	1	#!./perl
	2
	3	BEGIN {
	4	chdir 't' if -d 't';
	5	unshift @INC, '../lib';
	6	$ENV{PERL5LIB} = '../lib';
f70c35af	7	if ( ord("\t") != 9 ) { # skip on ebcdic platforms
	8	print "1..0 # Skip utf8 tests on ebcdic platform.\n";
	9	exit;
	10	}
f96ec2a2	11	}
f96ec2a2	12
a197cbdd	13	print "1..60\n";
f96ec2a2	14
	15	my $test = 1;
	16
	17	sub ok {
	18	my ($got,$expect) = @_;
	19	print "# expected [$expect], got [$got]\nnot " if $got ne $expect;
	20	print "ok $test\n";
	21	}
	22
	23	{
	24	use utf8;
	25	$_ = ">\x{263A}<";
	26	s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg;
	27	ok $_, '>☺<';
	28	$test++;
	29
	30	$_ = ">\x{263A}<";
	31	my $rx = "\x{80}-\x{10ffff}";
	32	s/([$rx])/"&#".ord($1).";"/eg;
	33	ok $_, '>☺<';
	34	$test++;
	35
	36	$_ = ">\x{263A}<";
	37	my $rx = "\\x{80}-\\x{10ffff}";
	38	s/([$rx])/"&#".ord($1).";"/eg;
	39	ok $_, '>☺<';
	40	$test++;
b8c5462f	41
	42	$_ = "alpha,numeric";
	43	m/([[:alpha:]]+)/;
	44	ok $1, 'alpha';
	45	$test++;
	46
	47	$_ = "alphaNUMERICstring";
	48	m/([[:^lower:]]+)/;
	49	ok $1, 'NUMERIC';
	50	$test++;
	51
	52	$_ = "alphaNUMERICstring";
	53	m/(\p{Ll}+)/;
	54	ok $1, 'alpha';
	55	$test++;
	56
	57	$_ = "alphaNUMERICstring";
	58	m/(\p{Lu}+)/;
	59	ok $1, 'NUMERIC';
	60	$test++;
	61
	62	$_ = "alpha,numeric";
	63	m/([\p{IsAlpha}]+)/;
	64	ok $1, 'alpha';
	65	$test++;
	66
	67	$_ = "alphaNUMERICstring";
	68	m/([^\p{IsLower}]+)/;
	69	ok $1, 'NUMERIC';
	70	$test++;
	71
0f4b6630	72	$_ = "alpha123numeric456";
	73	m/([\p{IsDigit}]+)/;
	74	ok $1, '123';
	75	$test++;
b8c5462f	76
0f4b6630	77	$_ = "alpha123numeric456";
	78	m/([^\p{IsDigit}]+)/;
	79	ok $1, 'alpha';
	80	$test++;
b8c5462f	81
0f4b6630	82	$_ = ",123alpha,456numeric";
	83	m/([\p{IsAlnum}]+)/;
	84	ok $1, '123alpha';
	85	$test++;
	86	}
a197cbdd	87	{
	88	use utf8;
	89
	90	$_ = "\x{263A}>\x{263A}\x{263A}";
	91
	92	ok length, 4;
	93	$test++;
	94
	95	ok length((m/>(.)/)[0]), 1;
	96	$test++;
	97
	98	ok length($&), 2;
	99	$test++;
	100
	101	ok length($'), 1;
	102	$test++;
	103
	104	ok length($`), 1;
	105	$test++;
	106
	107	ok length($1), 1;
	108	$test++;
	109
	110	ok length($tmp=$&), 2;
	111	$test++;
	112
	113	ok length($tmp=$'), 1;
	114	$test++;
	115
	116	ok length($tmp=$`), 1;
	117	$test++;
	118
	119	ok length($tmp=$1), 1;
	120	$test++;
	121
	122	ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
	123	$test++;
	124
	125	ok $', pack("C*", 0342, 0230, 0272);
	126	$test++;
	127
	128	ok $`, pack("C*", 0342, 0230, 0272);
	129	$test++;
	130
	131	ok $1, pack("C*", 0342, 0230, 0272);
	132	$test++;
	133
	134	{
	135	use bytes;
	136	no utf8;
	137
	138	ok length, 10;
	139	$test++;
	140
	141	ok length((m/>(.)/)[0]), 1;
	142	$test++;
	143
	144	ok length($&), 2;
	145	$test++;
	146
	147	ok length($'), 5;
	148	$test++;
	149
	150	ok length($`), 3;
151	$test++;
152
153	ok length($1), 1;
154	$test++;
155
156	ok $&, pack("C*", ord(">"), 0342);
157	$test++;
158
159	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
160	$test++;
161
162	ok $`, pack("C*", 0342, 0230, 0272);
163	$test++;
164
165	ok $1, pack("C*", 0342);
166	$test++;
167
168	}
169
170
171	{
172	no utf8;
173	$_="\342\230\272>\342\230\272\342\230\272";
174	}
175
176	ok length, 10;
177	$test++;
178
179	ok length((m/>(.)/)[0]), 1;
180	$test++;
181
182	ok length($&), 2;
183	$test++;
184
185	ok length($'), 1;
186	$test++;
187
188	ok length($`), 1;
189	$test++;
190
191	ok length($1), 1;
192	$test++;
193
194	ok length($tmp=$&), 2;
195	$test++;
196
197	ok length($tmp=$'), 1;
198	$test++;
199
200	ok length($tmp=$`), 1;
201	$test++;
202
203	ok length($tmp=$1), 1;
204	$test++;
205
206	ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
207	$test++;
208
209	ok $', pack("C*", 0342, 0230, 0272);
210	$test++;
211
212	ok $`, pack("C*", 0342, 0230, 0272);
213	$test++;
214
215	ok $1, pack("C*", 0342, 0230, 0272);
216	$test++;
217
218	{
219	use bytes;
220	no utf8;
221
222	ok length, 10;
223	$test++;
224
225	ok length((m/>(.)/)[0]), 1;
226	$test++;
227
228	ok length($&), 2;
229	$test++;
230
231	ok length($'), 5;
232	$test++;
233
234	ok length($`), 3;
235	$test++;
236
237	ok length($1), 1;
238	$test++;
239
240	ok $&, pack("C*", ord(">"), 0342);
241	$test++;
242
243	ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
244	$test++;
245
246	ok $`, pack("C*", 0342, 0230, 0272);
247	$test++;
248
249	ok $1, pack("C*", 0342);
250	$test++;
251
252	}
253	}