Commits

Anonymous committed 1a6224b

Now checking for an error thrown on inline tags.

Moved some inaccessible code to the rejects.

Comments (0)

Files changed (5)

perl/modules/XML-Grammar-Fiction/MANIFEST

 t/data/proto-text-invalid/no-right-angle.txt
 t/data/proto-text-invalid/not-start-with-tag.txt
 t/data/proto-text-invalid/wrong-close-tag.txt
+t/data/proto-text-invalid/wrong-closing-inner-tag.txt
 t/data/proto-text/nested-s.txt
 t/data/proto-text/scenes-with-titles.txt
 t/data/proto-text/sections-and-paras.txt

perl/modules/XML-Grammar-Fiction/lib/XML/Grammar/Fiction/FromProto/Parser/QnD.pm

 {
     my $self = shift;
 
-    return $self->_parse_top_level_tag();
+    return $self->_parse_tag();
 }
 
 # Skip the whitespace.
     return $self->_new_list(\@ret);
 }
 
-sub _consume_paragraph
-{
-    my $self = shift;
-
-    $self->_skip_space();
-
-    return $self->_parse_inner_text();
-}
-
-sub _parse_inner_tag
-{
-    my $self = shift;
-
-    my $open = $self->_parse_opening_tag();
-
-    if ($open->is_standalone())
-    {
-        $self->_skip_space();
-
-        return $self->_create_elem($open);
-    }
-
-    my $inside = $self->_parse_inner_text();
-
-    my $close = $self->_parse_closing_tag();
-
-    if ($open->name() ne $close->name())
-    {
-        Carp::confess(
-            sprintf(("Opening and closing tags do not match: "
-                . "%s and %s on element starting at line %d"),
-                $open->name(), $close->name(), $open->line()
-            )
-        );
-    }
-    return $self->_create_elem($open);
-}
-
 sub _find_next_inner_text
 {
     my $self = shift;
         }
         else
         {
-            return $self->_parse_top_level_tag();
+            return $self->_parse_tag();
         }
     }
     else
     return $$l =~ m{\G$re}cg;
 }
 
-sub _parse_top_level_tag
+sub _parse_tag
 {
     my $self = shift;
 

perl/modules/XML-Grammar-Fiction/rejects/QnD.pm

     });
 }
 
+sub _parse_inner_tag
+{
+    my $self = shift;
+
+    my $open = $self->_parse_opening_tag();
+
+    if ($open->is_standalone())
+    {
+        $self->_skip_space();
+
+        return $self->_create_elem($open);
+    }
+
+    my $inside = $self->_parse_inner_text();
+
+    my $close = $self->_parse_closing_tag();
+
+    if ($open->name() ne $close->name())
+    {
+        XML::Grammar::Fiction::Err::Parse::InnerTagsMismatch->throw(
+            error => "Inline tags do not match",
+            opening_tag => $open,
+            closing_tag => $close,
+        );
+    }
+
+    return $self->_create_elem($open);
+}
+

perl/modules/XML-Grammar-Fiction/t/data/proto-text-invalid/wrong-closing-inner-tag.txt

+<body id="index">
+
+<title>David vs. Goliath - Part I</title>
+
+<s id="top">
+
+<title>The Top Section</title>
+
+David and Goliath were standing by each other.    
+
+David said unto Goliath: "I will shoot you. I <b>swear</i> I will"
+
+<s id="goliath">
+
+<title>Goliath's Response</title>
+
+Goliath was not amused.
+
+</s>
+
+</s>
+
+</body>
+

perl/modules/XML-Grammar-Fiction/t/proto-text-invalid.t

 use strict;
 use warnings;
 
-use Test::More tests => 14;
+use Test::More tests => 20;
 
 use XML::LibXML;
 
     );
 }
 
+{
+    my $grammar = XML::Grammar::Fiction::FromProto->new({});
+    eval {
+    my $got_xml = $grammar->convert(
+        {
+            source =>
+            {
+                file => "t/data/proto-text-invalid/wrong-closing-inner-tag.txt",
+            },
+        }
+    );
+    };
+
+    my $err_raw = $@;
+
+    my $err = Exception::Class->caught(
+        "XML::Grammar::Fiction::Err::Parse::TagsMismatch"
+    );
+
+    # TEST
+    ok ($err, "TagsMismatch was caught");
+
+    # TEST
+    like(
+        $err->error(),
+        qr{\ATags do not match},
+        "Text is OK."
+    );
+
+    # TEST
+    is(
+        $err->opening_tag()->name(),
+        "b",
+        "Opening tag-name is OK.",
+    );
+
+    # TEST
+    is(
+        $err->opening_tag()->line(),
+        11,
+        "Opening line is OK.",
+    );
+
+    # TEST
+    is(
+        $err->closing_tag()->name(),
+        "i",
+        "closing tag.",
+    );
+
+    # TEST
+    is(
+        $err->closing_tag()->line(),
+        11,
+        "Opening line is OK.",
+    );
+}
+
 1;