Merge pull request #2812 from taboege/examples-compilation-memory

examples-compilation.t memory and code quality

Author: JJ

doc/Language/about.pod6

@@ -136,7 +136,7 @@ You can add emphasis with bold (B<V< B<> >>) or italicized (B<V< I<> >>),
 with or without code formatting (B<V< C<> >>).  Due to current parser limitations,
 special steps have to be taken to use B<V< X<> >> with other formatting codes; for example:
 
-=begin code
+=begin code :lang<pod6>
 =item X<B<foo>|foo> a fancy subroutine
 =end code
 

doc/Language/pod.pod6

@@ -12,7 +12,7 @@ Every Pod document has to begin with C<=begin pod> and end with C<=end pod>.
 Everything between these two delimiters will be processed and used to generate
 documentation.
 
-=begin code
+=begin code :lang<pod6>
 =begin pod
 
 A very simple Perl 6 Pod document
@@ -35,7 +35,7 @@ C<typename> of the block. Typenames that are entirely lowercase (for
 example: C<=begin head1>) or entirely uppercase (for example: C<=begin
 SYNOPSIS>) are reserved.
 
-=begin code
+=begin code :lang<pod6>
 =begin head1
 Top Level Heading
 =end head1
@@ -92,7 +92,7 @@ The C<=for> marker is followed by the C<typename> of the block
 plus, optionally, any configuration data as in the delimited
 blocks described above.
 
-=begin code
+=begin code :lang<pod6>
 =for head1
 Top Level Heading
 =end code
@@ -104,7 +104,7 @@ C<typename> of the block. All following data are part of the contents of the
 block, thus configuration data B<cannot> be specified for an I<abbreviated>
 block. The block ends at the next Pod directive or the first blank line.
 
-=begin code
+=begin code :lang<pod6>
 =head1 Top level heading
 =end code
 
@@ -178,7 +178,7 @@ Pod offers a wide range of standard block types.
 Headings can be defined using C<=headN>,
 where N is greater than zero (e.g., C<=head1>, C<=head2>, …).
 
-=begin code
+=begin code :lang<pod6>
 =head1 A top level heading
 
 =head2 A second level heading
@@ -222,7 +222,7 @@ Ordinary paragraphs do not require an explicit marker or delimiters.
 
 Alternatively, there is also an explicit C<=para> marker that can be used to explicitly mark a paragraph.
 
-=begin code
+=begin code :lang<pod6>
 =para
 This is an ordinary paragraph.
 Its text  will   be     squeezed     and
@@ -233,7 +233,7 @@ In addition, the longer C<=begin para> and C<=end para> form can be used.
 
 For example:
 
-=begin code
+=begin code :lang<pod6>
 
 =begin para
 This is an ordinary paragraph.
@@ -269,7 +269,7 @@ This ordinary paragraph introduces a code block:
 
 Code blocks can also be explicitly defined by enclosing them in C<=begin code> and C<=end code>
 
-=begin code
+=begin code :lang<pod6>
     =begin code
     my $name = 'John Doe';
     say $name;
@@ -313,7 +313,7 @@ The three suspects are:
 
 Lists that define terms or commands use C<=defn>, equivalent to the C<DL> lists in HTML
 
-=begin code
+=begin code :lang<pod6>
 =defn Happy
 When you're not blue.
 
@@ -337,7 +337,7 @@ Note that C<=item> is just an abbreviation for C<=item1>.
 
 For example:
 
-=begin code
+=begin code :lang<pod6>
 =item1  Animal
 =item2     Vertebrate
 =item2     Invertebrate
@@ -415,13 +415,13 @@ Pod comments are comments that Pod renderers ignore.
 
 Comments are useful for meta-documentation (documenting the documentation). Single-line comments use the C<comment> keyword:
 
-=begin code
+=begin code :lang<pod6>
 =comment Add more here about the algorithm
 =end code
 
 For multi-line comments use a delimited C<comment> block:
 
-=begin code
+=begin code :lang<pod6>
 =begin comment
 This comment is
 multi-line.
@@ -433,7 +433,7 @@ multi-line.
 All uppercase block typenames are reserved for specifying standard documentation,
 publishing, source components, or meta-information.
 
-=begin code
+=begin code :lang<pod6>
 =NAME
 =AUTHOR
 =VERSION
@@ -536,7 +536,7 @@ code itself.
 C<P<>> codes are handy for breaking out standard elements of
 your documentation set into reusable components that can then be
 incorporated directly into multiple documents. For example:
-=begin code
+=begin code :lang<pod6>
 =COPYRIGHT
 P<file:/shared/docs/std_copyright.pod>
 

xt/examples-compilation.t

@@ -33,52 +33,16 @@ Perl 6 level one.
 
 =end SYNOPSIS
 
-my @files = Test-Files.pods;
+plan +my @files = Test-Files.pods;
 
