This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move some tests from t/run/fresh_perl.t
[perl5.git] / t / run / fresh_perl.t
CommitLineData
a0d0e21e
LW
1#!./perl
2
eeabcb2d
MS
3# ** DO NOT ADD ANY MORE TESTS HERE **
4# Instead, put the test in the appropriate test file and use the
f5cda331 5# fresh_perl_is()/fresh_perl_like() functions in t/test.pl.
eeabcb2d 6
f15b33d3 7# This is for tests that used to abnormally cause segfaults, and other nasty
c9beb3f5
MS
8# errors that might kill the interpreter and for some reason you can't
9# use an eval().
fb73857a 10
c9beb3f5
MS
11BEGIN {
12 chdir 't' if -d 't';
13 @INC = '../lib';
c59238f2 14 require './test.pl'; # for which_perl() etc
c9beb3f5
MS
15}
16
17use strict;
a0d0e21e 18
c59238f2 19my $Perl = which_perl();
b5fe401b 20
a0d0e21e
LW
21$|=1;
22
c9beb3f5
MS
23my @prgs = ();
24while(<DATA>) {
25 if(m/^#{8,}\s*(.*)/) {
26 push @prgs, ['', $1];
27 }
28 else {
29 $prgs[-1][0] .= $_;
30 }
31}
eeabcb2d 32plan tests => scalar @prgs;
a0d0e21e 33
c9beb3f5
MS
34foreach my $prog (@prgs) {
35 my($raw_prog, $name) = @$prog;
68dc0745 36
a0d0e21e 37 my $switch;
c9beb3f5 38 if ($raw_prog =~ s/^\s*(-\w.*)//){
fb73857a 39 $switch = $1;
a0d0e21e 40 }
c9beb3f5
MS
41
42 my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog);
43
b97a373d
JH
44 if ($prog =~ /^\# SKIP: (.+)/m) {
45 if (eval $1) {
46 ok(1, "Skip: $1");
47 next;
48 }
49 }
50
f5cda331
JH
51 $expected =~ s/\n+$//;
52
53 fresh_perl_is($prog, $expected, { switches => [$switch] }, $name);
a0d0e21e
LW
54}
55
56__END__
2ace3117 57########
44a8e56a
PP
58$a = ":="; split /($a)/o, "a:=b:=c"; print "@_"
59EXPECT
60a := b := c
61########
36477c24 62$cusp = ~0 ^ (~0 >> 1);
85e0ebd8 63use integer;
36477c24 64$, = " ";
85e0ebd8 65print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, 8 | (($cusp + 1) % 8 + 7), "!\n";
36477c24 66EXPECT
85e0ebd8 677 0 0 8 !
36477c24 68########
a0d0e21e
LW
69$foo=undef; $foo->go;
70EXPECT
72b5445b 71Can't call method "go" on an undefined value at - line 1.
a0d0e21e
LW
72########
73BEGIN
74 {
75 "foo";
76 }
77########
a0d0e21e
LW
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########
648cac19 84chop ($str .= <DATA>);
a0d0e21e
LW
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########
dc459aad 94system './perl -ne "print if eof" /dev/null' unless $^O eq 'MacOS'
a0d0e21e 95########
648cac19 96chop($file = <DATA>);
a0d0e21e
LW
97########
98package N;
99sub new {my ($obj,$n)=@_; bless \$n}
100$aa=new N 1;
101$aa=12345;
102print $aa;
103EXPECT
10412345
105########
a0d0e21e
LW
106$_="foo";
107printf(STDOUT "%s\n", $_);
108EXPECT
109foo
110########
111push(@a, 1, 2, 3,)
112########
113quotemeta ""
114########
115for ("ABCDE") {
116 &sub;
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.
a7adf1f0
PP
197########
198{
199 package foo;
200 sub PRINT {
201 shift;
202 print join(' ', reverse @_)."\n";
203 }
46fc3d4c
PP
204 sub PRINTF {
205 shift;
206 my $fmt = shift;
207 print sprintf($fmt, @_)."\n";
208 }
a7adf1f0
PP
209 sub TIEHANDLE {
210 bless {}, shift;
211 }
58f51617
SV
212 sub READLINE {
213 "Out of inspiration";
214 }
a7adf1f0
PP
215 sub DESTROY {
216 print "and destroyed as well\n";
2ae324a7
PP
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 }
a7adf1f0
PP
228}
229{
230 local(*FOO);
231 tie(*FOO,'foo');
232 print FOO "sentence.", "reversed", "a", "is", "This";
58f51617 233 print "-- ", <FOO>, " --\n";
2ae324a7
PP
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";
46fc3d4c 239 printf "%s is number %d\n", "Perl", 1;
a7adf1f0
PP
240}
241EXPECT
242This is a reversed sentence.
58f51617 243-- Out of inspiration --
2ae324a7
PP
244foo->can(READ)(string 10 1)
245Don't GETC, Get Perl
46fc3d4c 246Perl is number 1
a7adf1f0 247and destroyed as well
a6006777
PP
248########
249my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"
250EXPECT
2512 2 2
252########
8ff950ac 253# used to attach defelem magic to all immortal values,
8b530633
GA
254# which made restore of local $_ fail.
255foo(2>1);
256sub foo { bar() for @_; }
257sub bar { local $_; }
258print "ok\n";
259EXPECT
260ok
261########
a6006777
PP
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########
8ebc5c01 272print "ok\n" if ("\0" lt "\xFF");
a6006777
PP
273EXPECT
274ok
275########
dc459aad 276open(H,$^O eq 'MacOS' ? ':run:fresh_perl.t' : 'run/fresh_perl.t'); # must be in the 't' directory
a6006777
PP
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########
d53f8f1c
HS
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########
44a8e56a
PP
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
774d564b
PP
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);
1ca7b98a
CS
345########
346sub foo { local $_ = shift; split; @_ }
347@x = foo(' x y z ');
348print "you die joe!\n" unless "@x" eq 'x y z';
c277df42
IZ
349########
350/(?{"{"})/ # Check it outside of eval too
351EXPECT
2cd61cdb 352Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern
7253e4e3 353Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1.
c277df42
IZ
354########
355/(?{"{"}})/ # Check it outside of eval too
356EXPECT
d98d5fff 357Unmatched right curly bracket at (re_eval 1) line 1, at end of line
c277df42 358syntax error at (re_eval 1) line 1, near ""{"}"
2cd61cdb 359Compilation failed in regexp at - line 1.
0da4822f 360########
ff689196 361BEGIN { @ARGV = qw(a b c d e) }
0da4822f
GS
362BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
363END { print "end <",shift,">\nargv <@ARGV>\n" }
364INIT { print "init <",shift,">\n" }
7d30b5c4 365CHECK { print "check <",shift,">\n" }
0da4822f 366EXPECT
ff689196 367argv <a b c d e>
0da4822f 368begin <a>
7d30b5c4 369check <b>
ff689196
GS
370init <c>
371end <d>
372argv <e>
4599a1de 373########
3500f679
RS
374-l
375# fdopen from a system descriptor to a system descriptor used to close
376# the former.
377open STDERR, '>&=STDOUT' or die $!;
75642110
NC
378select STDOUT; $| = 1; print fileno STDOUT or die $!;
379select STDERR; $| = 1; print fileno STDERR or die $!;
3500f679
RS
380EXPECT
3811
3822
383########
20408e3c
GS
384-w
385sub testme { my $a = "test"; { local $a = "new test"; print $a }}
386EXPECT
387Can't localize lexical variable $a at - line 2.
388########
51ae5c03
JPC
389package X;
390sub ascalar { my $r; bless \$r }
391sub DESTROY { print "destroyed\n" };
392package main;
393*s = ascalar X;
394EXPECT
395destroyed
396########
397package X;
398sub anarray { bless [] }
399sub DESTROY { print "destroyed\n" };
400package main;
401*a = anarray X;
402EXPECT
403destroyed
404########
405package X;
406sub ahash { bless {} }
407sub DESTROY { print "destroyed\n" };
408package main;
409*h = ahash X;
410EXPECT
411destroyed
412########
413package X;
414sub aclosure { my $x; bless sub { ++$x } }
415sub DESTROY { print "destroyed\n" };
416package main;
417*c = aclosure X;
418EXPECT
419destroyed
420########
421package X;
422sub any { bless {} }
423my $f = "FH000"; # just to thwart any future optimisations
ded8aa31 424sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r }
51ae5c03
JPC
425sub DESTROY { print "destroyed\n" }
426package main;
427$x = any X; # to bump sv_objcount. IO objs aren't counted??
428*f = afh X;
429EXPECT
430destroyed
431destroyed
432########
ebf99b04
GS
433BEGIN {
434 $| = 1;
435 $SIG{__WARN__} = sub {
436 eval { print $_[0] };
437 die "bar\n";
438 };
439 warn "foo\n";
440}
441EXPECT
442foo
443bar
444BEGIN failed--compilation aborted at - line 8.
8feb4e9f
JH
445########
446package X;
447@ISA='Y';
448sub new {
449 my $class = shift;
450 my $self = { };
451 bless $self, $class;
452 my $init = shift;
453 $self->foo($init);
454 print "new", $init;
455 return $self;
456}
457sub DESTROY {
458 my $self = shift;
459 print "DESTROY", $self->foo;
460}
461package Y;
462sub attribute {
463 my $self = shift;
464 my $var = shift;
465 if (@_ == 0) {
466 return $self->{$var};
467 } elsif (@_ == 1) {
468 $self->{$var} = shift;
469 }
470}
471sub AUTOLOAD {
472 $AUTOLOAD =~ /::([^:]+)$/;
473 my $method = $1;
474 splice @_, 1, 0, $method;
475 goto &attribute;
476}
477package main;
478my $x = X->new(1);
479for (2..3) {
480 my $y = X->new($_);
481 print $y->foo;
482}
483print $x->foo;
484EXPECT
485new1new22DESTROY2new33DESTROY31DESTROY1
dfad63ad
HS
486########
487re();
488sub re {
14455d6c 489 my $re = join '', eval 'qr/(??{ $obj->method })/';
dfad63ad
HS
490 $re;
491}
492EXPECT
1aff0e91
GS
493########
494use strict;
495my $foo = "ZZZ\n";
496END { print $foo }
497EXPECT
498ZZZ
499########
500eval '
501use strict;
502my $foo = "ZZZ\n";
503END { print $foo }
504';
505EXPECT
506ZZZ
7399586d
HS
507########
508-w
509if (@ARGV) { print "" }
510else {
511 if ($x == 0) { print "" } else { print $x }
512}
513EXPECT
b89fed5f 514Use of uninitialized value in numeric eq (==) at - line 4.
1d76a5c3
GS
515########
516$x = sub {};
517foo();
518sub foo { eval { return }; }
519print "ok\n";
520EXPECT
521ok
07447971 522########
b0f2b690 523# moved to op/lc.t
07447971 524EXPECT
92d29cee
JH
525########
526sub f { my $a = 1; my $b = 2; my $c = 3; my $d = 4; next }
527my $x = "foo";
528{ f } continue { print $x, "\n" }
529EXPECT
530foo
6a7129a1
GS
531########
532sub C () { 1 }
533sub M { $_[0] = 2; }
534eval "C";
535M(C);
536EXPECT
537Modification of a read-only value attempted at - line 2.
00c29ff8
TH
538########
539print qw(ab a\b a\\b);
540EXPECT
541aba\ba\b
dd8482fc 542########
c71fccf1
JH
543# lexicals declared after the myeval() definition should not be visible
544# within it
545sub myeval { eval $_[0] }
546my $foo = "ok 2\n";
547myeval('sub foo { local $foo = "ok 1\n"; print $foo; }');
548die $@ if $@;
549foo();
550print $foo;
551EXPECT
552ok 1
553ok 2
554########
2090ab20
JH
555# lexicals outside an eval"" should be visible inside subroutine definitions
556# within it
557eval <<'EOT'; die $@ if $@;
558{
559 my $X = "ok\n";
560 eval 'sub Y { print $X }'; die $@ if $@;
561 Y();
562}
563EOT
564EXPECT
565ok
566########
e5e32a3a 567# This test is here instead of lib/locale.t because
dd8482fc
JH
568# the bug depends on in the internal state of the locale
569# settings and pragma/locale messes up that state pretty badly.
570# We need a "fresh run".
c9f931b8
JH
571BEGIN {
572 eval { require POSIX };
573 if ($@) {
574 exit(0); # running minitest?
575 }
576}
dd8482fc
JH
577use Config;
578my $have_setlocale = $Config{d_setlocale} eq 'define';
dd8482fc
JH
579$have_setlocale = 0 if $@;
580# Visual C's CRT goes silly on strings of the form "en_US.ISO8859-1"
581# and mingw32 uses said silly CRT
2986a63f 582$have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i);
dd8482fc
JH
583exit(0) unless $have_setlocale;
584my @locales;
e5e32a3a 585if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) {
dd8482fc
JH
586 while(<LOCALES>) {
587 chomp;
588 push(@locales, $_);
589 }
590 close(LOCALES);
591}
592exit(0) unless @locales;
593for (@locales) {
594 use POSIX qw(locale_h);
595 use locale;
88e7acd2 596 setlocale(LC_NUMERIC, $_) or next;
dd8482fc
JH
597 my $s = sprintf "%g %g", 3.1, 3.1;
598 next if $s eq '3.1 3.1' || $s =~ /^(3.+1) \1$/;
599 print "$_ $s\n";
600}
601EXPECT
b927783e 602########
bf12611a
HS
603# [ID 20001202.002] and change #8066 added 'at -e line 1';
604# reversed again as a result of [perl #17763]
b927783e
JH
605die qr(x)
606EXPECT
bf12611a 607(?-xism:x)
b927783e 608########
7ef822cd
JH
609# 20001210.003 mjd@plover.com
610format REMITOUT_TOP =
611FOO
612.
613
614format REMITOUT =
615BAR
616.
617
618# This loop causes a segv in 5.6.0
619for $lineno (1..61) {
620 write REMITOUT;
621}
622
623print "It's OK!";
624EXPECT
625It's OK!
cb55de95
JH
626########
627# Inaba Hiroto
628reset;
629if (0) {
630 if ("" =~ //) {
631 }
632}
633########
634# Nicholas Clark
635$ENV{TERM} = 0;
636reset;
637// if 0;
638########
639# Vadim Konovalov
640use strict;
641sub new_pmop($) {
642 my $pm = shift;
643 return eval "sub {shift=~/$pm/}";
644}
645new_pmop "abcdef"; reset;
646new_pmop "abcdef"; reset;
647new_pmop "abcdef"; reset;
648new_pmop "abcdef"; reset;
880649cd
JH
649########
650# David Dyck
651# coredump in 5.7.1
652close STDERR; die;
653EXPECT
dba9804b 654########
99799961
HS
655-w
656"x" =~ /(\G?x)?/; # core dump in 20000716.007
99799961 657########
dba9804b
BS
658# Bug 20010515.004
659my @h = 1 .. 10;
660bad(@h);
661sub bad {
662 undef @h;
663 print "O";
664 print for @_;
665 print "K";
666}
667EXPECT
668OK
97b9a4cb
HS
669########
670# Bug 20010506.041
671"abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n";
672EXPECT
673ok
0b490c9c 674########
08b362fd
JH
675my $foo = Bar->new();
676my @dst;
677END {
678 ($_ = "@dst") =~ s/\(0x.+?\)/(0x...)/;
679 print $_, "\n";
680}
681package Bar;
682sub new {
683 my Bar $self = bless [], Bar;
684 eval '$self';
685 return $self;
686}
687sub DESTROY {
688 push @dst, "$_[0]";
689}
690EXPECT
691Bar=ARRAY(0x...)
8bfdd7d9
HS
692######## (?{...}) compilation bounces on PL_rs
693-0
694{
695 /(?{ $x })/;
696 # {
697}
698BEGIN { print "ok\n" }
699EXPECT
700ok
80071be7
MS
701######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155]
702# This only happens if the filename is 11 characters or less.
703$foo = \-f "blah";
704print "ok" if ref $foo && !$$foo;
705EXPECT
706ok
15a59b2d
MS
707######## [ID 20011128.159] 'X' =~ /\X/ segfault in 5.6.1
708print "ok" if 'X' =~ /\X/;
709EXPECT
710ok
f9dc862f
HS
711######## segfault in 5.6.1 within peep()
712@a = (1..9);
713@b = sort { @c = sort { @d = sort { 0 } @a; @d; } @a; } @a;
714print join '', @a, "\n";
715EXPECT
716123456789
a6fc0784
JS
717######## [ID 20020104.007] "coredump on dbmclose"
718package Foo;
327ccce1 719eval { require AnyDBM_File }; # not all places have dbm* functions
a6fc0784
JS
720if ($@) {
721 print "ok\n";
722 exit 0;
723}
724package Foo;
725sub new {
726 my $proto = shift;
727 my $class = ref($proto) || $proto;
728 my $self = {};
729 bless($self,$class);
730 my %LT;
731 dbmopen(%LT, "dbmtest", 0666) ||
732 die "Can't open dbmtest because of $!\n";
733 $self->{'LT'} = \%LT;
734 return $self;
735}
736sub DESTROY {
737 my $self = shift;
eb6e4459 738 dbmclose(%{$self->{'LT'}});
26d793c1 739 1 while unlink 'dbmtest';
a6fc0784
JS
740 1 while unlink <dbmtest.*>;
741 print "ok\n";
742}
eb6e4459
YST
743package main;
744$test = Foo->new(); # must be package var
a6fc0784
JS
745EXPECT
746ok
82686b01 747######## example from Camel 5, ch. 15, pp.406 (with my)
b97a373d 748# SKIP: ord "A" == 193 # EBCDIC
82686b01
JH
749use strict;
750use utf8;
751my $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
752$人++; # a child is born
753print $人, "\n";
754EXPECT
7553
756######## example from Camel 5, ch. 15, pp.406 (with our)
b97a373d 757# SKIP: ord "A" == 193 # EBCDIC
82686b01
JH
758use strict;
759use utf8;
760our $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
761$人++; # a child is born
762print $人, "\n";
763EXPECT
7643
765######## example from Camel 5, ch. 15, pp.406 (with package vars)
b97a373d 766# SKIP: ord "A" == 193 # EBCDIC
82686b01
JH
767use utf8;
768$人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
769$人++; # a child is born
770print $人, "\n";
771EXPECT
7723
08cd7fd6
JH
773######## example from Camel 5, ch. 15, pp.406 (with use vars)
774# SKIP: ord "A" == 193 # EBCDIC
775use strict;
776use utf8;
777use vars qw($人);
778$人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph
779$人++; # a child is born
780print $人, "\n";
781EXPECT
7823
650375fe
JH
783########
784# test that closures generated by eval"" hold on to the CV of the eval""
785# for their entire lifetime
786$code = eval q[
787 sub { eval '$x = "ok 1\n"'; }
788];
789&{$code}();
790print $x;
791EXPECT
792ok 1
793######## [ID 20020623.009] nested eval/sub segfaults
794$eval = eval 'sub { eval "sub { %S }" }';
795$eval->({});
df68b396
JH
796######## [perl #17951] Strange UTF error
797-W
798# From: "John Kodis" <kodis@mail630.gsfc.nasa.gov>
799# Newsgroups: comp.lang.perl.moderated
800# Subject: Strange UTF error
801# Date: Fri, 11 Oct 2002 16:19:58 -0400
802# Message-ID: <pan.2002.10.11.20.19.48.407190@mail630.gsfc.nasa.gov>
803$_ = "foobar\n";
804utf8::upgrade($_); # the original code used a UTF-8 locale (affects STDIN)
805# matching is actually irrelevant: avoiding several dozen of these
806# Illegal hexadecimal digit ' ' ignored at /usr/lib/perl5/5.8.0/utf8_heavy.pl line 152
807# is what matters.
808/^([[:digit:]]+)/;
809EXPECT