summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/01-basic.t27
-rw-r--r--t/02-xslt.t67
-rw-r--r--t/03-html.t47
-rw-r--r--t/04-xml.t54
-rw-r--r--t/05-mixed.t55
-rw-r--r--t/06-code.t58
-rw-r--r--t/07-inherit.t67
7 files changed, 375 insertions, 0 deletions
diff --git a/t/01-basic.t b/t/01-basic.t
new file mode 100644
index 0000000..01d3510
--- /dev/null
+++ b/t/01-basic.t
@@ -0,0 +1,27 @@
+#!perl
+use Test::Most tests => 2,'die';
+use strict;
+use warnings;
+use Tree::Template::Declare builder => '+DAG_Node';
+
+my $tree=tree {
+ node {
+ name 'root';
+ attribs name => 'none';
+ node {
+ name 'coso1';
+ attribs name => 'coso_1';
+ attribs other => 'some';
+ };
+ node {
+ name 'coso2';
+ };
+ };
+};
+
+cmp_deeply($tree->tree_to_lol(),
+ [[re(qr{coso1})],[re(qr{coso2})],re(qr{root})],
+ 'built the tree');
+is_deeply(($tree->daughters)[0]->attributes,
+ {name => 'coso_1', other => 'some'},
+ 'attributes');
diff --git a/t/02-xslt.t b/t/02-xslt.t
new file mode 100644
index 0000000..d36c132
--- /dev/null
+++ b/t/02-xslt.t
@@ -0,0 +1,67 @@
+#!perl
+package main;
+use Test::Most 'die';
+BEGIN {
+eval 'use Tree::DAG_Node::XPath 0.10; require Tree::Transform::XSLTish';
+plan skip_all => 'Tree::DAG_Node::XPath 0.10 and Tree::Transform::XSLTish needed for this test' if $@;
+}
+plan tests => 3;
+
+package Copy;{
+use Tree::Transform::XSLTish;
+use Tree::Template::Declare::DAG_Node;
+use Tree::Template::Declare builder => Tree::Template::Declare::DAG_Node->new('Tree::DAG_Node::XPath');
+use strict;
+use warnings;
+
+tree_rule match => '/', action => sub {
+ tree {
+ $_[0]->apply_rules;
+ };
+};
+
+tree_rule match => '*', priority => 0, action => sub {
+ node {
+ name $_[0]->it->name;
+ attribs %{$_[0]->it->attributes};
+ $_[0]->apply_rules;
+ };
+};
+
+}
+
+package main;
+use strict;
+use warnings;
+use Tree::Template::Declare builder => Tree::Template::Declare::DAG_Node->new('Tree::DAG_Node::XPath');
+use Data::Dumper;
+
+my $tree=tree {
+ node {
+ name 'root';
+ attribs name => 'none';
+ node {
+ name 'coso1';
+ attribs name => 'coso_1';
+ };
+ node {
+ name 'coso2';
+ node {
+ name 'coso3';
+ };
+ };
+ };
+};
+
+diag "transforming";
+my $trans=Copy->new();
+my ($tree2)=$trans->transform($tree);
+
+ok(defined $tree,'built');
+ok(defined $tree2,'transformed');
+
+diag "comparing";
+is($tree->tree_to_lol_notation(),
+ $tree2->tree_to_lol_notation(),
+ 'tree copy');
+
diff --git a/t/03-html.t b/t/03-html.t
new file mode 100644
index 0000000..6c1348d
--- /dev/null
+++ b/t/03-html.t
@@ -0,0 +1,47 @@
+#!perl
+use Test::Most 'die';
+BEGIN {
+eval 'use HTML::Element';
+plan skip_all => 'HTML::Element needed for this test' if $@;
+}
+plan tests => 1;
+use strict;
+use warnings;
+use Tree::Template::Declare builder => '+HTML_Element';
+use Data::Dumper;
+
+my $tree=tree {
+ node {
+ name 'html';
+ node {
+ name 'head';
+ node {
+ name 'title';
+ text_node 'Page title';
+ }
+ };
+ node {
+ name 'body';
+ node {
+ name 'p';
+ attribs id => 'p1';
+ attribs class => 'para';
+ text_node 'Page para';
+ };
+ };
+ };
+};
+
+my $expected_tree = HTML::Element->new_from_lol(
+ ['html',
+ ['head',
+ ['title','Page title'],
+ ],
+ ['body',
+ ['p','Page para',{class=>'para',id=>'p1'}],
+ ],
+ ],
+);
+ok($tree->same_as($expected_tree),
+ 'HTML tree'
+);
diff --git a/t/04-xml.t b/t/04-xml.t
new file mode 100644
index 0000000..bd4ada3
--- /dev/null
+++ b/t/04-xml.t
@@ -0,0 +1,54 @@
+#!perl
+use Test::Most 'die';
+BEGIN {
+eval 'use XML::LibXML';
+plan skip_all => 'XML::LibXML needed for this test' if $@;
+}
+plan tests => 2;
+use strict;
+use warnings;
+use Tree::Template::Declare builder => '+LibXML';
+use Data::Dumper;
+
+xmlns test => 'http://test/';
+
+sub make_tree {
+ tree {
+ node {
+ name 'stuff';
+ node {
+ name 'test:elem1';
+ attribs 'test:buh' => 'testing';
+ attribs id => 1;
+ node {
+ name 'test:sub1';
+ text_node 'some content';
+ }
+ };
+ node {
+ name 'elem2';
+ attribs id => 2;
+ };
+ };
+ };
+}
+
+{
+my $tree=make_tree();
+
+is($tree->toStringC14N(0),
+ qq{<stuff><test:elem1 xmlns:test="http://test/" id="1" test:buh="testing"><test:sub1>some content</test:sub1></test:elem1><elem2 id="2"></elem2></stuff>},
+ 'XML document without default NS'
+);
+}
+
+xmlns ':default' => 'ftp://test/';
+
+{
+my $tree=make_tree();
+
+is($tree->toStringC14N(0),
+ qq{<stuff xmlns="ftp://test/"><test:elem1 xmlns:test="http://test/" id="1" test:buh="testing"><test:sub1>some content</test:sub1></test:elem1><elem2 id="2"></elem2></stuff>},
+ 'XML document with default NS'
+);
+}
diff --git a/t/05-mixed.t b/t/05-mixed.t
new file mode 100644
index 0000000..85bcf37
--- /dev/null
+++ b/t/05-mixed.t
@@ -0,0 +1,55 @@
+#!perl
+use Test::Most 'die';
+BEGIN {
+eval 'use XML::LibXML';
+plan skip_all => 'XML::LibXML needed for this test' if $@;
+}
+plan tests => 2;
+use strict;
+use warnings;
+use Tree::Template::Declare -prefix=> 'x', builder => '+LibXML';
+use Tree::Template::Declare -prefix=> 'd', builder => '+DAG_Node';
+
+use Data::Dumper;
+
+xxmlns test => 'http://test/';
+
+my $xmltree= xtree {
+ xnode {
+ xname 'stuff';
+ xnode {
+ xname 'test:elem1';
+ xattribs id => 1, 'test:buh' => 'testing';
+ xnode {
+ xname 'test:sub1';
+ }
+ };
+ xnode {
+ xname 'elem2';
+ xattribs id => 2;
+ };
+ };
+};
+
+is($xmltree->toStringC14N(0),
+ qq{<stuff><test:elem1 xmlns:test="http://test/" id="1" test:buh="testing"><test:sub1></test:sub1></test:elem1><elem2 id="2"></elem2></stuff>},
+ 'XML document'
+);
+
+my $dagtree=dtree {
+ dnode {
+ dname 'root';
+ dattribs name => 'none';
+ dnode {
+ dname 'coso1';
+ dattribs name => 'coso_1';
+ };
+ dnode {
+ dname 'coso2';
+ };
+ };
+};
+
+cmp_deeply($dagtree->tree_to_lol(),
+ [[re(qr{coso1})],[re(qr{coso2})],re(qr{root})],
+ 'DAG_Node tree');
diff --git a/t/06-code.t b/t/06-code.t
new file mode 100644
index 0000000..f80c7fa
--- /dev/null
+++ b/t/06-code.t
@@ -0,0 +1,58 @@
+#!perl
+use Test::Most tests => 2,'die';
+use strict;
+use warnings;
+use Tree::Template::Declare builder => '+DAG_Node';
+use Data::Dumper;
+
+sub make_item {
+ my ($name,$id)=@_;
+
+ return detached node {
+ name 'item';
+ attribs id => $id;
+ node {
+ name 'description';
+ attribs name => $name;
+ };
+ };
+}
+
+sub make_list {
+ my (@items)=@_;
+
+ my @item_nodes=map {make_item(@$_)} @items;
+
+ return node {
+ name 'list';
+ attach_nodes @item_nodes;
+ };
+}
+
+my $tree=tree {
+ make_list([gino => 1],
+ [pino => 2],
+ [rino => 3],
+ );
+};
+
+cmp_deeply($tree->tree_to_lol(),
+ [
+ [[re(qr{description})],re(qr{item})],
+ [[re(qr{description})],re(qr{item})],
+ [[re(qr{description})],re(qr{item})],
+ re(qr{list})],
+ 'tree with code');
+
+my @attrs;
+$tree->walk_down({callback=>sub{
+ push @attrs,$_[0]->attributes;
+ 1
+ }});
+is_deeply(\@attrs,
+ [{},
+ {id=>1},{name=>'gino'},
+ {id=>2},{name=>'pino'},
+ {id=>3},{name=>'rino'},
+ ],
+ 'attributes');
diff --git a/t/07-inherit.t b/t/07-inherit.t
new file mode 100644
index 0000000..642b24f
--- /dev/null
+++ b/t/07-inherit.t
@@ -0,0 +1,67 @@
+#!perl
+package Base;{
+use strict;
+use warnings;
+use Tree::Template::Declare builder => '+DAG_Node';
+
+sub doc {
+ my ($self)=@_;
+ tree {
+ node {
+ name 'doc';
+ $self->head();
+ $self->body();
+ }
+ }
+}
+
+sub head {
+ node { name 'title' };
+}
+
+sub body {
+ node {
+ name 'content';
+ $_[0]->content();
+ }
+}
+
+sub content {
+ node { name 'stuff' }
+}
+
+}
+
+package Derived;{
+use strict;
+use warnings;
+use Tree::Template::Declare builder => '+DAG_Node';
+use base 'Base';
+
+sub head {
+ node { name 'whatever' };
+ $_[0]->SUPER::head();
+}
+
+sub content {
+ node { name 'something' }
+}
+
+}
+
+package main;
+use Test::Most tests=>2,'die';
+use strict;
+use warnings;
+
+my $base_tree=Base->doc();
+
+cmp_deeply($base_tree->tree_to_lol(),
+ [[re(qr{title})],[[re(qr{stuff})],re(qr{content})],re(qr{doc})],
+ 'base tree');
+
+my $deriv_tree=Derived->doc();
+
+cmp_deeply($deriv_tree->tree_to_lol(),
+ [[re(qr{whatever})],[re(qr{title})],[[re(qr{something})],re(qr{content})],re(qr{doc})],
+ 'derived tree');
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-02 05:20:52 +0000