Handle code blocks properly, import 04-code.t

src/Perl6/Actions.pm

@@ -237,17 +237,29 @@ class Perl6::Actions is HLL::Actions {
         make self.any_block($/);
     }
 
+    method pod_block:sym<paragraph_raw>($/) {
+        make self.raw_block($/);
+    }
+
     method pod_block:sym<abbreviated>($/) {
         make self.any_block($/);
     }
 
+    method pod_block:sym<abbreviated_raw>($/) {
+        make self.raw_block($/);
+    }
+
     method pod_block:sym<end>($/) {
     }
 
     method pod_block:sym<delimited>($/) {
         make self.any_block($/);
     }
 
+    method pod_block:sym<delimited_raw>($/) {
+        make self.raw_block($/);
+    }
+
     method any_block($/) {
         my $name := $*ST.add_constant('Str', 'str', $<type>.Str);
         my @children := [];
@@ -276,6 +288,28 @@ class Perl6::Actions is HLL::Actions {
         return $past<compile_time_value>;
     }
 
+    method raw_block($/) {
+        my $type;
+        my $str := $*ST.add_constant('Str', 'str', $<pod_content>.Str);
+        my $content := $*ST.add_constant(
+            'Array', 'type_new',
+            $str<compile_time_value>
+        );
+        my $past := $*ST.add_constant(
+            $<type>.Str eq 'code' ?? 'Pod__Block__Code'
+                                  !! 'Pod__Block__Comment',
+            'type_new',
+            :content($content<compile_time_value>),
+        );
+        return $past<compile_time_value>;
+    }
+
+    method pod_text_para($/) {
+        my $t    := self.formatted_text($<text>.Str);
+        my $past := $*ST.add_constant('Str', 'str', $t);
+        make $past<compile_time_value>;
+    }
+
     method pod_content:sym<text>($/) {
         my @ret := [];
         for $<pod_textcontent> {
@@ -290,6 +324,23 @@ class Perl6::Actions is HLL::Actions {
         make $past<compile_time_value>;
     }
 
+    method pod_textcontent:sym<code>($/) {
+        my $s := $<spaces>.Str;
+        my $t := subst($<text>.Str, /\n$s/, "\n", :global);
+        $t    := subst($t, /\n$/, ''); # chomp!
+        my $str := $*ST.add_constant('Str', 'str', $t);
+        my $content := $*ST.add_constant(
+            'Array', 'type_new',
+            $str<compile_time_value>
+        );
+        my $past := $*ST.add_constant(
+            'Pod__Block__Code', 'type_new',
+            :content($content<compile_time_value>),
+        );
+        make $past<compile_time_value>;
+    }
+
+
     method formatted_text($a) {
         my $r := subst($a, /\s+/, ' ', :global);
         $r    := subst($r, /^^\s*/, '');

src/core/Pod.pm

@@ -6,4 +6,10 @@ class Pod__Block__Named is Pod__Block {
     has $.name;
 }
 
+class Pod__Block__Comment is Pod__Block { }
+
+class Pod__Block__Code is Pod__Block {
+    has @.allowed;
+}
+
 # vim: ft=perl6

t/pod/04-code.t

@@ -0,0 +1,143 @@
+use Test;
+plan 45;
+my $r;
+
+=begin pod
+This ordinary paragraph introduces a code block:
+
+    $this = 1 * code('block');
+    $which.is_specified(:by<indenting>);
+=end pod
+
+$r = $POD[0];
+is $r.content[0], 'This ordinary paragraph introduces a code block:';
+isa_ok $r.content[1], Pod__Block__Code;
+is $r.content[1].content.Str, q[$this = 1 * code('block');
+$which.is_specified(:by<indenting>);];
+
+# more fancy code blocks
+=begin pod
+This is an ordinary paragraph
+
+    While this is not
+    This is a code block
+
+    =head1 Mumble mumble
+
+    Suprisingly, this is a code block again
+        (with fancy indentation too)
+
+But this is just a text. Again
+
+=end pod
+
+$r = $POD[1];
+is $r.content.elems, 5;
+is $r.content[0], 'This is an ordinary paragraph';
+isa_ok $r.content[1], Pod__Block__Code;
+is $r.content[1].content, "While this is not\nThis is a code block";
+isa_ok $r.content[2], Pod__Block;
+is $r.content[2].content, 'Mumble mumble';
+isa_ok $r.content[3], Pod__Block__Code;
+is $r.content[3].content, "Suprisingly, this is a code block again\n"
+                        ~ "    (with fancy indentation too)";
+is $r.content[4], "But this is just a text. Again";
+
+=begin pod
+
+Tests for the feed operators
+
+    ==> and <==
+    
+=end pod
+
+$r = $POD[2];
+is $r.content[0], 'Tests for the feed operators';
+isa_ok $r.content[1], Pod__Block__Code;
+is $r.content[1].content, "==> and <==";
+
+=begin pod
+Fun comes
+
+    This is code
+  Ha, what now?
+
+ one more block of code
+ just to make sure it works
+  or better: maybe it'll break!
+=end pod
+
+$r = $POD[3];
+is $r.content.elems, 4;
+is $r.content[0], 'Fun comes';
+isa_ok $r.content[1], Pod__Block__Code;
+is $r.content[1].content, 'This is code';
+isa_ok $r.content[2], Pod__Block__Code;
+is $r.content[2].content, 'Ha, what now?';
+isa_ok $r.content[3], Pod__Block__Code;
+is $r.content[3].content, "one more block of code\n"
+                        ~ "just to make sure it works\n"
+                        ~ " or better: maybe it'll break!";
+
+=begin pod
+
+=head1 A heading
+
+This is Pod too. Specifically, this is a simple C<para> block
+
+    $this = pod('also');  # Specifically, a code block
+
+=end pod
+
+$r = $POD[4];
+is $r.content.elems, 3;
+isa_ok $r.content[0], Pod__Block;
+is $r.content[0].content, 'A heading';
+is $r.content[1],
+   'This is Pod too. Specifically, this is a simple C<para> block';
+isa_ok $r.content[2], Pod__Block__Code;
+is $r.content[2].content,
+   q[$this = pod('also');  # Specifically, a code block];
+
+=begin pod
+    this is code
+
+    =for podcast
+        this is not
+
+    this is code
+
+    =begin itemization
+        this is not
+    =end itemization
+
+    =begin quitem
+        and this is not
+    =end quitem
+
+    =item
+        and this is!
+=end pod
+
+$r = $POD[5];
+is $r.content.elems, 6;
+isa_ok $r.content[0], Pod__Block__Code;
+is $r.content[0].content, 'this is code';
+
+isa_ok $r.content[1], Pod__Block__Named;
+is $r.content[1].name, 'podcast';
+is $r.content[1].content, 'this is not';
+
+isa_ok $r.content[2], Pod__Block__Code;
+is $r.content[2].content, 'this is code';
+
+isa_ok $r.content[3], Pod__Block__Named;
+is $r.content[3].name, 'itemization';
+is $r.content[3].content, 'this is not';
+
+isa_ok $r.content[4], Pod__Block__Named;
+is $r.content[4].name, 'quitem';
+is $r.content[4].content, 'and this is not';
+
+isa_ok $r.content[5].content[0], Pod__Block__Code;
+is $r.content[5].content[0].content, 'and this is!';