Skip to content

Instantly share code, notes, and snippets.

@perlpilot
Created August 2, 2014 15:25
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save perlpilot/6bd0ce11b61cc886c532 to your computer and use it in GitHub Desktop.
Save perlpilot/6bd0ce11b61cc886c532 to your computer and use it in GitHub Desktop.
use Test;
plan 262;
my $pod_index = 0;
sub test-leading($thing, $value) {
is $thing.WHY.contents, $value, $value ~ ' - contents';
ok $thing.WHY.WHEREFORE === $thing, $value ~ ' - WHEREFORE';
is $thing.WHY.leading, $value, $value ~ ' - leading';
ok !$thing.WHY.trailing.defined, $value ~ ' - no trailing';
is ~$thing.WHY, $value, $value ~ ' - stringifies correctly';
ok $=pod[$pod_index].WHEREFORE === $thing, "\$=pod $value - WHEREFORE";
is ~$=pod[$pod_index], $value, "\$=pod $value";
$pod_index++;
}
#| simple case
class Simple {
}
test-leading(Simple, "simple case");
#| giraffe
class Outer {
#| zebra
class Inner {
}
}
test-leading(Outer, 'giraffe');
test-leading(Outer::Inner, 'zebra');
#| a module
module foo {
#| a package
package bar {
#| and a class
class baz {
}
}
}
test-leading(foo, 'a module');
test-leading(foo::bar, 'a module');
test-leading(foo::bar::baz, 'a module');
#| yellow
sub marine {}
test-leading(&marine, 'yellow');
#| pink
sub panther {}
test-leading(&panther, 'pink');
#| a sheep
class Sheep {
#| usually white
has $.wool;
#| not too scary
method roar { 'roar!' }
}
my $wool-attr = Sheep.^attributes.grep({ .name eq '$!wool' })[0];
my $roar-method = Sheep.^find_method('roar');
test-leading(Sheep,'a sheep');
test-leading($wool-attr, 'usually white');
test-leading($roar-method, 'not too scary');
sub routine {}
is &routine.WHY.defined, False;
#| our works too
our sub oursub {}
test-leading(&oursub, 'our works too');
# two subs in a row
#| one
sub one {}
#| two
sub two {}
test-leading(&one, 'one');
test-leading(&two, 'two');
#| that will break
sub first {}
#| that will break
sub second {}
test-leading(&first, "that will break");
test-leading(&second, "that will break");
#| trailing space here
sub third {}
test-leading(&third, "trailing space here");
sub has-parameter(
#| documented
Str $param
) {}
{
my @params = &has-parameter.signature.params;
test-leading(@params[0], 'documented');
}
sub has-two-params(
#| documented
Str $param,
Int $second
) {}
{
my @params = &has-parameter.signature.params;
test-leading(@params[0], 'documented');
ok !@params[1].WHY.defined, 'Second param should not be documented' or
diag(&params[1].WHY.contents);
}
sub both-documented(
#| documented
Str $param,
#| I too, am documented
Int $second
) {}
{
my @params = &both-documented.signature.params[0];
test-leading(@params[0], 'documented');
test-leading(@params[1], 'I too, am documented');
}
sub has-anon-param(
#| leading
Str $
) {}
{
my @params = &has-anon-param.signature.params;
test-leading(@params[0], 'leading');
}
class DoesntMatter {
method m(
#| invocant comment
::?CLASS $this:
$arg
) {}
}
{
my @params = DoesntMatter.^find_method('m').signature.params;
test-leading(@params[0], 'invocant comment');
}
#| Are you talking to me?
role Boxer {
#| Robert De Niro
method actor { }
}
{
my $method = Boxer.^find_method('actor');
test-leading( Boxer, 'Are you talking to me?');
test-leading($method, 'Are you talking to me?');
}
class C {
#| Bob
submethod BUILD { }
}
{
my $submethod = C.^find_method("BUILD");
test-leading($submethod, 'Bob');
}
#| grammar
grammar G {
#| rule
rule R { <?> }
#| token
token T { <?> }
#| regex
regex X { <?> }
}
{
my $rule = G.^find_method("R");
my $token = G.^find_method("T");
my $regex = G.^find_method("X");
test-leading(G, 'grammar');
test-leading($rule, 'rule');
test-leading($token, 'token');
test-leading($regex, 'regex');
}
#| solo
proto sub foo() { }
test-leading(&foo, 'solo');
#| no proto
multi sub bar() { }
test-leading(&bar, 'no proto');
#| variant A
multi sub baz() { }
#| variant B
multi sub baz(Int) { }
{
my @candidates = &baz.candidates;
test-leading(@candidates[0], 'variant A');
test-leading(@candidates[1], 'variant B');
}
#| proto
proto sub greeble {*}
#| alpha
multi sub greeble(Int) { }
#| beta
multi sub greeble(Str) { }
{
my @candidates = &greeble.candidates;
test-leading(&greeble, 'proto');
test-leading(@candidates[0], 'alpha');
test-leading(@candidates[1], 'beta');
}
is $=pod.elems, $pod_index;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment