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.*)//){ 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 "@_" 59EXPECT 60a := b := c 61######## 62$cusp = ~0 ^ (~0 >> 1); 63use integer; 64$, = " "; 65print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, 8 | (($cusp + 1) % 8 + 7), "!\n"; 66EXPECT 677 0 0 8 ! 68######## 69$foo=undef; $foo->go; 70EXPECT 71Can't call method "go" on an undefined value at - line 1. 72######## 73BEGIN 74 { 75 "foo"; 76 } 77######## 78$array[128]=1 79######## 80$x=0x0eabcd; print $x->ref; 81EXPECT 82Can't call method "ref" without a package or object reference at - line 1. 83######## 84chop ($str .= <DATA>); 85######## 86close ($banana); 87######## 88$x=2;$y=3;$x<$y ? $x : $y += 23;print $x; 89EXPECT 9025 91######## 92eval 'sub bar {print "In bar"}'; 93######## 94system './perl -ne "print if eof" /dev/null' unless $^O eq 'MacOS' 95######## 96chop($file = <DATA>); 97######## 98package N; 99sub new {my ($obj,$n)=@_; bless \$n} 100$aa=new N 1; 101$aa=12345; 102print $aa; 103EXPECT 10412345 105######## 106$_="foo"; 107printf(STDOUT "%s\n", $_); 108EXPECT 109foo 110######## 111push(@a, 1, 2, 3,) 112######## 113quotemeta "" 114######## 115for ("ABCDE") { 116 ⊂ 117s/./&sub($&)/eg; 118print;} 119sub sub {local($_) = @_; 120$_ x 4;} 121EXPECT 122Modification of a read-only value attempted at - line 3. 123######## 124package FOO;sub new {bless {FOO => BAR}}; 125package main; 126use strict vars; 127my $self = new FOO; 128print $$self{FOO}; 129EXPECT 130BAR 131######## 132$_="foo"; 133s/.{1}//s; 134print; 135EXPECT 136oo 137######## 138print scalar ("foo","bar") 139EXPECT 140bar 141######## 142sub by_number { $a <=> $b; };# inline function for sort below 143$as_ary{0}="a0"; 144@ordered_array=sort by_number keys(%as_ary); 145######## 146sub NewShell 147{ 148 local($Host) = @_; 149 my($m2) = $#Shells++; 150 $Shells[$m2]{HOST} = $Host; 151 return $m2; 152} 153 154sub 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 176eval 'tie @h, FAKEARRAY, fred' ; 177tie @h, FAKEARRAY, fred ; 178EXPECT 179TIEARRAY FAKEARRAY fred 180TIEARRAY FAKEARRAY fred 181DESTROY 182######## 183BEGIN { die "phooey\n" } 184EXPECT 185phooey 186BEGIN failed--compilation aborted at - line 1. 187######## 188BEGIN { 1/$zero } 189EXPECT 190Illegal division by zero at - line 1. 191BEGIN failed--compilation aborted at - line 1. 192######## 193BEGIN { undef = 0 } 194EXPECT 195Modification of a read-only value attempted at - line 1. 196BEGIN 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} 241EXPECT 242This is a reversed sentence. 243-- Out of inspiration -- 244foo->can(READ)(string 10 1) 245Don't GETC, Get Perl 246Perl is number 1 247and destroyed as well 248######## 249my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n" 250EXPECT 2512 2 2 252######## 253# used to attach defelem magic to all immortal values, 254# which made restore of local $_ fail. 255foo(2>1); 256sub foo { bar() for @_; } 257sub bar { local $_; } 258print "ok\n"; 259EXPECT 260ok 261######## 262@a = ($a, $b, $c, $d) = (5, 6); 263print "ok\n" 264 if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]); 265EXPECT 266ok 267######## 268print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000); 269EXPECT 270ok 271######## 272print "ok\n" if ("\0" lt "\xFF"); 273EXPECT 274ok 275######## 276open(H,$^O eq 'MacOS' ? ':run:fresh_perl.t' : 'run/fresh_perl.t'); # must be in the 't' directory 277stat(H); 278print "ok\n" if (-e _ and -f _ and -r _); 279EXPECT 280ok 281######## 282sub thing { 0 || return qw(now is the time) } 283print thing(), "\n"; 284EXPECT 285nowisthetime 286######## 287$ren = 'joy'; 288$stimpy = 'happy'; 289{ local $main::{ren} = *stimpy; print $ren, ' ' } 290print $ren, "\n"; 291EXPECT 292happy joy 293######## 294$stimpy = 'happy'; 295{ local $main::{ren} = *stimpy; print ${'ren'}, ' ' } 296print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n"; 297EXPECT 298happy joy 299######## 300package p; 301sub func { print 'really ' unless wantarray; 'p' } 302sub groovy { 'groovy' } 303package main; 304print p::func()->groovy(), "\n" 305EXPECT 306really groovy 307######## 308@list = ([ 'one', 1 ], [ 'two', 2 ]); 309sub func { $num = shift; (grep $_->[1] == $num, @list)[0] } 310print scalar(map &func($_), 1 .. 3), " ", 311 scalar(map scalar &func($_), 1 .. 3), "\n"; 312EXPECT 3132 3 314######## 315($k, $s) = qw(x 0); 316@{$h{$k}} = qw(1 2 4); 317for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) } 318print "bogus\n" unless $s == 7; 319######## 320my $a = 'outer'; 321eval q[ my $a = 'inner'; eval q[ print "$a " ] ]; 322eval { my $x = 'peace'; eval q[ print "$x\n" ] } 323EXPECT 324inner peace 325######## 326-w 327$| = 1; 328sub foo { 329 print "In foo1\n"; 330 eval 'sub foo { print "In foo2\n" }'; 331 print "Exiting foo1\n"; 332} 333foo; 334foo; 335EXPECT 336In foo1 337Subroutine foo redefined at (eval 1) line 1. 338Exiting foo1 339In foo2 340######## 341$s = 0; 342map {#this newline here tickles the bug 343$s += $_} (1,2,4); 344print "eat flaming death\n" unless ($s == 7); 345######## 346sub foo { local $_ = shift; split; @_ } 347@x = foo(' x y z '); 348print "you die joe!\n" unless "@x" eq 'x y z'; 349######## 350/(?{"{"})/ # Check it outside of eval too 351EXPECT 352Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1. 353######## 354/(?{"{"}})/ # Check it outside of eval too 355EXPECT 356Unmatched right curly bracket at (re_eval 1) line 1, at end of line 357syntax error at (re_eval 1) line 1, near ""{"}" 358Compilation failed in regexp at - line 1. 359######## 360BEGIN { @ARGV = qw(a b c d e) } 361BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" } 362END { print "end <",shift,">\nargv <@ARGV>\n" } 363INIT { print "init <",shift,">\n" } 364CHECK { print "check <",shift,">\n" } 365EXPECT 366argv <a b c d e> 367begin <a> 368check <b> 369init <c> 370end <d> 371argv <e> 372######## 373-l 374# fdopen from a system descriptor to a system descriptor used to close 375# the former. 376open STDERR, '>&=STDOUT' or die $!; 377select STDOUT; $| = 1; print fileno STDOUT or die $!; 378select STDERR; $| = 1; print fileno STDERR or die $!; 379EXPECT 3801 3812 382######## 383-w 384sub testme { my $a = "test"; { local $a = "new test"; print $a }} 385EXPECT 386Can't localize lexical variable $a at - line 2. 387######## 388package X; 389sub ascalar { my $r; bless \$r } 390sub DESTROY { print "destroyed\n" }; 391package main; 392*s = ascalar X; 393EXPECT 394destroyed 395######## 396package X; 397sub anarray { bless [] } 398sub DESTROY { print "destroyed\n" }; 399package main; 400*a = anarray X; 401EXPECT 402destroyed 403######## 404package X; 405sub ahash { bless {} } 406sub DESTROY { print "destroyed\n" }; 407package main; 408*h = ahash X; 409EXPECT 410destroyed 411######## 412package X; 413sub aclosure { my $x; bless sub { ++$x } } 414sub DESTROY { print "destroyed\n" }; 415package main; 416*c = aclosure X; 417EXPECT 418destroyed 419######## 420package X; 421sub any { bless {} } 422my $f = "FH000"; # just to thwart any future optimisations 423sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r } 424sub DESTROY { print "destroyed\n" } 425package main; 426$x = any X; # to bump sv_objcount. IO objs aren't counted?? 427*f = afh X; 428EXPECT 429destroyed 430destroyed 431######## 432BEGIN { 433 $| = 1; 434 $SIG{__WARN__} = sub { 435 eval { print $_[0] }; 436 die "bar\n"; 437 }; 438 warn "foo\n"; 439} 440EXPECT 441foo 442bar 443BEGIN failed--compilation aborted at - line 8. 444######## 445package X; 446@ISA='Y'; 447sub 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} 456sub DESTROY { 457 my $self = shift; 458 print "DESTROY", $self->foo; 459} 460package Y; 461sub 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} 470sub AUTOLOAD { 471 $AUTOLOAD =~ /::([^:]+)$/; 472 my $method = $1; 473 splice @_, 1, 0, $method; 474 goto &attribute; 475} 476package main; 477my $x = X->new(1); 478for (2..3) { 479 my $y = X->new($_); 480 print $y->foo; 481} 482print $x->foo; 483EXPECT 484new1new22DESTROY2new33DESTROY31DESTROY1 485######## 486re(); 487sub re { 488 my $re = join '', eval 'qr/(??{ $obj->method })/'; 489 $re; 490} 491EXPECT 492######## 493use strict; 494my $foo = "ZZZ\n"; 495END { print $foo } 496EXPECT 497ZZZ 498######## 499eval ' 500use strict; 501my $foo = "ZZZ\n"; 502END { print $foo } 503'; 504EXPECT 505ZZZ 506######## 507-w 508if (@ARGV) { print "" } 509else { 510 if ($x == 0) { print "" } else { print $x } 511} 512EXPECT 513Use of uninitialized value in numeric eq (==) at - line 4. 514######## 515$x = sub {}; 516foo(); 517sub foo { eval { return }; } 518print "ok\n"; 519EXPECT 520ok 521######## 522# moved to op/lc.t 523EXPECT 524######## 525sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next } 526my $x = "foo"; 527{ f } continue { print $x, "\n" } 528EXPECT 529foo 530######## 531sub C () { 1 } 532sub M { $_[0] = 2; } 533eval "C"; 534M(C); 535EXPECT 536Modification of a read-only value attempted at - line 2. 537######## 538print qw(ab a\b a\\b); 539EXPECT 540aba\ba\b 541######## 542# lexicals declared after the myeval() definition should not be visible 543# within it 544sub myeval { eval $_[0] } 545my $foo = "ok 2\n"; 546myeval('sub foo { local $foo = "ok 1\n"; print $foo; }'); 547die $@ if $@; 548foo(); 549print $foo; 550EXPECT 551ok 1 552ok 2 553######## 554# lexicals outside an eval"" should be visible inside subroutine definitions 555# within it 556eval <<'EOT'; die $@ if $@; 557{ 558 my $X = "ok\n"; 559 eval 'sub Y { print $X }'; die $@ if $@; 560 Y(); 561} 562EOT 563EXPECT 564ok 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". 570BEGIN { 571 eval { require POSIX }; 572 if ($@) { 573 exit(0); # running minitest? 574 } 575} 576use Config; 577my $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); 582exit(0) unless $have_setlocale; 583my @locales; 584if (-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} 591exit(0) unless @locales; 592for (@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} 600EXPECT 601######## 602# [ID 20001202.002] and change #8066 added 'at -e line 1'; 603# reversed again as a result of [perl #17763] 604die qr(x) 605EXPECT 606(?-xism:x) 607######## 608# 20001210.003 mjd@plover.com 609format REMITOUT_TOP = 610FOO 611. 612 613format REMITOUT = 614BAR 615. 616 617# This loop causes a segv in 5.6.0 618for $lineno (1..61) { 619 write REMITOUT; 620} 621 622print "It's OK!"; 623EXPECT 624It's OK! 625######## 626# Inaba Hiroto 627reset; 628if (0) { 629 if ("" =~ //) { 630 } 631} 632######## 633# Nicholas Clark 634$ENV{TERM} = 0; 635reset; 636// if 0; 637######## 638# Vadim Konovalov 639use strict; 640sub new_pmop($) { 641 my $pm = shift; 642 return eval "sub {shift=~/$pm/}"; 643} 644new_pmop "abcdef"; reset; 645new_pmop "abcdef"; reset; 646new_pmop "abcdef"; reset; 647new_pmop "abcdef"; reset; 648######## 649# David Dyck 650# coredump in 5.7.1 651close STDERR; die; 652EXPECT 653######## 654-w 655"x" =~ /(\G?x)?/; # core dump in 20000716.007 656######## 657# Bug 20010515.004 658my @h = 1 .. 10; 659bad(@h); 660sub bad { 661 undef @h; 662 print "O"; 663 print for @_; 664 print "K"; 665} 666EXPECT 667OK 668######## 669# Bug 20010506.041 670"abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n"; 671EXPECT 672ok 673######## 674my $foo = Bar->new(); 675my @dst; 676END { 677 ($_ = "@dst") =~ s/\(0x.+?\)/(0x...)/; 678 print $_, "\n"; 679} 680package Bar; 681sub new { 682 my Bar $self = bless [], Bar; 683 eval '$self'; 684 return $self; 685} 686sub DESTROY { 687 push @dst, "$_[0]"; 688} 689EXPECT 690Bar=ARRAY(0x...) 691######## (?{...}) compilation bounces on PL_rs 692-0 693{ 694 /(?{ $x })/; 695 # { 696} 697BEGIN { print "ok\n" } 698EXPECT 699ok 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"; 703print "ok" if ref $foo && !$$foo; 704EXPECT 705ok 706######## [ID 20011128.159] 'X' =~ /\X/ segfault in 5.6.1 707print "ok" if 'X' =~ /\X/; 708EXPECT 709ok 710######## segfault in 5.6.1 within peep() 711@a = (1..9); 712@b = sort { @c = sort { @d = sort { 0 } @a; @d; } @a; } @a; 713print join '', @a, "\n"; 714EXPECT 715123456789 716######## [ID 20020104.007] "coredump on dbmclose" 717package Foo; 718eval { require AnyDBM_File }; # not all places have dbm* functions 719if ($@) { 720 print "ok\n"; 721 exit 0; 722} 723package Foo; 724sub 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} 735sub DESTROY { 736 my $self = shift; 737 dbmclose(%{$self->{'LT'}}); 738 1 while unlink 'dbmtest'; 739 1 while unlink <dbmtest.*>; 740 print "ok\n"; 741} 742package main; 743$test = Foo->new(); # must be package var 744EXPECT 745ok 746######## example from Camel 5, ch. 15, pp.406 (with my) 747# SKIP: ord "A" == 193 # EBCDIC 748use strict; 749use utf8; 750my $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph 751$人++; # a child is born 752print $人, "\n"; 753EXPECT 7543 755######## example from Camel 5, ch. 15, pp.406 (with our) 756# SKIP: ord "A" == 193 # EBCDIC 757use strict; 758use utf8; 759our $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph 760$人++; # a child is born 761print $人, "\n"; 762EXPECT 7633 764######## example from Camel 5, ch. 15, pp.406 (with package vars) 765# SKIP: ord "A" == 193 # EBCDIC 766use utf8; 767$人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph 768$人++; # a child is born 769print $人, "\n"; 770EXPECT 7713 772######## example from Camel 5, ch. 15, pp.406 (with use vars) 773# SKIP: ord "A" == 193 # EBCDIC 774use strict; 775use utf8; 776use vars qw($人); 777$人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph 778$人++; # a child is born 779print $人, "\n"; 780EXPECT 7813 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}(); 789print $x; 790EXPECT 791ok 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"; 803utf8::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:]]+)/; 808EXPECT 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; 814if ($name =~ /(\p{IsUpper}) (\p{IsUpper})/){ 815 print "It's good! >$1< >$2<\n"; 816} else { 817 print "It's not good...\n"; 818} 819EXPECT 820It's good! >A< >B< 821######## [perl #8760] strangness with utf8 and warn 822$_="foo";utf8::upgrade($_);/bar/i,warn$_; 823EXPECT 824foo at - line 1. 825######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com> 826-lw 827BEGIN { 828 eval 'require Fcntl'; 829 if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest? 830} 831if ($^O eq 'VMS') { # VMS is not *that* kind of a glob. 832print qq[./"TEST"\n./"TEST"\n]; 833} else { 834print glob(q(./"TEST")); 835use File::Glob; 836print glob(q(./"TEST")); 837} 838EXPECT 839./"TEST" 840./"TEST" 841######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com> 842-lw 843BEGIN { 844 eval 'require Fcntl'; 845 if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest? 846} 847if ($^O eq 'VMS') { # VMS is not *that* kind of a glob. 848print qq[./"TEST"\n./"TEST"\n]; 849} else { 850use File::Glob; 851print glob(q(./"TEST")); 852use File::Glob; 853print glob(q(./"TEST")); 854} 855EXPECT 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-lw 860BEGIN { 861 eval 'require Encode'; 862 if ($@) { exit 0 } # running minitest? 863} 864# Test case cut down by jhi 865$SIG{__WARN__} = sub { $@ = shift }; 866use Encode; 867my $t = "\xE9"; 868Encode::_utf8_on($t); 869$t =~ s/([^a])//ge; 870$@ =~ s/ at .*/ at/; 871print $@ 872EXPECT 873Malformed UTF-8 character (unexpected end of string) at 874