Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: b27262e7e8
Fetching contributors…

Cannot retrieve contributors at this time

file 63 lines (53 sloc) 2.075 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
use v6;
use Test;

plan 14;

=begin pod

Tests for lexical classes delcared with 'my class'

=end pod

# L<S12/Classes>

# A few basic tests.
eval_lives_ok 'my class A {}', 'my class parses OK';
eval_lives_ok '{ my class B {} }; { my class B {} }',
              'declare classes with the same name in two scopes.';
eval_lives_ok '{ my class B {}; B.new; }',
              'can instantiate lexical class';
#?pugs todo
eval_dies_ok '{ my class B {}; B.new; }; B.new',
              'scope is correctly restricted';

{
    my class WeissBier {
        has $.name;
        method describe() { 'outstanding flavour' }
    }
    my $pint = WeissBier.new(name => 'Erdinger');
    ok $pint ~~ WeissBier, 'can smart-match against lexical class';
    is $pint.name, 'Erdinger', 'attribute in lexical class works';
    is $pint.describe, 'outstanding flavour', 'method call on lexical class works';
    is WeissBier.gist, 'WeissBier()', 'lexical type object stringifies correct';

    my class LessThanAmazingWeissBier is WeissBier {
        method describe() { 'tastes like sweetcorn' }
    }
    ok LessThanAmazingWeissBier ~~ WeissBier, 'inehritance between lexical classes works';
    my $ltapint = LessThanAmazingWeissBier.new(name => 'Baltika 7');
    ok $ltapint ~~ LessThanAmazingWeissBier, 'can smart-match class that inherits';
    ok $ltapint ~~ WeissBier, 'can smart-match against parent class too';
    is $ltapint.describe, 'tastes like sweetcorn', 'can call overridden method';
    is $ltapint.name, 'Baltika 7', 'can call inherited method that accesses inherited attribute';
}

# RT #69316
#?pugs skip 'bless'
{
    class Forest {
        class Frog {
            method speak { "ribbit ribbit" }
        };
        has Frog $.frog;
        method new() {
            my Frog $frog .= new;
            self.bless(*, :$frog);
        };
    }
    is Forest.new.frog.speak, 'ribbit ribbit',
        'can construct objects of inner class in outer constructor';
}

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