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