This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Skip test when building without Encode.
[perl5.git] / t / run / fresh_perl.t
1 #!./perl
2
3 # ** DO NOT ADD ANY MORE TESTS HERE **
4 # Instead, put the test in the appropriate test file and use the 
5 # fresh_perl_is()/fresh_perl_like() functions in t/test.pl.
6
7 # This is for tests that used to abnormally cause segfaults, and other nasty
8 # errors that might kill the interpreter and for some reason you can't
9 # use an eval().
10
11 BEGIN {
12     chdir 't' if -d 't';
13     @INC = '../lib';
14     require './test.pl';        # for which_perl() etc
15 }
16
17 use strict;
18
19 my $Perl = which_perl();
20
21 $|=1;
22
23 my @prgs = ();
24 while(<DATA>) { 
25     if(m/^#{8,}\s*(.*)/) { 
26         push @prgs, ['', $1];
27     }
28     else { 
29         $prgs[-1][0] .= $_;
30     }
31 }
32 plan tests => scalar @prgs;
33
34 foreach my $prog (@prgs) {
35     my($raw_prog, $name) = @$prog;
36
37     my $switch;
38     if ($raw_prog =~ s/^\s*(-\w.*)//){
39         $switch = $1;
40     }
41
42     my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog);
43
44     if ($prog =~ /^\# SKIP: (.+)/m) {
45         if (eval $1) {
46             ok(1, "Skip: $1");
47             next;
48         }
49     }
50
51     $expected =~ s/\n+$//;
52
53     fresh_perl_is($prog, $expected, { switches => [$switch] }, $name);
54 }
55
56 __END__
57 ########
58 $a = ":="; split /($a)/o, "a:=b:=c"; print "@_"
59 EXPECT
60 a := b := c
61 ########
62 $cusp = ~0 ^ (~0 >> 1);
63 use integer;
64 $, = " ";
65 print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, 8 | (($cusp + 1) % 8 + 7), "!\n";
66 EXPECT
67 7 0 0 8 !
68 ########
69 $foo=undef; $foo->go;
70 EXPECT
71 Can't call method "go" on an undefined value at - line 1.
72 ########
73 BEGIN
74         {
75             "foo";
76         }
77 ########
78 $array[128]=1
79 ########
80 $x=0x0eabcd; print $x->ref;
81 EXPECT
82 Can't call method "ref" without a package or object reference at - line 1.
83 ########
84 chop ($str .= <DATA>);
85 ########
86 close ($banana);
87 ########
88 $x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
89 EXPECT
90 25
91 ########
92 eval 'sub bar {print "In bar"}';
93 ########
94 system './perl -ne "print if eof" /dev/null' unless $^O eq 'MacOS'
95 ########
96 chop($file = <DATA>);
97 ########
98 package N;
99 sub new {my ($obj,$n)=@_; bless \$n}  
100 $aa=new N 1;
101 $aa=12345;
102 print $aa;
103 EXPECT
104 12345
105 ########
106 $_="foo";
107 printf(STDOUT "%s\n", $_);
108 EXPECT
109 foo
110 ########
111 push(@a, 1, 2, 3,)
112 ########
113 quotemeta ""
114 ########
115 for ("ABCDE") {
116  &sub;
117 s/./&sub($&)/eg;
118 print;}
119 sub sub {local($_) = @_;
120 $_ x 4;}
121 EXPECT
122 Modification of a read-only value attempted at - line 3.
123 ########
124 package FOO;sub new {bless {FOO => BAR}};
125 package main;
126 use strict vars;   
127 my $self = new FOO;
128 print $$self{FOO};
129 EXPECT
130 BAR
131 ########
132 $_="foo";
133 s/.{1}//s;
134 print;
135 EXPECT
136 oo
137 ########
138 print scalar ("foo","bar")
139 EXPECT
140 bar
141 ########
142 sub by_number { $a <=> $b; };# inline function for sort below
143 $as_ary{0}="a0";
144 @ordered_array=sort by_number keys(%as_ary);
145 ########
146 sub NewShell
147 {
148   local($Host) = @_;
149   my($m2) = $#Shells++;
150   $Shells[$m2]{HOST} = $Host;
151   return $m2;
152 }
153  
154 sub ShowShell
155 {
156   local($i) = @_;
157 }
158  
159 &ShowShell(&NewShell(beach,Work,"+0+0"));
160 &ShowShell(&NewShell(beach,Work,"+0+0"));
161 &ShowShell(&NewShell(beach,Work,"+0+0"));
162 ########
163    {
164        package FAKEARRAY;
165    
166        sub TIEARRAY
167        { print "TIEARRAY @_\n"; 
168          die "bomb out\n" unless $count ++ ;
169          bless ['foo'] 
170        }
171        sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
172        sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
173        sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
174    }
175    
176 eval 'tie @h, FAKEARRAY, fred' ;
177 tie @h, FAKEARRAY, fred ;
178 EXPECT
179 TIEARRAY FAKEARRAY fred
180 TIEARRAY FAKEARRAY fred
181 DESTROY 
182 ########
183 BEGIN { die "phooey\n" }
184 EXPECT
185 phooey
186 BEGIN failed--compilation aborted at - line 1.
187 ########
188 BEGIN { 1/$zero }
189 EXPECT
190 Illegal division by zero at - line 1.
191 BEGIN failed--compilation aborted at - line 1.
192 ########
193 BEGIN { undef = 0 }
194 EXPECT
195 Modification of a read-only value attempted at - line 1.
196 BEGIN failed--compilation aborted at - line 1.
197 ########
198 {
199     package foo;
200     sub PRINT {
201         shift;
202         print join(' ', reverse @_)."\n";
203     }
204     sub PRINTF {
205         shift;
206           my $fmt = shift;
207         print sprintf($fmt, @_)."\n";
208     }
209     sub TIEHANDLE {
210         bless {}, shift;
211     }
212     sub READLINE {
213         "Out of inspiration";
214     }
215     sub DESTROY {
216         print "and destroyed as well\n";
217   }
218   sub READ {
219       shift;
220       print STDOUT "foo->can(READ)(@_)\n";
221       return 100; 
222   }
223   sub GETC {
224       shift;
225       print STDOUT "Don't GETC, Get Perl\n";
226       return "a"; 
227   }    
228 }
229 {
230     local(*FOO);
231     tie(*FOO,'foo');
232     print FOO "sentence.", "reversed", "a", "is", "This";
233     print "-- ", <FOO>, " --\n";
234     my($buf,$len,$offset);
235     $buf = "string";
236     $len = 10; $offset = 1;
237     read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed";
238     getc(FOO) eq "a" or die "foo->GETC failed";
239     printf "%s is number %d\n", "Perl", 1;
240 }
241 EXPECT
242 This is a reversed sentence.
243 -- Out of inspiration --
244 foo->can(READ)(string 10 1)
245 Don't GETC, Get Perl
246 Perl is number 1
247 and destroyed as well
248 ########
249 my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"
250 EXPECT
251 2 2 2
252 ########
253 # used to attach defelem magic to all immortal values,
254 # which made restore of local $_ fail.
255 foo(2>1);
256 sub foo { bar() for @_;  }
257 sub bar { local $_; }
258 print "ok\n";
259 EXPECT
260 ok
261 ########
262 @a = ($a, $b, $c, $d) = (5, 6);
263 print "ok\n"
264   if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]);
265 EXPECT
266 ok
267 ########
268 print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000);
269 EXPECT
270 ok
271 ########
272 print "ok\n" if ("\0" lt "\xFF");
273 EXPECT
274 ok
275 ########
276 open(H,$^O eq 'MacOS' ? ':run:fresh_perl.t' : 'run/fresh_perl.t'); # must be in the 't' directory
277 stat(H);
278 print "ok\n" if (-e _ and -f _ and -r _);
279 EXPECT
280 ok
281 ########
282 sub thing { 0 || return qw(now is the time) }
283 print thing(), "\n";
284 EXPECT
285 nowisthetime
286 ########
287 $ren = 'joy';
288 $stimpy = 'happy';
289 { local $main::{ren} = *stimpy; print $ren, ' ' }
290 print $ren, "\n";
291 EXPECT
292 happy joy
293 ########
294 $stimpy = 'happy';
295 { local $main::{ren} = *stimpy; print ${'ren'}, ' ' }
296 print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n";
297 EXPECT
298 happy joy
299 ########
300 package p;
301 sub func { print 'really ' unless wantarray; 'p' }
302 sub groovy { 'groovy' }
303 package main;
304 print p::func()->groovy(), "\n"
305 EXPECT
306 really groovy
307 ########
308 @list = ([ 'one', 1 ], [ 'two', 2 ]);
309 sub func { $num = shift; (grep $_->[1] == $num, @list)[0] }
310 print scalar(map &func($_), 1 .. 3), " ",
311       scalar(map scalar &func($_), 1 .. 3), "\n";
312 EXPECT
313 2 3
314 ########
315 ($k, $s)  = qw(x 0);
316 @{$h{$k}} = qw(1 2 4);
317 for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) }
318 print "bogus\n" unless $s == 7;
319 ########
320 my $a = 'outer';
321 eval q[ my $a = 'inner'; eval q[ print "$a " ] ];
322 eval { my $x = 'peace'; eval q[ print "$x\n" ] }
323 EXPECT
324 inner peace
325 ########
326 -w
327 $| = 1;
328 sub foo {
329     print "In foo1\n";
330     eval 'sub foo { print "In foo2\n" }';
331     print "Exiting foo1\n";
332 }
333 foo;
334 foo;
335 EXPECT
336 In foo1
337 Subroutine foo redefined at (eval 1) line 1.
338 Exiting foo1
339 In foo2
340 ########
341 $s = 0;
342 map {#this newline here tickles the bug
343 $s += $_} (1,2,4);
344 print "eat flaming death\n" unless ($s == 7);
345 ########
346 sub foo { local $_ = shift; split; @_ }
347 @x = foo(' x  y  z ');
348 print "you die joe!\n" unless "@x" eq 'x y z';
349 ########
350 /(?{"{"})/      # Check it outside of eval too
351 EXPECT
352 Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1.
353 ########
354 /(?{"{"}})/     # Check it outside of eval too
355 EXPECT
356 Unmatched right curly bracket at (re_eval 1) line 1, at end of line
357 syntax error at (re_eval 1) line 1, near ""{"}"
358 Compilation failed in regexp at - line 1.
359 ########
360 BEGIN { @ARGV = qw(a b c d e) }
361 BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
362 END { print "end <",shift,">\nargv <@ARGV>\n" }
363 INIT { print "init <",shift,">\n" }
364 CHECK { print "check <",shift,">\n" }
365 EXPECT
366 argv <a b c d e>
367 begin <a>
368 check <b>
369 init <c>
370 end <d>
371 argv <e>
372 ########
373 -l
374 # fdopen from a system descriptor to a system descriptor used to close
375 # the former.
376 open STDERR, '>&=STDOUT' or die $!;
377 select STDOUT; $| = 1; print fileno STDOUT or die $!;
378 select STDERR; $| = 1; print fileno STDERR or die $!;
379 EXPECT
380 1
381 2
382 ########
383 -w
384 sub testme { my $a = "test"; { local $a = "new test"; print $a }}
385 EXPECT
386 Can't localize lexical variable $a at - line 2.
387 ########
388 package X;
389 sub ascalar { my $r; bless \$r }
390 sub DESTROY { print "destroyed\n" };
391 package main;
392 *s = ascalar X;
393 EXPECT
394 destroyed
395 ########
396 package X;
397 sub anarray { bless [] }
398 sub DESTROY { print "destroyed\n" };
399 package main;
400 *a = anarray X;
401 EXPECT
402 destroyed
403 ########
404 package X;
405 sub ahash { bless {} }
406 sub DESTROY { print "destroyed\n" };
407 package main;
408 *h = ahash X;
409 EXPECT
410 destroyed
411 ########
412 package X;
413 sub aclosure { my $x; bless sub { ++$x } }
414 sub DESTROY { print "destroyed\n" };
415 package main;
416 *c = aclosure X;
417 EXPECT
418 destroyed
419 ########
420 package X;
421 sub any { bless {} }
422 my $f = "FH000"; # just to thwart any future optimisations
423 sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r }
424 sub DESTROY { print "destroyed\n" }
425 package main;
426 $x = any X; # to bump sv_objcount. IO objs aren't counted??
427 *f = afh X;
428 EXPECT
429 destroyed
430 destroyed
431 ########
432 BEGIN {
433   $| = 1;
434   $SIG{__WARN__} = sub {
435     eval { print $_[0] };
436     die "bar\n";
437   };
438   warn "foo\n";
439 }
440 EXPECT
441 foo
442 bar
443 BEGIN failed--compilation aborted at - line 8.
444 ########
445 package X;
446 @ISA='Y';
447 sub new {
448     my $class = shift;
449     my $self = { };
450     bless $self, $class;
451     my $init = shift;
452     $self->foo($init);
453     print "new", $init;
454     return $self;
455 }
456 sub DESTROY {
457     my $self = shift;
458     print "DESTROY", $self->foo;
459 }
460 package Y;
461 sub attribute {
462     my $self = shift;
463     my $var = shift;
464     if (@_ == 0) {
465         return $self->{$var};
466     } elsif (@_ == 1) {
467         $self->{$var} = shift;
468     }
469 }
470 sub AUTOLOAD {
471     $AUTOLOAD =~ /::([^:]+)$/;
472     my $method = $1;
473     splice @_, 1, 0, $method;
474     goto &attribute;
475 }
476 package main;
477 my $x = X->new(1);
478 for (2..3) {
479     my $y = X->new($_);
480     print $y->foo;
481 }
482 print $x->foo;
483 EXPECT
484 new1new22DESTROY2new33DESTROY31DESTROY1
485 ########
486 re();
487 sub re {
488     my $re = join '', eval 'qr/(??{ $obj->method })/';
489     $re;
490 }
491 EXPECT
492 ########
493 use strict;
494 my $foo = "ZZZ\n";
495 END { print $foo }
496 EXPECT
497 ZZZ
498 ########
499 eval '
500 use strict;
501 my $foo = "ZZZ\n";
502 END { print $foo }
503 ';
504 EXPECT
505 ZZZ
506 ########
507 -w
508 if (@ARGV) { print "" }
509 else {
510   if ($x == 0) { print "" } else { print $x }
511 }
512 EXPECT
513 Use of uninitialized value $x in numeric eq (==) at - line 4.
514 ########
515 $x = sub {};
516 foo();
517 sub foo { eval { return }; }
518 print "ok\n";
519 EXPECT
520 ok
521 ########
522 # moved to op/lc.t
523 EXPECT
524 ########
525 sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next }
526 my $x = "foo";
527 { f } continue { print $x, "\n" }
528 EXPECT
529 foo
530 ########
531 sub C () { 1 }
532 sub M { $_[0] = 2; }
533 eval "C";
534 M(C);
535 EXPECT
536 Modification of a read-only value attempted at - line 2.
537 ########
538 print qw(ab a\b a\\b);
539 EXPECT
540 aba\ba\b
541 ########
542 # lexicals declared after the myeval() definition should not be visible
543 # within it
544 sub myeval { eval $_[0] }
545 my $foo = "ok 2\n";
546 myeval('sub foo { local $foo = "ok 1\n"; print $foo; }');
547 die $@ if $@;
548 foo();
549 print $foo;
550 EXPECT
551 ok 1
552 ok 2
553 ########
554 # lexicals outside an eval"" should be visible inside subroutine definitions
555 # within it
556 eval <<'EOT'; die $@ if $@;
557 {
558     my $X = "ok\n";
559     eval 'sub Y { print $X }'; die $@ if $@;
560     Y();
561 }
562 EOT
563 EXPECT
564 ok
565 ########
566 # This test is here instead of lib/locale.t because
567 # the bug depends on in the internal state of the locale
568 # settings and pragma/locale messes up that state pretty badly.
569 # We need a "fresh run".
570 BEGIN {
571     eval { require POSIX };
572     if ($@) {
573         exit(0); # running minitest?
574     }
575 }
576 use Config;
577 my $have_setlocale = $Config{d_setlocale} eq 'define';
578 $have_setlocale = 0 if $@;
579 # Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
580 # and mingw32 uses said silly CRT
581 $have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
582 exit(0) unless $have_setlocale;
583 my @locales;
584 if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
585     while(<LOCALES>) {
586         chomp;
587         push(@locales, $_);
588     }
589     close(LOCALES);
590 }
591 exit(0) unless @locales;
592 for (@locales) {
593     use POSIX qw(locale_h);
594     use locale;
595     setlocale(LC_NUMERIC, $_) or next;
596     my $s = sprintf "%g %g", 3.1, 3.1;
597     next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
598     print "$_ $s\n";
599 }
600 EXPECT
601 ########
602 # [ID 20001202.002] and change #8066 added 'at -e line 1';
603 # reversed again as a result of [perl #17763]
604 die qr(x)
605 EXPECT
606 (?-xism:x)
607 ########
608 # 20001210.003 mjd@plover.com
609 format REMITOUT_TOP =
610 FOO
611 .
612
613 format REMITOUT =
614 BAR
615 .
616
617 # This loop causes a segv in 5.6.0
618 for $lineno (1..61) {
619    write REMITOUT;
620 }
621
622 print "It's OK!";
623 EXPECT
624 It's OK!
625 ########
626 # Inaba Hiroto
627 reset;
628 if (0) {
629   if ("" =~ //) {
630   }
631 }
632 ########
633 # Nicholas Clark
634 $ENV{TERM} = 0;
635 reset;
636 // if 0;
637 ########
638 # Vadim Konovalov
639 use strict;
640 sub new_pmop($) {
641     my $pm = shift;
642     return eval "sub {shift=~/$pm/}";
643 }
644 new_pmop "abcdef"; reset;
645 new_pmop "abcdef"; reset;
646 new_pmop "abcdef"; reset;
647 new_pmop "abcdef"; reset;
648 ########
649 # David Dyck
650 # coredump in 5.7.1
651 close STDERR; die;
652 EXPECT
653 ########
654 -w
655 "x" =~ /(\G?x)?/;       # core dump in 20000716.007
656 ########
657 # Bug 20010515.004
658 my @h = 1 .. 10;
659 bad(@h);
660 sub bad {
661    undef @h;
662    print "O";
663    print for @_;
664    print "K";
665 }
666 EXPECT
667 OK
668 ########
669 # Bug 20010506.041
670 "abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n";
671 EXPECT
672 ok
673 ########
674 my $foo = Bar->new();
675 my @dst;
676 END {
677     ($_ = "@dst") =~ s/\(0x.+?\)/(0x...)/;
678     print $_, "\n";
679 }
680 package Bar;
681 sub new {
682     my Bar $self = bless [], Bar;
683     eval '$self';
684     return $self;
685 }
686 sub DESTROY { 
687     push @dst, "$_[0]";
688 }
689 EXPECT
690 Bar=ARRAY(0x...)
691 ######## (?{...}) compilation bounces on PL_rs
692 -0
693 {
694   /(?{ $x })/;
695   # {
696 }
697 BEGIN { print "ok\n" }
698 EXPECT
699 ok
700 ######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155]
701 # This only happens if the filename is 11 characters or less.
702 $foo = \-f "blah";
703 print "ok" if ref $foo && !$$foo;
704 EXPECT
705 ok
706 ######## [ID 20011128.159] 'X' =~ /\X/ segfault in 5.6.1
707 print "ok" if 'X' =~ /\X/;
708 EXPECT
709 ok
710 ######## segfault in 5.6.1 within peep()
711 @a = (1..9);
712 @b = sort { @c = sort { @d = sort { 0 } @a; @d; } @a; } @a;
713 print join '', @a, "\n";
714 EXPECT
715 123456789
716 ######## [ID 20020104.007] "coredump on dbmclose"
717 package Foo;
718 eval { require AnyDBM_File }; # not all places have dbm* functions
719 if ($@) {
720     print "ok\n";
721     exit 0;
722 }
723 package Foo;
724 sub new {
725         my $proto = shift;
726         my $class = ref($proto) || $proto;
727         my $self  = {};
728         bless($self,$class);
729         my %LT;
730         dbmopen(%LT, "dbmtest", 0666) ||
731             die "Can't open dbmtest because of $!\n";
732         $self->{'LT'} = \%LT;
733         return $self;
734 }
735 sub DESTROY {
736         my $self = shift;
737         dbmclose(%{$self->{'LT'}});
738         1 while unlink 'dbmtest';
739         1 while unlink <dbmtest.*>;
740         print "ok\n";
741 }
742 package main;
743 $test = Foo->new(); # must be package var
744 EXPECT
745 ok
746 ######## example from Camel 5, ch. 15, pp.406 (with my)
747 # SKIP: ord "A" == 193 # EBCDIC
748 use strict;
749 use utf8;
750 my $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
751 $人++; # a child is born
752 print $人, "\n";
753 EXPECT
754 3
755 ######## example from Camel 5, ch. 15, pp.406 (with our)
756 # SKIP: ord "A" == 193 # EBCDIC
757 use strict;
758 use utf8;
759 our $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
760 $人++; # a child is born
761 print $人, "\n";
762 EXPECT
763 3
764 ######## example from Camel 5, ch. 15, pp.406 (with package vars)
765 # SKIP: ord "A" == 193 # EBCDIC
766 use utf8;
767 $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
768 $人++; # a child is born
769 print $人, "\n";
770 EXPECT
771 3
772 ######## example from Camel 5, ch. 15, pp.406 (with use vars)
773 # SKIP: ord "A" == 193 # EBCDIC
774 use strict;
775 use utf8;
776 use vars qw($人);
777 $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
778 $人++; # a child is born
779 print $人, "\n";
780 EXPECT
781 3
782 ########
783 # test that closures generated by eval"" hold on to the CV of the eval""
784 # for their entire lifetime
785 $code = eval q[
786   sub { eval '$x = "ok 1\n"'; }
787 ];
788 &{$code}();
789 print $x;
790 EXPECT
791 ok 1
792 ######## [ID 20020623.009] nested eval/sub segfaults
793 $eval = eval 'sub { eval "sub { %S }" }';
794 $eval->({});
795 ######## [perl #17951] Strange UTF error
796 -W
797 # From: "John Kodis" <kodis@mail630.gsfc.nasa.gov>
798 # Newsgroups: comp.lang.perl.moderated
799 # Subject: Strange UTF error
800 # Date: Fri, 11 Oct 2002 16:19:58 -0400
801 # Message-ID: <pan.2002.10.11.20.19.48.407190@mail630.gsfc.nasa.gov>
802 $_ = "foobar\n";
803 utf8::upgrade($_); # the original code used a UTF-8 locale (affects STDIN)
804 # matching is actually irrelevant: avoiding several dozen of these
805 # Illegal hexadecimal digit '   ' ignored at /usr/lib/perl5/5.8.0/utf8_heavy.pl line 152
806 # is what matters.
807 /^([[:digit:]]+)/;
808 EXPECT
809 ######## [perl #20667] unicode regex vs non-unicode regex
810 $toto = 'Hello';
811 $toto =~ /\w/; # this line provokes the problem!
812 $name = 'A B';
813 # utf8::upgrade($name) if @ARGV;
814 if ($name =~ /(\p{IsUpper}) (\p{IsUpper})/){
815     print "It's good! >$1< >$2<\n";
816 } else {
817     print "It's not good...\n";
818 }
819 EXPECT
820 It's good! >A< >B<
821 ######## [perl #8760] strangness with utf8 and warn
822 $_="foo";utf8::upgrade($_);/bar/i,warn$_;
823 EXPECT
824 foo at - line 1.
825 ######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com>
826 -lw
827 BEGIN {
828   eval 'require Fcntl';
829   if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest?
830 }
831 if ($^O eq 'VMS') { # VMS is not *that* kind of a glob.
832 print qq[./"TEST"\n./"TEST"\n];
833 } else {
834 print glob(q(./"TEST"));
835 use File::Glob;
836 print glob(q(./"TEST"));
837 }
838 EXPECT
839 ./"TEST"
840 ./"TEST"
841 ######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com>
842 -lw
843 BEGIN {
844   eval 'require Fcntl';
845   if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest?
846 }
847 if ($^O eq 'VMS') { # VMS is not *that* kind of a glob.
848 print qq[./"TEST"\n./"TEST"\n];
849 } else {
850 use File::Glob;
851 print glob(q(./"TEST"));
852 use File::Glob;
853 print glob(q(./"TEST"));
854 }
855 EXPECT
856 ./"TEST"
857 ./"TEST"
858 ######## "Segfault using HTML::Entities", Richard Jolly <richardjolly@mac.com>, <A3C7D27E-C9F4-11D8-B294-003065AE00B6@mac.com> in perl-unicode@perl.org
859 # SKIP: " $Config::Config{'extensions'} " !~ m[ Encode ] # Perl configured without Encode module
860 -lw
861 BEGIN {
862   eval 'require Encode';
863   if ($@) { exit 0 } # running minitest?
864 }
865 # Test case cut down by jhi
866 $SIG{__WARN__} = sub { $@ = shift };
867 use Encode;
868 my $t = "\xE9";
869 Encode::_utf8_on($t);
870 $t =~ s/([^a])//ge;
871 $@ =~ s/ at .*/ at/;
872 print $@
873 EXPECT
874 Malformed UTF-8 character (unexpected end of string) at