Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 84b3895ce1
Fetching contributors…

Cannot retrieve contributors at this time

file 367 lines (287 sloc) 10.046 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367
use v6;
use Test;
#?pugs emit #
BEGIN { @*INC.push('t/spec/packages/') };
#?pugs emit #
use Test::Util;

=begin pod

'Mu' and 'undefine' tests

This test file contains two sections: a port of the perl5 'undef.t' tests, and
perl6-specific tests.

=end pod

# Note: See thread "Undef issues" by Adrian Taylor on p6l
# L<http://groups.google.com/groups?threadm=20050601002444.GB32060@wall.org>
# On Tue, May 24, 2005 at 10:53:59PM +1000, Stuart Cook wrote:
# : I'm not sure whether this behaviour is supposed to be changing.
#
# It is. I think we decided to make the value undef, and the function
# undefine(). (But these days most values of undef really ought to
# be constructed and returned (or thrown) using fail().)
#
# Larry

plan 86;

our $GLOBAL;

# L<S32::Basics/Mu/=item defined>

ok(!defined(Mu), "Mu is not defined");

{
    my $a;
    ok(!defined($a), "uninitialized lexicals are undefined");

    ok(!defined($GLOBAL), "uninitialized package vars are undefined");

    $a += 1;
    ok(defined($a), "initialized var is defined");
    #?niecza todo
    #?pugs skip 'is_run'
    is_run( 'my $a; $a += 1', { err => '', out => '', status => 0 },
            'increment of undefined variable does not warn' );

    undefine $a;
    ok(!defined($a), "undefine($a) does");

    $a = "hi";
    ok(defined($a), "string");

    my $b;
    $a = $b;
    ok(!defined($a), "assigning another undefined lexical");

    $a = $GLOBAL;
    ok(!defined($a), "assigning another undefined global");
}

# L<S32::Basics/Mu/"=item undefine">
{
    my @ary = "arg1";
    my $a = @ary.pop;
    ok(defined($a), "pop from array");
    $a = @ary.pop;
    ok(!defined($a), "pop from empty array");

    @ary = "arg1";
    $a = @ary.shift;
    ok(defined($a), "shift from array");
    $a = @ary.shift;
    ok(!defined($a), "shift from empty array");

    my %hash = ( bar => 'baz', quux => 'quuz' );
    ok(defined(%hash<bar>), "hash subscript");
    ok(!defined(%hash<bargho>), "non-existent hash subscript");

    undefine %hash<bar>;
    ok(!defined(%hash<bar>), "undefine hash subscript");

    %hash<bar> = "baz";
    %hash.delete("bar");
    ok(!defined(%hash<bar>), "delete hash subscript");

    ok(defined(@ary), "aggregate array defined");
    ok(defined(%hash), "aggregate hash defined");

    undefine(@ary);
#?pugs todo 'bug'
#?rakudo todo 'definedness of array'
#?niecza todo 'definedness of array'
    ok(!defined(@ary), "undefine array");

    #?rakudo emit #
    #?niecza emit #
    undefine(%hash);
#?pugs todo 'bug'
#?rakudo todo 'definedness of hash'
#?niecza todo 'definedness of hash'
    ok(!defined(%hash), "undefine hash");

    @ary = (1);
    ok(defined(@ary), "define array again");
    %hash = (1,1);
    ok(defined(%hash), "define hash again");
}

#?rakudo skip 'access to &your_sub'
#?niecza skip 'huh?'
{
    sub a_sub { "møøse" }

    ok(defined(&a_sub), "defined sub");
#?pugs todo 'parsefail'
    ok(eval('defined(%«$?PACKAGE\::»<&a_sub>)'), "defined sub (symbol table)");

#?pugs todo 'feature'
    ok(eval('!defined(&a_subwoofer)'), "undefined sub");
#?pugs todo 'feature'
    ok(eval('!defined(%«$?PACKAGE\::»<&a_subwoofer>)'), "undefined sub (symbol table)");
    
    dies_ok { undefine &a_sub }, 'die trying to undefine a sub';
    ok defined &a_sub, 'sub is still defined after attempt to undefine';
}

