view release on metacpan or  search on metacpan

t/junction/misc_junctions.t  view on Meta::CPAN

    
    $b = 'a';
    
    {
        my $one_of_them = $b ^ $c ^ $a;
        ok('a' ne $one_of_them, 'junction variable of ($b ^ $c ^ $a) matches at more than one "a"');              
    }
    
    $b = 'b';
    $c = 'c';
    
    {
        my $one_of_them = $b ^ $c ^ $a;    
        ok('a' eq $one_of_them, 'junction of ($b ^ $c ^ $a) matches at ~only~ one "a"');
        ok('b' eq $one_of_them, 'junction of ($a ^ $b ^ $c) matches at ~only~ one "b"');
        ok('c' eq $one_of_them, 'junction of ($c ^ $a ^ $b) matches at ~only~ one "c"');  
    }

    {
        my $any_of_them = $b | $c | $a;
        ok('a' eq $any_of_them, 'junction of ($b | $c | $a) matches at least one "a"');
        ok('b' eq $any_of_them, 'junction of ($a | $b | $c) matches at least one "b"');
        ok('c' eq $any_of_them, 'junction of ($c | $a | $b) matches at least one "c"'); 
    }

}

{
    my $j = 1 | 2;
    $j = 5;
    is($j, 5, 'reassignment of junction variable');
}

{
    my ($j,$k,$l);

    $j = 1|2;
    is(WHAT($j),'Junction', 'basic junction type reference test');

    $k=$j;
    is(WHAT($k),'Junction', 'assignment preserves reference');

    # XXX does this next one make any sense?
    $l=\$j;
    is(WHAT($l),'Junction', 'hard reference to junction');
}


=pod

Tests junction examples from Synopsis 03 

j() is used to convert a junction to canonical string form, currently
just using .perl until a better approach presents itself.

L<S03/"Junctive operators">

=cut

# Canonical stringification of a junction
sub j (Junction $j) { return $j.perl }

{
    # L<S03/"Junctive operators" /They thread through operations/>
    my ($got, $want);
    $got = ((1|2|3)+4);
    $want = (5|6|7);
    is( j($got), j($want), 'thread + returning junctive result');

    $got = ((1|2) + (3&4));
    $want = ((4|5) & (5|6));
    is( j($got), j($want), 'thread + returning junctive combination of results');

    # L<S03/"Junctive operators" /This opens doors for constructions like/>
    # unless $roll == any(1..6) { print "Invalid roll" }
    my ($roll, $note);
    $roll = 3; $note = '';
    unless $roll == any(1..6) { $note = "Invalid roll"; };
    is($note, "", 'any() junction threading ==');

    $roll = 7; $note = '';
    unless $roll == any(1..6) { $note = "Invalid roll"; };
    is($note, "Invalid roll", 'any() junction threading ==');

    # if $roll == 1|2|3 { print "Low roll" }
    $roll = 4; $note = '';
    if $roll == 1|2|3 { $note = "Low roll" }
    is($note, "", '| junction threading ==');

    $roll = 2; $note = '';
    if $roll == 1|2|3 { $note = "Low roll" }
    is($note, "Low roll", '| junction threading ==');


    # L<S03/"Junctive operators" /Junctions work through subscripting/>
    my ($got, @foo);
    $got = ''; @foo = ();
    $got ~= 'y' if try { @foo[any(1,2,3)] };
    is($got, '', "junctions work through subscripting, 0 matches");

    $got = ''; @foo = (0,1);
    $got ~= 'y' if try { @foo[any(1,2,3)] };
    is($got, '', "junctions work through subscripting, 1 match");

    $got = ''; @foo = (1,1,1);
    $got ~= 'y' if try { @foo[any(1,2,3)] };
    is($got, '', "junctions work through subscripting, 3 matches");


    # L<S03/"Junctive operators" /Junctions are specifically unordered/>
    # Compiler *can* reorder and parallelize but *may not* so don't test
    # for all(@foo) {...};  

    # Not sure what is expected
    #my %got = ('1' => 1); # Hashes are unordered too
    #@foo = (2,3,4);
    #for all(@foo) { %got{$_} = 1; };
    #is( %got.keys.sort.join(','), '1,2,3,4',
    #    'for all(...) { ...} as parallelizable');
}