From 7dfba0e7cf30ddbf834abee94520efcac26385d7 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Thu, 5 Nov 2009 13:52:51 +0100
Subject: still segfaults
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

and I can't reproduce the error in a minimal test case…
---
 boom/test.pl        | 55 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 boom/test.xml       |  4 ++++
 boom/test.xsl       | 27 ++++++++++++++++++++++++++
 lib/WebCoso/XSLT.pm | 25 +++++++++++-------------
 t/whole-01.t        |  4 +++-
 5 files changed, 100 insertions(+), 15 deletions(-)
 create mode 100644 boom/test.pl
 create mode 100644 boom/test.xml
 create mode 100644 boom/test.xsl

diff --git a/boom/test.pl b/boom/test.pl
new file mode 100644
index 0000000..c3ecb42
--- /dev/null
+++ b/boom/test.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use XML::LibXML;
+use XML::LibXSLT;
+use open ':std',':locale';
+
+my $tmpdoc=XML::LibXML->createDocument();
+{my $el=$tmpdoc->createElement('doc');
+$tmpdoc->setDocumentElement($el);
+my $e1=$tmpdoc->createElement('test');
+$e1->appendTextNode('blah balh');
+$el->appendChild($e1);
+}
+my $doc_mem=XML::LibXML->createDocument();
+{my $el=$doc_mem->createElement('test');
+$doc_mem->setDocumentElement($el);
+my $e1=$doc_mem->createElement('some');
+$el->appendChild($e1);
+}
+
+my $NS='urn:test';
+{
+my $p=XML::LibXML->new();
+my $t=XML::LibXSLT->new();
+
+$t->register_function($NS,'doc',\&test_doc);
+$t->register_function($NS,'str',\&test_str);
+$t->debug_callback(sub{print@_});
+
+my $doc=$p->parse_file('test.xml');
+my $st=$t->parse_stylesheet_file('test.xsl');
+
+my $out=$st->transform($doc);
+print $st->output_as_chars($out);
+$out=$st->transform($doc_mem);
+print $st->output_as_chars($out);
+}
+
+sub test_doc {
+    my $odoc=XML::LibXML::Document->new();
+    my $el=$odoc->createElementNS($NS,'doc');
+    $odoc->setDocumentElement($el);
+    $el->appendTextNode('a test');
+    $el->appendChild($odoc->importNode(
+        ($tmpdoc->findnodes('/doc/test'))[0]));
+    $el->appendChild($odoc->importNode(
+        ($doc_mem->findnodes('/test'))[0]));
+    warn('returning from test_doc');
+    return $odoc;
+}
+
+sub test_str {
+    return 'a string';
+}
diff --git a/boom/test.xml b/boom/test.xml
new file mode 100644
index 0000000..c13808a
--- /dev/null
+++ b/boom/test.xml
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="utf-8"?>
+<doc>
+ <test id="5">testo</test>
+</doc>
\ No newline at end of file
diff --git a/boom/test.xsl b/boom/test.xsl
new file mode 100644
index 0000000..ea32419
--- /dev/null
+++ b/boom/test.xsl
@@ -0,0 +1,27 @@
+<?xml version="1.0" encoding="utf-8"?>
+<x:stylesheet xmlns:x="http://www.w3.org/1999/XSL/Transform"
+              version="1.0"
+              xmlns:t="urn:test"
+              exclude-result-prefixes="t"
+              >
+ 
+ <x:output method="xml" encoding="utf-8"/>
+
+ <x:template match="/doc|/test">
+  <out>
+   <from-func><x:value-of select="t:str()"/></from-func>
+   <from-func><x:apply-templates select="t:doc()"/></from-func>
+   <x:apply-templates/>
+  </out>
+ </x:template>
+
+ <x:template match="*">
+  <x:copy>
+   <x:apply-templates select="@*|*"/>
+  </x:copy>
+ </x:template>
+ <x:template match="@*">
+  <x:copy/>
+ </x:template>
+
+</x:stylesheet>
\ No newline at end of file
diff --git a/lib/WebCoso/XSLT.pm b/lib/WebCoso/XSLT.pm
index ceb7b3a..8daa912 100644
--- a/lib/WebCoso/XSLT.pm
+++ b/lib/WebCoso/XSLT.pm
@@ -45,7 +45,12 @@ sub new {
     $self->{fc}->add_writer(qr{\.xml$} =>
                                 sub { $_[1]->toFile($_[0]) });
 
-    $self->{du2html}=sub {
+    bless $self,$class;
+}
+
+sub du2html {
+    my ($self)=@_;
+    return sub {
         my ($maker,$target,$deps,$matches)=@_;
         DEBUG("du2html($maker,$target,(@$deps),(@$matches))");
 
@@ -73,8 +78,12 @@ sub new {
                                  ));
         $self->{fc}->put($target,$xslt->output_string($out));
     };
+}
 
-    $self->{fillFeed}=sub {
+sub fillFeed {
+    my ($self)=@_;
+
+    return sub {
         my ($maker,$target,$deps,$matches)=@_;
         DEBUG("fillFeed($maker,$target,(@$deps),(@$matches))");
 
@@ -95,18 +104,6 @@ sub new {
                                  ));
         $self->{fc}->put($target,$out);
     };
-
-    bless $self,$class;
-}
-
-sub du2html {
-    my ($self)=@_;
-    return $self->{du2html};
-}
-
-sub fillFeed {
-    my ($self)=@_;
-    return $self->{fillFeed};
 }
 
 sub setXMLTagsSource {
diff --git a/t/whole-01.t b/t/whole-01.t
index f270c5e..f2e7506 100644
--- a/t/whole-01.t
+++ b/t/whole-01.t
@@ -11,8 +11,10 @@ $ENV{PERL5LIB}=join ':',@INC;
 system($^X,qw(blib/script/webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/src/common/ --clean))
     and die "Problems running webcoso.pl (clean): $?\n";
 
+#system('valgrind',$^X,qw(blib/script/webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/src/common/))
 system($^X,qw(blib/script/webcoso.pl -s t/test-site/src/ -d t/test-site/output/ -I t/test-site/src/common/))
-    and die "Problems running webcoso.pl: $?\n";
+#    and die "Problems running webcoso.pl: $?\n";
+;
 
 is(system(qw(diff -r -x .svn -I),'\(Ultima modifica\|Latest change\)',qw(t/test-site/output/ t/test-site-output/)),0,'output as expected');
 
-- 
cgit v1.2.3