# TODO: find a read-only value to try and assign to, since we don't
# have rules right now to play around with (the p5 version used $1)
#eval { "constant" = "something else"; };
#is($!, "Modification of a read", "readonly write yields exception");

# skipped tests for tied things

# skipped test for attempt to undef a bareword -- no barewords here.

# TODO: p5 "bugid 3096
# undefing a hash may free objects with destructors that then try to
# modify the hash. To them, the hash should appear empty."


# Test LHS assignment to undef:
# XXX shouldn't that be * instead of undef?
# yes, this chunk should move to a different file --Larry

#?pugs skip "Can't modify constant item: VNum Infinity"
{
    my $interesting;
    (*, *, $interesting) = (1,2,3);
    is($interesting, 3, "Undef on LHS of list assignment");

    (*, $interesting, *) = (1,2,3);
    is($interesting, 2, "Undef on LHS of list assignment");

    ($interesting, *, *) = (1,2,3);
    is($interesting, 1, "Undef on LHS of list assignment");

    sub two_elements() { (1,2) };
    (*,$interesting) = two_elements();
    is($interesting, 2, "Undef on LHS of function assignment");

    ($interesting, *) = two_elements();
    is($interesting, 1, "Undef on LHS of function assignment");
}

=begin pod

Perl6-specific tests

=end pod

#?rakudo skip 'fun with undefine'
#?niecza skip 'fun with undefine'
{
    # aggregate references

    my @ary = (<a b c d e>);
    my $ary_r = @ary; # ref
    isa_ok($ary_r, Array);
    ok(defined($ary_r), "array reference");

    undefine @ary;
    #?pugs todo
    ok(!+$ary_r, "undefine array referent");

    #?pugs todo
    is(+$ary_r, 0, "dangling array reference");

    my %hash = (1, 2, 3, 4);
    my $hash_r = %hash;
    #?pugs todo
    isa_ok($hash_r, "Hash");
    ok(defined($hash_r), "hash reference");
    undefine %hash;
    ok(defined($hash_r), "undefine hash referent:");
    #?pugs todo
    is(+$hash_r.keys, 0, "dangling hash reference");
}

#?rakudo skip 'autovivification'
#?niecza skip 'push does not vivify'
{
    my Array $an_ary;
    ok(!defined($an_ary), "my Array");
    nok( defined($an_ary[0]) , "my Array subscript - Mu");
    $an_ary.push("blergh");
    ok(defined($an_ary.pop), "push");
    nok(defined($an_ary.pop), "comes to shove");
}

#?rakudo skip 'Autovivify hashes'
{
    my Hash $a_hash;

    nok(defined($a_hash), "my Hash");
    nok(defined($a_hash<blergh>), "my Hash subscript - Mu");
    nok(defined($a_hash<blergh>), "my Hash subscript - Mu, no autovivification happened");

    $a_hash<blergh> = 1;
    ok(defined($a_hash.delete('blergh')), "delete");
    nok(defined($a_hash.delete("blergh")), " - once only");
}


{
    class Dog {};
    my Dog $spot;

    ok(!defined($spot), "Unelaborated mutt");
    $spot .= new;
    ok(defined($spot), " - now real");
}

# rules
# TODO. refer to S05
# L<S05/Match objects/"they will all be undefined" closure
# "let keyword">

# - unmatched alternative should bind to undef
#?rakudo skip 'null PMC access in type()'
#?niecza skip 'unspeclike use of %MY::'
#?DOES 10
{
    my ($num, $alpha);
    my ($rx1, $rx2); #OK not used
    eval '
$rx1 = rx
/ [ (\d+) { let $<num> := $0 }
| (<alpha>+) { let $<alpha> := $1 }
]
/;
$rx2 = rx
/ [ $<num> := (\d+)
| $<alpha>:= (<alpha>+)
]
/;
';
    for (<rx1 rx2>) {
        # I want symbolic lookups because I need the rx names for test results.

        eval '"1" ~~ %MY::{$_}';
    #?pugs todo 'unimpl'
        ok(defined($num), '{$_}: successful hypothetical');
        ok(!defined($alpha), '{$_}: failed hypothetical');

        eval '"A" ~~ %MY::{$_}';
        ok(!defined($num), '{$_}: failed hypothetical (2nd go)');
    #?pugs todo 'unimpl'
        ok(defined($alpha), '{$_}: successful hypothetical (2nd go)');
    }

    # - binding to hash keys only would leave values undefined
    eval '"a=b\nc=d\n" ~~ / $<matches> := [ (\w) = \N+ ]* /';
    #?pugs todo 'unimpl'
    ok(eval('$<matches> ~~ all(<a b>)'), "match keys exist");

    #ok(!defined($<matches><a>) && !defined($<matches><b>), "match values don't");
    #?pugs todo 'unimpl'
    ok(0 , "match values don't");
}

#?DOES 1
{
    # - $0, $1 etc. should all be undefined after a failed match
    # (except for special circumstances)
        "abcde" ~~ /(.)(.)(.)/;
        "abcde" ~~ /(\d)/;
    ok((!try { grep { defined($_) }, ($0, $1, $2, $3, $4, $5) }),
            "all submatches undefined after failed match") or
        diag("match state: " ~ eval '$/');

    # XXX write me: "special circumstances"
}


# subroutines
{
    sub bar ($bar, $baz?, :$quux) {
        is($bar, "BAR", "defined param"); # sanity

        # L<S06/Optional parameters/Missing optional arguments>
        ok(!defined($baz), "unspecified optional param");

        # L<S06/Named parameters/Named parameters are optional>
        ok(!defined($quux), "unspecified optional param");
    }

    bar("BAR");

}

# autoloading
# L<S10/Autoloading>

# Currently waiting on
# - packages
# - symtable hash
# - autoloading itself

# Extra tests added due to apparent bugs
is((Any) + 1, 1, 'Any + 1');
is(1 + (Any), 1, '1 + Any');
is((Any) * 2, 0, 'Any * 2');
is(2 * (Any), 0, '2 * Any');
is((Any) xx 2, [Any, Any], 'Any xx 2');
is((Any) * (Any), 0, 'Any * Any');

# L<http://colabti.de/irclogger/irclogger_log/perl6?date=2006-09-12,Tue&sel=145#l186>
# See log above. From IRC, TimToady says that both of these
# should be false. (At time of writing, @(Mu,) is true.)
#?pugs todo 'feature', :depends<@() imposing context and not [] constructor>;
#?rakudo 2 skip 'todo: lists, defined, truthness'
#?niecza 2 todo 'huh?'
is ?(@(Mu,)), Bool::False, '?(@(Mu,)) is false';
is ?(list(Mu,)), Bool::False, '?(@(Mu,)) is false';

#?niecza todo 'dubious'
lives_ok { uc(eval("")) }, 'can use eval("") in further expressions';

{
    sub lie { Bool::False }
    ok lie() ~~ Bool, 'sub returns a bool';
    dies_ok { undefine lie }, 'attempt to undefine returned Bool type dies';
    ok lie() ~~ Bool, 'sub still returns a bool';
}

{
    sub def is rw { my $x = [] } #OK not used
    ok def() ~~ Array, 'sub returns array';
    lives_ok { undefine def }, 'attempt to undefine returned array lives';
    ok def() ~~ Array, 'sub still returns array';

    dies_ok { undefine &def }, 'attempt to undefine sub dies';
    ok defined(&def), 'attempt to undefine sub fails';
    ok def() ~~ Array, 'can still call sub after attempt to undefine it';
}

# RT #69238
{
    sub foo { my $a = "baz"; undefine $a; undefine $a; $a; }
    ok !defined(foo()), 'can undefine $a twice without any troubles';
}

done;

# vim: ft=perl6
Something went wrong with that request. Please try again.