X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Farray.t;h=1108f494f84449a69c49dc33e5004b3465b43642;hb=6b8eaf932222db04db65aff99717b9c1dbd0a692;hp=f307655cedccdc9f61461efdf765a080095a2f8a;hpb=c6aa4a325f8f7aec03423575f368826bb1e2b038;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/array.t b/t/op/array.t index f307655..1108f49 100755 --- a/t/op/array.t +++ b/t/op/array.t @@ -1,8 +1,10 @@ #!./perl -# $RCSfile: array.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:37 $ +print "1..66\n"; -print "1..40\n"; +# +# @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them +# @ary = (1,2,3,4,5); if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";} @@ -119,32 +121,98 @@ print $foo eq 'e' ? "ok 35\n" : "not ok 35\n"; $foo = ('a','b','c','d','e','f')[1]; print $foo eq 'b' ? "ok 36\n" : "not ok 36\n"; -# Test pseudo-hashes and %FIELDS. Real programs would "use fields..." -# but we assign to %FIELDS manually since the real module tests come later. +@foo = ( 'foo', 'bar', 'burbl'); +push(foo, 'blah'); +print $#foo == 3 ? "ok 37\n" : "not ok 37\n"; + +# various AASSIGN_COMMON checks (see newASSIGNOP() in op.c) + +$test = 37; +sub t { ++$test; print "not " unless $_[0]; print "ok $test\n"; } + +@foo = @foo; +t("@foo" eq "foo bar burbl blah"); # 38 + +(undef,@foo) = @foo; +t("@foo" eq "bar burbl blah"); # 39 + +@foo = ('XXX',@foo, 'YYY'); +t("@foo" eq "XXX bar burbl blah YYY"); # 40 + +@foo = @foo = qw(foo bar burbl blah); +t("@foo" eq "foo bar burbl blah"); # 41 + +@bar = @foo = qw(foo bar); # 42 +t("@foo" eq "foo bar"); +t("@bar" eq "foo bar"); # 43 + +# try the same with local +# XXX tie-stdarray fails the tests involving local, so we use +# different variable names to escape the 'tie' -BEGIN { - %Base::WithFields::FIELDS = (foo => 1, bar => 2, baz => 3, __MAX__ => 3); - %OtherBase::WithFields::FIELDS = (one => 1, two => 2, __MAX__ => 2); +@bee = ( 'foo', 'bar', 'burbl', 'blah'); +{ + + local @bee = @bee; + t("@bee" eq "foo bar burbl blah"); # 44 + { + local (undef,@bee) = @bee; + t("@bee" eq "bar burbl blah"); # 45 + { + local @bee = ('XXX',@bee,'YYY'); + t("@bee" eq "XXX bar burbl blah YYY"); # 46 + { + local @bee = local(@bee) = qw(foo bar burbl blah); + t("@bee" eq "foo bar burbl blah"); # 47 + { + local (@bim) = local(@bee) = qw(foo bar); + t("@bee" eq "foo bar"); # 48 + t("@bim" eq "foo bar"); # 49 + } + t("@bee" eq "foo bar burbl blah"); # 50 + } + t("@bee" eq "XXX bar burbl blah YYY"); # 51 + } + t("@bee" eq "bar burbl blah"); # 52 + } + t("@bee" eq "foo bar burbl blah"); # 53 } + +# try the same with my { - package Base::WithoutFields; + + my @bee = @bee; + t("@bee" eq "foo bar burbl blah"); # 54 + { + my (undef,@bee) = @bee; + t("@bee" eq "bar burbl blah"); # 55 + { + my @bee = ('XXX',@bee,'YYY'); + t("@bee" eq "XXX bar burbl blah YYY"); # 56 + { + my @bee = my @bee = qw(foo bar burbl blah); + t("@bee" eq "foo bar burbl blah"); # 57 + { + my (@bim) = my(@bee) = qw(foo bar); + t("@bee" eq "foo bar"); # 58 + t("@bim" eq "foo bar"); # 59 + } + t("@bee" eq "foo bar burbl blah"); # 60 + } + t("@bee" eq "XXX bar burbl blah YYY"); # 61 + } + t("@bee" eq "bar burbl blah"); # 62 + } + t("@bee" eq "foo bar burbl blah"); # 63 } -@ISA = qw(Base::WithoutFields Base::WithFields); -@k = sort keys %FIELDS; -print "not " unless "@k" eq "__MAX__ bar baz foo"; -print "ok 37\n"; -eval { - @ISA = 'OtherBase::WithFields'; -}; -print "not " unless $@ =~ /Inherited %FIELDS can't override existing %FIELDS/; -print "ok 38\n"; -undef %FIELDS; -eval { - @ISA = qw(Base::WithFields OtherBase::WithFields); -}; -print "not " unless $@ =~ /Can't multiply inherit %FIELDS/; -print "ok 39\n"; -@foo = ( 'foo', 'bar', 'burbl'); -push(foo, 'blah'); -print $#foo == 3 ? "ok 40\n" : "not ok 40\n"; +# make sure reification behaves +my $t = 63; +sub reify { $_[1] = ++$t; print "@_\n"; } +reify('ok'); +reify('ok'); + +# qw() is no more a runtime split, it's compiletime. +print "not " unless qw(foo bar snorfle)[2] eq 'snorfle'; +print "ok 66\n"; +