This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix example #4 in perlXStut
[perl5.git] / t / op / misc.t
CommitLineData
a0d0e21e
LW
1#!./perl
2
3chdir 't' if -d 't';
4@INC = "../lib";
5$ENV{PERL5LIB} = "../lib";
6
7$|=1;
8
9undef $/;
10@prgs = split "\n########\n", <DATA>;
11print "1..", scalar @prgs, "\n";
12
13$tmpfile = "misctmp000";
141 while -f ++$tmpfile;
15END { unlink $tmpfile if $tmpfile; }
16
17for (@prgs){
18 my $switch;
19 if (s/^\s*-\w+//){
20 $switch = $&;
21 }
22 my($prog,$expected) = split(/\nEXPECT\n/, $_);
23 open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
24 print TEST $prog, "\n";
25 close TEST;
26 $status = $?;
27 $results = `cat $tmpfile`;
28 $results =~ s/\n+$//;
29 $expected =~ s/\n+$//;
30 if ( $results ne $expected){
31 print STDERR "PROG: $switch\n$prog\n";
32 print STDERR "EXPECTED:\n$expected\n";
33 print STDERR "GOT:\n$results\n";
34 print "not ";
35 }
36 print "ok ", ++$i, "\n";
37}
38
39__END__
2ace3117
CS
40()=()
41########
36477c24
PP
42$cusp = ~0 ^ (~0 >> 1);
43$, = " ";
44print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n";
45EXPECT
467 0 0 1 !
47########
a0d0e21e
LW
48$foo=undef; $foo->go;
49EXPECT
50Can't call method "go" without a package or object reference at - line 1.
51########
52BEGIN
53 {
54 "foo";
55 }
56########
a0d0e21e
LW
57$array[128]=1
58########
59$x=0x0eabcd; print $x->ref;
60EXPECT
61Can't call method "ref" without a package or object reference at - line 1.
62########
63chop ($str .= <STDIN>);
64########
65close ($banana);
66########
67$x=2;$y=3;$x<$y ? $x : $y += 23;print $x;
68EXPECT
6925
70########
71eval {sub bar {print "In bar";}}
72########
73system "./perl -ne 'print if eof' /dev/null"
74########
75chop($file = <>);
76########
77package N;
78sub new {my ($obj,$n)=@_; bless \$n}
79$aa=new N 1;
80$aa=12345;
81print $aa;
82EXPECT
8312345
84########
85%@x=0;
86EXPECT
87Can't coerce HASH to string in repeat at - line 1.
88########
89$_="foo";
90printf(STDOUT "%s\n", $_);
91EXPECT
92foo
93########
94push(@a, 1, 2, 3,)
95########
96quotemeta ""
97########
98for ("ABCDE") {
99 &sub;
100s/./&sub($&)/eg;
101print;}
102sub sub {local($_) = @_;
103$_ x 4;}
104EXPECT
105Modification of a read-only value attempted at - line 3.
106########
107package FOO;sub new {bless {FOO => BAR}};
108package main;
109use strict vars;
110my $self = new FOO;
111print $$self{FOO};
112EXPECT
113BAR
114########
115$_="foo";
116s/.{1}//s;
117print;
118EXPECT
119oo
120########
121print scalar ("foo","bar")
122EXPECT
123bar
124########
125sub by_number { $a <=> $b; };# inline function for sort below
126$as_ary{0}="a0";
127@ordered_array=sort by_number keys(%as_ary);
128########
129sub NewShell
130{
131 local($Host) = @_;
132 my($m2) = $#Shells++;
133 $Shells[$m2]{HOST} = $Host;
134 return $m2;
135}
136
137sub ShowShell
138{
139 local($i) = @_;
140}
141
142&ShowShell(&NewShell(beach,Work,"+0+0"));
143&ShowShell(&NewShell(beach,Work,"+0+0"));
144&ShowShell(&NewShell(beach,Work,"+0+0"));
145########
146 {
147 package FAKEARRAY;
148
149 sub TIEARRAY
150 { print "TIEARRAY @_\n";
151 die "bomb out\n" unless $count ++ ;
152 bless ['foo']
153 }
154 sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] }
155 sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] }
156 sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; }
157 }
158
159eval 'tie @h, FAKEARRAY, fred' ;
160tie @h, FAKEARRAY, fred ;
161EXPECT
162TIEARRAY FAKEARRAY fred
163TIEARRAY FAKEARRAY fred
164DESTROY
165########
166BEGIN { die "phooey\n" }
167EXPECT
168phooey
169BEGIN failed--compilation aborted at - line 1.
170########
171BEGIN { 1/$zero }
172EXPECT
173Illegal division by zero at - line 1.
174BEGIN failed--compilation aborted at - line 1.
175########
176BEGIN { undef = 0 }
177EXPECT
178Modification of a read-only value attempted at - line 1.
179BEGIN failed--compilation aborted at - line 1.
a7adf1f0
PP
180########
181{
182 package foo;
183 sub PRINT {
184 shift;
185 print join(' ', reverse @_)."\n";
186 }
187 sub TIEHANDLE {
188 bless {}, shift;
189 }
58f51617
SV
190 sub READLINE {
191 "Out of inspiration";
192 }
a7adf1f0
PP
193 sub DESTROY {
194 print "and destroyed as well\n";
195 }
196}
197{
198 local(*FOO);
199 tie(*FOO,'foo');
200 print FOO "sentence.", "reversed", "a", "is", "This";
58f51617 201 print "-- ", <FOO>, " --\n";
a7adf1f0
PP
202}
203EXPECT
204This is a reversed sentence.
58f51617 205-- Out of inspiration --
a7adf1f0 206and destroyed as well
a6006777
PP
207########
208my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n"
209EXPECT
2102 2 2
211########
212@a = ($a, $b, $c, $d) = (5, 6);
213print "ok\n"
214 if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]);
215EXPECT
216ok
217########
218print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000);
219EXPECT
220ok
221########
8ebc5c01 222print "ok\n" if ("\0" lt "\xFF");
a6006777
PP
223EXPECT
224ok
225########
226open(H,'op/misc.t'); # must be in the 't' directory
227stat(H);
228print "ok\n" if (-e _ and -f _ and -r _);
229EXPECT
230ok
231########
232sub thing { 0 || return qw(now is the time) }
233print thing(), "\n";
234EXPECT
235nowisthetime
236########
237$ren = 'joy';
238$stimpy = 'happy';
239{ local $main::{ren} = *stimpy; print $ren, ' ' }
240print $ren, "\n";
241EXPECT
242happy joy
243########
244$stimpy = 'happy';
245{ local $main::{ren} = *stimpy; print ${'ren'}, ' ' }
246print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n";
247EXPECT
248happy joy
249########
250package p;
251sub func { print 'really ' unless wantarray; 'p' }
252sub groovy { 'groovy' }
253package main;
254print p::func()->groovy(), "\n"
255EXPECT
256really groovy
257########