Make sure role group delegates .WHY to its default candidate

This required to remove tests which were testing for `Role.WHY` returning `Nil`. But as was suggested in this comment: rakudo/rakudo#3549 (comment) the tests were needed to ensure that a documentation comment is attached to a particular parametric role, not to its group. But since rakudo/rakudo#3549 makes `.WHY` delegate to the default candidate, these tests doesn't make sense anymore. Instead why-both.t now makes sure what we get from a role group is the same object we get from the default candidate. Alongside with the essential changes, also unified all tests with regard to use of idential test assertion subs. They all now are `subtest` based.
Raku · Feb 11, 2022 · 1a2fc4a · 1a2fc4a
1 parent d3af368
commit 1a2fc4a
Show file tree

Hide file tree

Showing 5 changed files with 62 additions and 52 deletions.
diff --git a/S26-documentation/block-leading.t b/S26-documentation/block-leading.t
@@ -1,24 +1,26 @@
 use v6.d;
 use Test;
-plan 335;
+plan 64;
 
 my $pod_index = 0;
 
 # Test that we get the values we expect from WHY.contents, WHY.leading,
 # WHY.trailing, and that WHY.WHEREFORE is the appropriate thing
 # Also checks the $=pod object is set appropriately.
-# XXX we need to be able to affect the test level (like Test::Builder::Level
-#     in Perl 5) so that failures point at the caller
-sub test-leading($thing, $value) {
-    is $thing.WHY.?contents, $value, $value  ~ ' - contents';
-    is $thing.WHY.?WHEREFORE.^name, $thing.^name, $value ~ ' - WHEREFORE';
-    is $thing.WHY.?leading, $value, $value ~ ' - leading';
-    ok !$thing.WHY.?trailing.defined, $value ~ ' - no trailing';
-    is ~$thing.WHY, $value, $value ~ ' - stringifies correctly';
-
-    is $=pod[$pod_index].?WHEREFORE.^name,$thing.^name, "\$=pod $value - WHEREFORE";
-    is ~$=pod[$pod_index], $value, "\$=pod $value";
-    $pod_index++;
+#?DOES 1
+sub test-leading($thing, $value) is test-assertion {
+    subtest $thing.^name => {
+        plan 7;
+        is $thing.WHY.?contents, $value, $value  ~ ' - contents';
+        is $thing.WHY.?WHEREFORE.^name, $thing.^name, $value ~ ' - WHEREFORE';
+        is $thing.WHY.?leading, $value, $value ~ ' - leading';
+        ok !$thing.WHY.?trailing.defined, $value ~ ' - no trailing';
+        is ~$thing.WHY, $value, $value ~ ' - stringifies correctly';
+
+        is $=pod[$pod_index].?WHEREFORE.^name,$thing.^name, "\$=pod $value - WHEREFORE";
+        is ~$=pod[$pod_index], $value, "\$=pod $value";
+        $pod_index++;
+    }
 }
 
 
@@ -192,7 +194,6 @@ role Boxer {
 
 {
     my $method = Boxer.^lookup('actor');
-    ok !Boxer.WHY.defined, q{Role group's WHY should not be defined};
     test-leading(Boxer.HOW.candidates(Boxer)[0], 'Are you talking to me?');
     test-leading($method, 'Robert De Niro');
 }

diff --git a/S26-documentation/block-trailing.t b/S26-documentation/block-trailing.t
@@ -1,12 +1,12 @@
 use v6.d;
 use Test;
-plan 52;
+plan 51;
 
 my $pod_index = 0;
 
 #?DOES 1
-sub test-trailing($thing, $value) {
-    subtest $thing.^name, {
+sub test-trailing($thing, $value) is test-assertion {
+    subtest $thing.^name => {
         plan 7;
         is $thing.WHY.?contents, $value, $value  ~ ' - contents';
         is $thing.WHY.?WHEREFORE.^name, $thing.^name, $value ~ ' - WHEREFORE';
@@ -189,7 +189,6 @@ role Boxer {
 
 {
     my $method = Boxer.^lookup('actor');
-    ok !Boxer.WHY.defined, q{Role group's WHY should not be defined};
     test-trailing(Boxer.HOW.candidates(Boxer)[0], 'Are you talking to me?');
     test-trailing($method, 'Robert De Niro');
 }

diff --git a/S26-documentation/why-both.t b/S26-documentation/why-both.t
@@ -1,22 +1,26 @@
 use v6.d;
 use Test;
-plan 291;
+plan 58;
 
 my $pod_index = 0;
 
-sub test-both($thing, $leading, $trailing) {
-    my $combined = "$leading\n$trailing";
-    my $name     = "$leading\\n$trailing";
-
-    is $thing.WHY.?contents, $combined, $name  ~ ' - contents';
-    is $thing.WHY.?WHEREFORE.^name, $thing.^name, $name ~ ' - WHEREFORE';
-    is $thing.WHY.?leading, $leading, $name ~ ' - trailing';
-    is $thing.WHY.?trailing, $trailing, $name ~ ' - trailing';
-    is ~$thing.WHY, $combined, $name ~ ' - stringifies correctly';
-
-    is $=pod[$pod_index].?WHEREFORE.^name, $thing.^name, "\$=pod $name - WHEREFORE";
-    is ~$=pod[$pod_index], $combined, "\$=pod $name";
-    $pod_index++;
+#?DOES 1
+sub test-both($thing, $leading, $trailing) is test-assertion {
+    subtest $thing.^name => {
+        plan 7;
+        my $combined = "$leading\n$trailing";
+        my $name     = "$leading\\n$trailing";
+
+        is $thing.WHY.?contents, $combined, $name  ~ ' - contents';
+        is $thing.WHY.?WHEREFORE.^name, $thing.^name, $name ~ ' - WHEREFORE';
+        is $thing.WHY.?leading, $leading, $name ~ ' - trailing';
+        is $thing.WHY.?trailing, $trailing, $name ~ ' - trailing';
+        is ~$thing.WHY, $combined, $name ~ ' - stringifies correctly';
+
+        is $=pod[$pod_index].?WHEREFORE.^name, $thing.^name, "\$=pod $name - WHEREFORE";
+        is ~$=pod[$pod_index], $combined, "\$=pod $name";
+        $pod_index++;
+    }
 }
 
 #| simple case
@@ -74,7 +78,7 @@ my $roar-method = Sheep.^lookup('roar');
 
 test-both($roar-method, 'not too scary', '...unless you fear sheep!');
 
-#| trailing space here  
+#| trailing space here
 sub third {}
 #=    leading space here
 
@@ -141,11 +145,17 @@ role Boxer {
     #= he's an actor
 }
 
+#| I'm not talkative
+role Boxer[::T] {
+#= and this is OK
+}
+
 {
     my $method = Boxer.^lookup('actor');
-    ok !Boxer.WHY.defined, q{Role group's WHY should not be defined};
     test-both(Boxer.HOW.candidates(Boxer)[0], 'Are you talking to me?', 'I said, are you talking to me?');
+    ok Boxer.WHY =:= Boxer.^candidates[0].WHY, q{Role group's WHY is the one of its default candidate};
     test-both($method, 'Robert De Niro', q{he's an actor});
+    test-both(Boxer.HOW.candidates(Boxer)[1], q{I'm not talkative}, q{and this is OK});
 }
 
 class C {

diff --git a/S26-documentation/why-leading.t b/S26-documentation/why-leading.t
@@ -1,24 +1,26 @@
 use v6.d;
 use Test;
-plan 355;
+plan 66;
 
 my $pod_index = 0;
 
 # Test that we get the values we expect from WHY.contents, WHY.leading,
 # WHY.trailing, and that WHY.WHEREFORE is the appropriate thing
 # Also checks the $=pod object is set appropriately.
-# XXX we need to be able to affect the test level (like Test::Builder::Level
-#     in Perl 5) so that failures point at the caller
-sub test-leading($thing, $value) {
-    is $thing.WHY.?contents, $value, $value  ~ ' - contents';
-    is $thing.WHY.?WHEREFORE.^name, $thing.^name, $value ~ ' - WHEREFORE';
-    is $thing.WHY.?leading, $value, $value ~ ' - leading';
-    ok !$thing.WHY.?trailing.defined, $value ~ ' - no trailing';
-    is ~$thing.WHY, $value, $value ~ ' - stringifies correctly';
-
-    is $=pod[$pod_index].?WHEREFORE.^name, $thing.^name, "\$=pod $value - WHEREFORE";
-    is ~$=pod[$pod_index], $value, "\$=pod $value";
-    $pod_index++;
+#?DOES 1
+sub test-leading($thing, $value) is test-assertion {
+    subtest $thing.^name => {
+        plan 7;
+        is $thing.WHY.?contents, $value, $value  ~ ' - contents';
+        is $thing.WHY.?WHEREFORE.^name, $thing.^name, $value ~ ' - WHEREFORE';
+        is $thing.WHY.?leading, $value, $value ~ ' - leading';
+        ok !$thing.WHY.?trailing.defined, $value ~ ' - no trailing';
+        is ~$thing.WHY, $value, $value ~ ' - stringifies correctly';
+
+        is $=pod[$pod_index].?WHEREFORE.^name, $thing.^name, "\$=pod $value - WHEREFORE";
+        is ~$=pod[$pod_index], $value, "\$=pod $value";
+        $pod_index++;
+    }
 }
 
 
@@ -184,7 +186,6 @@ role Boxer {
 
 {
     my $method = Boxer.^lookup('actor');
-    ok !Boxer.WHY.defined, q{Role group's WHY should not be defined};
     test-leading(Boxer.HOW.candidates(Boxer)[0], 'Are you talking to me?');
     test-leading($method, 'Robert De Niro');
 }

diff --git a/S26-documentation/why-trailing.t b/S26-documentation/why-trailing.t
@@ -1,12 +1,12 @@
 use v6.d;
 use Test;
-plan 55;
+plan 54;
 
 my $pod_index = 0;
 
 #?DOES 1
-sub test-trailing($thing, $value) {
-    subtest $thing.^name, {
+sub test-trailing($thing, $value) is test-assertion {
+    subtest $thing.^name => {
         plan 7;
         is $thing.WHY.?contents, $value, $value  ~ ' - contents';
         is $thing.WHY.?WHEREFORE.^name, $thing.^name, $value ~ ' - WHEREFORE';
@@ -181,7 +181,6 @@ role Boxer {
 
 {
     my $method = Boxer.^lookup('actor');
-    ok !Boxer.WHY.defined, q{Role group's WHY should not be defined};
     test-trailing(Boxer.HOW.candidates(Boxer)[0], 'Are you talking to me?');
     test-trailing($method, 'Robert De Niro');
 }