-sub walk($arg) {
-    given $arg {
-        when Pod::FormattingCode { walk $arg.contents }
-        when Str   { $arg }
-        when Array { $arg.map({walk $_}).join }
-    }
-}
-
-# Extract all the examples from the given files
 for @files -> $file {
-    my $counts = 0;
-    my @chunks = extract-pod($file.IO).contents;
-    while @chunks {
-        my $chunk = @chunks.pop;
-        if $chunk ~~ Pod::Block::Code  {
-            if $chunk.config<lang> && $chunk.config<lang> ne 'perl6' {
-                next; # Only testing Perl 6 snippets.
-            }
-            my $todo = False;
-            if $chunk.config<skip-test> {
-                %*ENV<P6_DOC_TEST_FUDGE> ?? ($todo = True) !! next;
-            }
-            check-chunk( %(
-                'contents',  $chunk.contents.map({walk $_}).join,
-                'file',      $file,
-                'count',     ++$counts,
-                'todo',      $todo,
-                'ok-test',   $chunk.config<ok-test> // "",
-                'preamble',  $chunk.config<preamble> // "",
-                'method',    $chunk.config<method> // "",
-                'solo',      $chunk.config<solo> // "",
-            ) );
-        } else {
-            if $chunk.^can('contents') {
-                @chunks.push(|$chunk.contents)
-            }
-        }
+    subtest $file => {
+        plan +my @examples = code-blocks($file);
+        test-example $_ for @examples;
     }
 }
 
-done-testing;
-
-sub check-chunk( $eg ) {
-
+sub test-example ($eg) {
     # #1355 - don't like .WHAT in examples
     if ! $eg<ok-test>.contains('WHAT') && $eg<contents>.contains('.WHAT') {
         flunk "$eg<file> chunk starting with «" ~ starts-with($eg<contents>) ~ '» uses .WHAT: try .^name instead';
@@ -89,17 +53,17 @@ sub check-chunk( $eg ) {
         next;
     }
 
-    # Wrap each snippet in a block so it compiles but isn't run on EVAL
-    # Further wrap in an anonymous class (so bare method works)
-    # Add in empty routine bodies if needed
+    # Wrap snippets in an anonymous class (so bare method works)
+    # and add in empty blocks if needed.
 
     my $code;
     if $eg<solo> {
-        $code = $eg<preamble> ~ ";\n" if $eg<preamble>;
+        $code  = $eg<preamble> ~ ";\n" if $eg<preamble>;
         $code ~= $eg<contents>;
-    } else {
-        $code = 'no worries; ';
-        $code ~= "if False \{\nclass :: \{\n";
+    }
+    else {
+        $code  = 'no worries; ';
+        $code ~= "class :: \{\n";
         $code ~= $eg<preamble> ~ ";\n";
 
         for $eg<contents>.lines -> $line {
@@ -110,18 +74,18 @@ sub check-chunk( $eg ) {
             # to make it compilable. Be careful with multiline signatures:
             # '(' and ',' at the end of a line indicate a continued sig.
             # We wait until none of them is encountered before adding '{}'.
+            # Cases that are not covered by the heuristic and which contain
+            # nothing but a method declaration can use :method instead.
             $in-signature ?|= $line.trim.starts-with(any(<multi method proto only sub>))
-                           && $eg<method> eq "";
+                           && not $eg<method>;
             if $in-signature && !$line.trim.ends-with(any(« } , ( »)) {
                $code ~= " \{}";
                $in-signature = False;
             }
-            if $eg<method> eq "" || $eg<method> eq "False" {
-                $code ~= "\n";
-            }
+            NEXT $code ~= "\n";
+            LAST $code ~= "\{}\n" if $eg<method>;
         }
-        $code ~= "\{}\n" if $eg<method> eq "True";
-        $code ~= "\n}}";
+        $code ~= "}";
     }
 
     my $msg = "$eg<file> chunk $eg<count> starts with “" ~ starts-with($eg<contents>) ~ "” compiles";
@@ -136,7 +100,8 @@ sub check-chunk( $eg ) {
             $proc.stdout.tap: {;};
             $proc.stderr.tap: {;};
             $has-error = ! await $proc.start;
-        } else {
+        }
+        else {
             temp $*OUT = open :w, $*SPEC.devnull;
             temp $*ERR = open :w, $*SPEC.devnull;
             use nqp;
@@ -153,11 +118,52 @@ sub check-chunk( $eg ) {
         diag $eg<contents>;
         diag $has-error;
         flunk $msg;
-    } else {
+    }
+    else {
         pass $msg;
     }
 }
 
-sub starts-with( Str $chunk ) {
+sub code-blocks (IO() $file) {
+    my $count;
+    my @chunks = extract-pod($file).contents;
+    gather while @chunks {
+        my $chunk = @chunks.pop;
+        if $chunk ~~ Pod::Block::Code  {
+            # Only testing Perl 6 snippets.
+            next unless $chunk.config<lang>:v eq '' | 'perl6';
+
+            my $todo = False;
+            if $chunk.config<skip-test> {
+                %*ENV<P6_DOC_TEST_FUDGE> ?? ($todo = True) !! next;
+            }
+            take %(
+                'contents',  $chunk.contents.map({walk $_}).join,
+                'file',      $file,
+                'count',     ++$count,
+                'todo',      $todo,
+                'ok-test',   $chunk.config<ok-test> // "",
+                'preamble',  $chunk.config<preamble> // "",
+                'method',    $chunk.config<method>:v,
+                'solo',      $chunk.config<solo>:v,
+            );
+        }
+        else {
+            if $chunk.^can('contents') {
+                @chunks.push(|$chunk.contents)
+            }
+        }
+    }
+}
+
+sub walk ($arg) {
+    given $arg {
+        when Pod::FormattingCode { walk $arg.contents }
+        when Str   { $arg }
+        when Array { $arg.map({walk $_}).join }
+    }
+}
+
+sub starts-with (Str $chunk) {
     ($chunk.lines)[0].substr(0,10).trim
 }