Integrate with Sarathy.

p4raw-id: //depot/cfgperl@4591

20 files changed, 1087 insertions, 86 deletions

diff --git a/cop.h b/cop.h
index af29ff6678..88627d684e 100644
--- a/cop.h
+++ b/cop.h
@@ -370,7 +370,7 @@ struct stackinfo {
     I32			si_type;	/* type of runlevel */
     struct stackinfo *	si_prev;
     struct stackinfo *	si_next;
-    I32 *		si_markbase;	/* where markstack begins for us.
+    I32			si_markoff;	/* offset where markstack begins for us.
 					 * currently used only with DEBUGGING,
 					 * but not #ifdef-ed for bincompat */
 };
@@ -382,9 +382,10 @@ typedef struct stackinfo PERL_SI;
 #define cxstack_max	(PL_curstackinfo->si_cxmax)
 
 #ifdef DEBUGGING
-#  define	SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr
+#  define	SET_MARK_OFFSET \
+    PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack
 #else
-#  define	SET_MARKBASE NOOP
+#  define	SET_MARK_OFFSET NOOP
 #endif
 
 #define PUSHSTACKi(type) \
@@ -400,7 +401,7 @@ typedef struct stackinfo PERL_SI;
 	AvFILLp(next->si_stack) = 0;					\
 	SWITCHSTACK(PL_curstack,next->si_stack);			\
 	PL_curstackinfo = next;						\
-	SET_MARKBASE;							\
+	SET_MARK_OFFSET;						\
     } STMT_END
 
 #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
diff --git a/deb.c b/deb.c
index 0eaa056f58..36b8ca3b68 100644
--- a/deb.c
+++ b/deb.c
@@ -88,7 +88,7 @@ Perl_debstack(pTHX)
     dTHR;
     I32 top = PL_stack_sp - PL_stack_base;
     register I32 i = top - 30;
-    I32 *markscan = PL_curstackinfo->si_markbase;
+    I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff;
 
     if (i < 0)
 	i = 0;
diff --git a/embed.h b/embed.h
index 72aeae42cd..6c17d8832c 100644
--- a/embed.h
+++ b/embed.h
@@ -764,6 +764,9 @@
 #define my_attrs		Perl_my_attrs
 #define boot_core_xsutils	Perl_boot_core_xsutils
 #if defined(USE_ITHREADS)
+#define cx_dup			Perl_cx_dup
+#define si_dup			Perl_si_dup
+#define ss_dup			Perl_ss_dup
 #define he_dup			Perl_he_dup
 #define re_dup			Perl_re_dup
 #define fp_dup			Perl_fp_dup
@@ -2134,6 +2137,9 @@
 #define my_attrs(a,b)		Perl_my_attrs(aTHX_ a,b)
 #define boot_core_xsutils()	Perl_boot_core_xsutils(aTHX)
 #if defined(USE_ITHREADS)
+#define cx_dup(a,b,c)		Perl_cx_dup(aTHX_ a,b,c)
+#define si_dup(a)		Perl_si_dup(aTHX_ a)
+#define ss_dup(a,b,c)		Perl_ss_dup(aTHX_ a,b,c)
 #define he_dup(a,b)		Perl_he_dup(aTHX_ a,b)
 #define re_dup(a)		Perl_re_dup(aTHX_ a)
 #define fp_dup(a,b)		Perl_fp_dup(aTHX_ a,b)
@@ -4206,6 +4212,12 @@
 #define Perl_boot_core_xsutils	CPerlObj::Perl_boot_core_xsutils
 #define boot_core_xsutils	Perl_boot_core_xsutils
 #if defined(USE_ITHREADS)
+#define Perl_cx_dup		CPerlObj::Perl_cx_dup
+#define cx_dup			Perl_cx_dup
+#define Perl_si_dup		CPerlObj::Perl_si_dup
+#define si_dup			Perl_si_dup
+#define Perl_ss_dup		CPerlObj::Perl_ss_dup
+#define ss_dup			Perl_ss_dup
 #define Perl_he_dup		CPerlObj::Perl_he_dup
 #define he_dup			Perl_he_dup
 #define Perl_re_dup		CPerlObj::Perl_re_dup
diff --git a/embed.pl b/embed.pl
index 39984b3181..64a25b55ab 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1773,6 +1773,9 @@ p	|void	|newMYSUB	|I32 floor|OP *o|OP *proto|OP *attrs|OP *block
 p	|OP *	|my_attrs	|OP *o|OP *attrs
 p	|void	|boot_core_xsutils
 #if defined(USE_ITHREADS)
+p	|PERL_CONTEXT*|cx_dup	|PERL_CONTEXT* cx|I32 ix|I32 max
+p	|PERL_SI*|si_dup	|PERL_SI* si
+p	|ANY*	|ss_dup		|ANY* ss|I32 ix|I32 max
 p	|HE*	|he_dup		|HE* e|bool shared
 p	|REGEXP*|re_dup		|REGEXP* r
 p	|PerlIO*|fp_dup		|PerlIO* fp|char type
diff --git a/global.sym b/global.sym
index d15142263d..e21903093c 100644
--- a/global.sym
+++ b/global.sym
@@ -675,6 +675,9 @@ Perl_newATTRSUB
 Perl_newMYSUB
 Perl_my_attrs
 Perl_boot_core_xsutils
+Perl_cx_dup
+Perl_si_dup
+Perl_ss_dup
 Perl_he_dup
 Perl_re_dup
 Perl_fp_dup
diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index 8f6d1d17f9..aa5c5490ae 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -10,7 +10,7 @@
 package Pod::Checker;
 
 use vars qw($VERSION);
-$VERSION = 1.085;  ## Current version of this package
+$VERSION = 1.090;  ## Current version of this package
 require  5.004;    ## requires this Perl version or later
 
 =head1 NAME
@@ -21,7 +21,7 @@ Pod::Checker, podchecker() - check pod documents for syntax errors
 
   use Pod::Checker;
 
-  $syntax_okay = podchecker($filepath, $outputpath);
+  $syntax_okay = podchecker($filepath, $outputpath, %options);
 
 =head1 OPTIONS/ARGUMENTS
 
@@ -31,6 +31,15 @@ indcating a file-path, or else a reference to an open filehandle.
 If unspecified, the input-file it defaults to C<\*STDIN>, and
 the output-file defaults to C<\*STDERR>.
 
+=head2 Options
+
+=over 4
+
+=item B<-warnings> =E<gt> I<val>
+
+Turn warnings on/off. See L<"Warnings">.
+
+=back
 
 =head1 DESCRIPTION
 
@@ -43,13 +52,83 @@ unknown 'X<...>' interior-sequences, and unterminated interior sequences.
 It is hoped that curious/ambitious user will help flesh out and add the
 additional features they wish to see in B<Pod::Checker> and B<podchecker>.
 
+The following additional checks are preformed:
+
+=over 4
+
+=item *
+
+Check for proper balancing of C<=begin> and C<=end>.
+
+=item *
+
+Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>.
+
+=item *
+
+Check for same nested interior-sequences (e.g. C<LE<lt>...LE<lt>...E<gt>...E<gt>>).
+
+=item *
+
+Check for malformed entities.
+
+=item *
+
+Check for correct syntax of hyperlinks C<LE<lt>E<gt>>. See L<perlpod> for 
+details.
+
+=item *
+
+Check for unresolved document-internal links.
+
+=back
+
+=head2 Warnings
+
+The following warnings are printed. These may not necessarily cause trouble,
+but indicate mediocre style.
+
+=over 4
+
+=item *
+
+Spurious characters after C<=back> and C<=end>.
+
+=item *
+
+Unescaped C<E<lt>> and C<E<gt>> in the text.
+
+=item *
+
+Missing arguments for C<=begin> and C<=over>.
+
+=item *
+
+Empty C<=over> / C<=back> list.
+
+=item *
+
+Hyperlinks: leading/trailing whitespace, brackets C<()> in the page name.
+
+=back
+
+=head1 DIAGNOSTICS
+
+I<[T.B.D.]>
+
+=head1 RETURN VALUE
+
+B<podchecker> returns the number of POD syntax errors found or -1 if
+there were no POD commands at all found in the file.
+
 =head1 EXAMPLES
 
 I<[T.B.D.]>
 
 =head1 AUTHOR
 
-Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version)
+Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
 
 Based on code for B<Pod::Text::pod2text()> written by
 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
@@ -101,8 +180,8 @@ my %VALID_SEQUENCES = (
 ## Function definitions begin here
 ##---------------------------------
 
-sub podchecker( $ ; $ ) {
-    my ($infile, $outfile) = @_;
+sub podchecker( $ ; $ % ) {
+    my ($infile, $outfile, %options) = @_;
     local $_;
 
     ## Set defaults
@@ -110,7 +189,7 @@ sub podchecker( $ ; $ ) {
     $outfile ||= \*STDERR;
 
     ## Now create a pod checker
-    my $checker = new Pod::Checker();
+    my $checker = new Pod::Checker(%options);
 
     ## Now check the pod document for errors
     $checker->parse_from_file($infile, $outfile);
@@ -141,6 +220,12 @@ sub initialize {
     ## increment this number and then print to the designated output.
     $self->{_NUM_ERRORS} = 0;
     $self->errorsub('poderror');
+    $self->{_commands} = 0; # total number of POD commands encountered
+    $self->{_list_stack} = []; # stack for nested lists
+    $self->{_have_begin} = ''; # stores =begin
+    $self->{_links} = []; # stack for internal hyperlinks
+    $self->{_nodes} = []; # stack for =head/=item nodes
+    $self->{-warnings} = 1 unless(defined $self->{-warnings});
 }
 
 ## Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )
@@ -154,8 +239,9 @@ sub poderror {
     my $file = (exists $opts{-file}) ? " in file $opts{-file}" : "";
     my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : "";
 
-    ## Increment error count and print message
-    ++($self->{_NUM_ERRORS});
+    ## Increment error count and print message "
+    ++($self->{_NUM_ERRORS}) 
+        if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR'));
     my $out_fh = $self->output_handle();
     print $out_fh ($severity, $msg, $line, $file, "\n");
 }
@@ -164,17 +250,58 @@ sub num_errors {
    return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
 }
 
+## overrides for Pod::Parser
+
 sub end_pod {
-   ## Print the number of errors found
+   ## Do some final checks and
+   ## print the number of errors found
    my $self   = shift;
    my $infile = $self->input_file();
    my $out_fh = $self->output_handle();
 
+   if(@{$self->{_list_stack}}) {
+       # _TODO_ display, but don't count them for now
+       my $list;
+       while($list = shift(@{$self->{_list_stack}})) {
+           $self->poderror({ -line => 'EOF', -file => $infile,
+               -severity => 'ERROR', -msg => "=over on line " .
+               $list->start() . " without closing =back" }); #"
+       }
+   }
+
+   # check validity of document internal hyperlinks
+   # first build the node names from the paragraph text
+   my %nodes;
+   foreach($self->node()) {
+       #print "Have node: +$_+\n";
+       $nodes{$_} = 1;
+       if(/^(\S+)\s+/) {
+           # we have more than one word. Use the first as a node, too.
+           # This is used heavily in perlfunc.pod
+           $nodes{$1} ||= 2; # derived node
+       }
+   }
+   foreach($self->hyperlink()) {
+       #print "Seek node: +$_+\n";
+       my $line = '';
+       s/^(\d+):// && ($line = $1);
+       if($_ && !$nodes{$_}) {
+           $self->poderror({ -line => $line, -file => $infile,
+               -severity => 'ERROR',
+               -msg => "unresolved internal link `$_'"});
+       }
+   }
+
+   ## Print the number of errors found
    my $num_errors = $self->num_errors();
    if ($num_errors > 0) {
       printf $out_fh ("$infile has $num_errors pod syntax %s.\n",
                       ($num_errors == 1) ? "error" : "errors");
    }
+   elsif($self->{_commands} == 0) {
+      print $out_fh "$infile does not contain any pod commands.\n";
+      $self->num_errors(-1);
+   }
    else {
       print $out_fh "$infile pod syntax OK.\n";
    }
@@ -184,16 +311,240 @@ sub command {
     my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_;
     my ($file, $line) = $pod_para->file_line;
     ## Check the command syntax
+    my $arg; # this will hold the command argument
     if (! $VALID_COMMANDS{$cmd}) {
        $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
                          -msg => "Unknown command \"$cmd\"" });
     }
     else {
-       ## check syntax of particular command
+        $self->{_commands}++; # found a valid command
+        ## check syntax of particular command
+        if($cmd eq 'over') {
+            # start a new list
+            unshift(@{$self->{_list_stack}}, 
+                Pod::List->new(
+                    -indent => $paragraph,
+                    -start => $line,
+                    -file => $file));
+        }
+        elsif($cmd eq 'item') {
+            unless(@{$self->{_list_stack}}) {
+                $self->poderror({ -line => $line, -file => $file,
+                     -severity => 'ERROR', 
+                     -msg => "=item without previous =over" });
+            }
+            else {
+                # check for argument
+                $arg = $self->_interpolate_and_check($paragraph, $line, $file);
+                unless($arg && $arg =~ /(\S+)/) {
+                    $self->poderror({ -line => $line, -file => $file,
+                         -severity => 'WARNING', 
+                         -msg => "No argument for =item" });
+                }
+                # add this item
+                $self->{_list_stack}[0]->item($arg || '');
+                # remember this node
+                $self->node($arg) if($arg);
+            }
+        }
+        elsif($cmd eq 'back') {
+            # check if we have an open list
+            unless(@{$self->{_list_stack}}) {
+                $self->poderror({ -line => $line, -file => $file,
+                         -severity => 'ERROR', 
+                         -msg => "=back without previous =over" });
+            }
+            else {
+                # check for spurious characters
+                $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+                if($arg && $arg =~ /\S/) {
+                    $self->poderror({ -line => $line, -file => $file,
+                         -severity => 'WARNING', 
+                         -msg => "Spurious character(s) after =back" });
+                }
+                # close list
+                my $list = shift @{$self->{_list_stack}};
+                # check for empty lists
+                if(!$list->item() && $self->{-warnings}) {
+                    $self->poderror({ -line => $line, -file => $file,
+                         -severity => 'WARNING', 
+                         -msg => "No items in =over (at line " .
+                         $list->start() . ") / =back list"}); #"
+                }
+            }
+        }
+        elsif($cmd =~ /^head/) {
+            # check if there is an open list
+            if(@{$self->{_list_stack}}) {
+                my $list;
+                while($list = shift(@{$self->{_list_stack}})) {
+                    $self->poderror({ -line => $line, -file => $file,
+                         -severity => 'ERROR', 
+                         -msg => "unclosed =over (line ". $list->start() .
+                         ") at $cmd" });
+                }
+            }
+            # remember this node
+            $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+            $self->node($arg) if($arg);
+        }
+        elsif($cmd eq 'begin') {
+            if($self->{_have_begin}) {
+                # already have a begin
+                $self->poderror({ -line => $line, -file => $file,
+                     -severity => 'ERROR', 
+                     -msg => "Nested =begin's (first at line " .
+                     $self->{_have_begin} . ")"});
+            }
+            else {
+                # check for argument
+                $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+                unless($arg && $arg =~ /(\S+)/) {
+                    $self->poderror({ -line => $line, -file => $file,
+                         -severity => 'WARNING', 
+                         -msg => "No argument for =begin"});
+                }
+                # remember the =begin
+                $self->{_have_begin} = "$line:$1";
+            }
+        }
+        elsif($cmd eq 'end') {
+            if($self->{_have_begin}) {
+                # close the existing =begin
+                $self->{_have_begin} = '';
+                # check for spurious characters
+                $arg = $self->_interpolate_and_check($paragraph, $line,$file);
+                if($arg && $arg =~ /\S/) {
+                    $self->poderror({ -line => $line, -file => $file,
+                         -severity => 'WARNING', 
+                         -msg => "Spurious character(s) after =end" });
+                }
+            }
+            else {
+                # don't have a matching =begin
+                $self->poderror({ -line => $line, -file => $file,
+                     -severity => 'WARNING', 
+                     -msg => "=end without =begin" });
+            }
+        }
     }
-    my $expansion = $self->interpolate($paragraph, $line_num);
+    ## Check the interior sequences in the command-text
+    $self->_interpolate_and_check($paragraph, $line,$file)
+        unless(defined $arg);
 }
 
+sub _interpolate_and_check {
+    my ($self, $paragraph, $line, $file) = @_;
+    ## Check the interior sequences in the command-text
+    # and return the text
+    $self->_check_ptree(
+        $self->parse_text($paragraph,$line), $line, $file, '');
+}
+
+sub _check_ptree {
+    my ($self,$ptree,$line,$file,$nestlist) = @_;
+    local($_);
+    my $text = '';
+    # process each node in the parse tree
+    foreach(@$ptree) {
+        # regular text chunk
+        unless(ref) {
+            my $count;
+            # count the unescaped angle brackets
+            my $i = $_;
+            if($count = $i =~ s/[<>]/$self->expand_unescaped_bracket($&)/ge) {
+                $self->poderror({ -line => $line, -file => $file,
+                     -severity => 'WARNING', 
+                     -msg => "$count unescaped <>" });
+            }
+            $text .= $i;
+            next;
+        }
+        # have an interior sequence
+        my $cmd = $_->cmd_name();
+        my $contents = $_->parse_tree();
+        ($file,$line) = $_->file_line();
+        # check for valid tag
+        if (! $VALID_SEQUENCES{$cmd}) {
+            $self->poderror({ -line => $line, -file => $file,
+                 -severity => 'ERROR', 
+                 -msg => qq(Unknown interior-sequence "$cmd")});
+            # expand it anyway
+            $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+            next;
+        }
+        if($nestlist =~ /$cmd/) {
+            $self->poderror({ -line => $line, -file => $file,
+                 -severity => 'ERROR', 
+                 -msg => "nested commands $cmd<...$cmd<...>...>"});
+            # _TODO_ should we add the contents anyway?
+            # expand it anyway, see below
+        }
+        if($cmd eq 'E') {
+            # preserve entities
+            if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) {
+                $self->poderror({ -line => $line, -file => $file,
+                    -severity => 'ERROR', 
+                    -msg => "garbled entity " . $_->raw_text()});
+                next;
+            }
+            $text .= $self->expand_entity($$contents[0]);
+        }
+        elsif($cmd eq 'L') {
+            # try to parse the hyperlink
+            my $link = Pod::Hyperlink->new($contents->raw_text());
+            unless(defined $link) {
+                $self->poderror({ -line => $line, -file => $file,
+                    -severity => 'ERROR', 
+                    -msg => "malformed link L<>: $@"});
+                next;
+            }
+            $link->line($line); # remember line
+            if($self->{-warnings}) {
+                foreach my $w ($link->warning()) {
+                    $self->poderror({ -line => $line, -file => $file,
+                        -severity => 'WARNING', 
+                        -msg => $w });
+                }
+            }
+            # check the link text
+            $text .= $self->_check_ptree($self->parse_text($link->text(),
+                $line), $line, $file, "$nestlist$cmd");
+            my $node = '';
+            $node = $self->_check_ptree($self->parse_text($link->node(),
+                $line), $line, $file, "$nestlist$cmd")
+                if($link->node());
+            # store internal link
+            # _TODO_ what if there is a link to the page itself by the name,
+            # e.g. Tk::Pod : L<Tk::Pod/"DESCRIPTION">
+            $self->hyperlink("$line:$node") if($node && !$link->page());
+        }
+        elsif($cmd =~ /[BCFIS]/) {
+            # add the guts
+            $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+        }
+        else {
+            # check, but add nothing to $text (X<>, Z<>)
+            $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+        }
+    }
+    $text;
+}
+
+# default method - just return it
+sub expand_unescaped_bracket {
+    my ($self,$bracket) = @_;
+    $bracket;
+}
+
+# keep the entities
+sub expand_entity {
+    my ($self,$entity) = @_;
+    "E<$entity>";
+}
+
+# _TODO_ overloadable methods for BC..Z<...> expansion
+
 sub verbatim { 
     ## Nothing to check
     ## my ($self, $paragraph, $line_num, $pod_para) = @_;
@@ -201,19 +552,376 @@ sub verbatim {
 
 sub textblock { 
     my ($self, $paragraph, $line_num, $pod_para) = @_;
-    my $expansion = $self->interpolate($paragraph, $line_num);
+    my ($file, $line) = $pod_para->file_line;
+    $self->_interpolate_and_check($paragraph, $line,$file);
 }
 
-sub interior_sequence { 
-    my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_;
-    my ($file, $line) = $pod_seq->file_line;
-    ## Check the sequence syntax
-    if (! $VALID_SEQUENCES{$seq_cmd}) {
-       $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR',
-                         -msg => "Unknown interior-sequence \"$seq_cmd\"" });
+# set/return nodes of the current POD
+sub node {
+    my ($self,$text) = @_;
+    if(defined $text) {
+        $text =~ s/[\s\n]+$//; # strip trailing whitespace
+        # add node
+        push(@{$self->{_nodes}}, $text);
+        return $text;
+    }
+    @{$self->{_nodes}};
+}
+
+# set/return hyperlinks of the current POD
+sub hyperlink {
+    my $self = shift;
+    if($_[0]) {
+        push(@{$self->{_links}}, $_[0]);
+        return $_[0];
+    }
+    @{$self->{_links}};
+}
+
+#-----------------------------------------------------------------------------
+# Pod::List
+#
+# class to hold POD list info (=over, =item, =back)
+#-----------------------------------------------------------------------------
+
+package Pod::List;
+
+use Carp;
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my %params = @_;
+    my $self = {%params};
+    bless $self, $class;
+    $self->initialize();
+    return $self;
+}
+
+sub initialize {
+    my $self = shift;
+    $self->{-file} ||= 'unknown';
+    $self->{-start} ||= 'unknown';
+    $self->{-indent} ||= 4; # perlpod: "should be the default"
+    $self->{_items} = [];
+}
+
+# The POD file name the list appears in
+sub file {
+   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
+}
+
+# The line in the file the node appears
+sub start {
+   return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
+}
+
+# indent level
+sub indent {
+   return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
+}
+
+# The individual =items of this list
+sub item {
+    my ($self,$item) = @_;
+    if(defined $item) {
+        push(@{$self->{_items}}, $item);
+        return $item;
     }
     else {
-       ## check syntax of the particular sequence
+        return @{$self->{_items}};
     }
 }
 
+#-----------------------------------------------------------------------------
+# Pod::Hyperlink
+#
+# class to hold hyperlinks (L<>)
+#-----------------------------------------------------------------------------
+
+package Pod::Hyperlink;
+
+=head1 NAME
+
+Pod::Hyperlink - class for manipulation of POD hyperlinks
+
+=head1 SYNOPSIS
+
+    my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');
+
+=head1 DESCRIPTION
+
+The B<Pod::Hyperlink> class is mainly designed to parse the contents of the
+C<LE<lt>...E<gt>> sequence, providing a simple interface for accessing the
+different parts of a POD hyperlink.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+The B<new()> method can either be passed a set of key/value pairs or a single
+scalar value, namely the contents of a C<LE<lt>...E<gt>> sequence. An object
+of the class C<Pod::Hyperlink> is returned. The value C<undef> indicates a
+failure, the error message is stored in C<$@>.
+
+=item parse()
+
+This method can be used to (re)parse a (new) hyperlink. The result is stored
+in the current object.
+
+=item markup($on,$off,$pageon,$pageoff)
+
+The result of this method is a string the represents the textual value of the
+link, but with included arbitrary markers that highlight the active portion
+of the link. This will mainly be used by POD translators and saves the
+effort of determining which words have to be highlighted. Examples: Depending
+on the type of link, the following text will be returned, the C<*> represent
+the places where the section/item specific on/off markers will be placed
+(link to a specific node) and C<+> for the pageon/pageoff markers (link to the
+top of the page).
+
+  the +perl+ manpage
+  the *$|* entry in the +perlvar+ manpage
+  the section on *OPTIONS* in the +perldoc+ manpage
+  the section on *DESCRIPTION* elsewhere in this document
+
+This method is read-only.
+
+=item text()
+
+This method returns the textual representation of the hyperlink as above,
+but without markers (read only).
+
+=item warning()
+
+After parsing, this method returns any warnings ecountered during the
+parsing process.
+
+=item page()
+
+This method sets or returns the POD page this link points to.
+
+=item node()
+
+As above, but the destination node text of the link.
+
+=item type()
+
+The node type, either C<section> or C<item>.
+
+=item alttext()
+
+Sets or returns an alternative text specified in the link.
+
+=item line(), file()
+
+Just simple slots for storing information about the line and the file
+the link was incountered in. Has to be filled in manually.
+
+=back
+
+=head1 AUTHOR
+
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>, borrowing
+a lot of things from L<pod2man> and L<pod2roff>.
+
+=cut
+
+use Carp;
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my $self = +{};
+    bless $self, $class;
+    $self->initialize();
+    if(defined $_[0]) {
+        if(ref($_[0])) {
+            # called with a list of parameters
+            %$self = %{$_[0]};
+        }
+        else {
+            # called with L<> contents
+            return undef unless($self->parse($_[0]));
+        }
+    }
+    return $self;
+}
+
+sub initialize {
+    my $self = shift;
+    $self->{-line} ||= 'undef';
+    $self->{-file} ||= 'undef';
+    $self->{-page} ||= '';
+    $self->{-node} ||= '';
+    $self->{-alttext} ||= '';
+    $self->{-type} ||= 'undef';
+    $self->{_warnings} = [];
+    $self->_construct_text();
+}
+
+sub parse {
+    my $self = shift;
+    local($_) = $_[0];
+    # syntax check the link and extract destination
+    my ($alttext,$page,$section,$item) = ('','','','');
+
+    # strip leading/trailing whitespace
+    if(s/^[\s\n]+//) {
+        $self->warning("ignoring leading whitespace in link");
+    }
+    if(s/[\s\n]+$//) {
+        $self->warning("ignoring trailing whitespace in link");
+    }
+
+    # collapse newlines with whitespace
+    s/\s*\n\s*/ /g;
+
+    # extract alternative text
+    if(s!^([^|/"\n]*)[|]!!) {
+        $alttext = $1;
+    }
+    # extract page
+    if(s!^([^|/"\s]*)(?=/|$)!!) {
+        $page = $1;
+    }
+    # extract section
+    if(s!^/?"([^"\n]+)"$!!) { # e.g. L</"blah blah">
+        $section = $1;
+    }
+    # extact item
+    if(s!^/(.*)$!!) {
+        $item = $1;
+    }
+    # last chance here
+    if(s!^([^|"\s\n/][^"\n/]*)$!!) { # e.g. L<lah di dah>
+        $section = $1;
+    }
+    # now there should be nothing left
+    if(length) {
+        _invalid_link("garbled entry (spurious characters `$_')");
+        return undef;
+    }
+    elsif(!(length($page) || length($section) || length($item))) {
+        _invalid_link("empty link");
+        return undef;
+    }
+    elsif($alttext =~ /[<>]/) {
+        _invalid_link("alternative text contains < or >");
+        return undef;
+    }
+    else { # no errors so far
+        if($page =~ /[(]\d\w*[)]$/) {
+             $self->warning("brackets in `$page'");
+             $page = $`; # strip that extension
+        }
+        if($page =~ /^(\s*)(\S+)(\s*)/ && (length($1) || length($3))) {
+             $self->warning("whitespace in `$page'");
+             $page = $2; # strip that extension
+        }
+    }
+    $self->page($page);
+    $self->node($section || $item); # _TODO_ do not distinguish for now
+    $self->alttext($alttext);
+    $self->type($item ? 'item' : 'section');
+    1;
+}
+
+sub _construct_text {
+    my $self = shift;
+    my $alttext = $self->alttext();
+    my $type = $self->type();
+    my $section = $self->node();
+    my $page = $self->page();
+    $self->{_text} =
+        $alttext ? $alttext : (
+        !$section       ? '' :
+        $type eq 'item' ? 'the ' . $section . ' entry' :
+                          'the section on ' . $section ) .
+        ($page ? ($section ? ' in ':''). 'the ' . $page . ' manpage' :
+                'elsewhere in this document');
+    # for being marked up later
+    $self->{_markup} =
+        $alttext ? '<SECTON>' . $alttext . '<SECTOFF>' : (
+        !$section      ? '' : 
+        $type eq 'item' ? 'the <SECTON>' . $section . '<SECTOFF> entry' :
+                          'the section on <SECTON>' . $section . '<SECTOFF>' ) .
+        ($page ? ($section ? ' in ':'') . 'the <PAGEON>' .
+            $page . '<PAGEOFF> manpage' :
+        ' elsewhere in this document');
+}
+
+# include markup
+sub markup {
+    my ($self,$on,$off,$pageon,$pageoff) = @_;
+    $on ||= '';
+    $off ||= '';
+    $pageon ||= '';
+    $pageoff ||= '';
+    $_[0]->_construct_text;
+    my $str = $self->{_markup};
+    $str =~ s/<SECTON>/$on/;
+    $str =~ s/<SECTOFF>/$off/;
+    $str =~ s/<PAGEON>/$pageon/;
+    $str =~ s/<PAGEOFF>/$pageoff/;
+    return $str;
+}
+
+# The complete link's text
+sub text {
+    $_[0]->_construct_text();
+    $_[0]->{_text};
+}
+
+# The POD page the link appears on
+sub warning {
+   my $self = shift;
+   if(@_) {
+       push(@{$self->{_warnings}}, @_);
+       return @_;
+   }
+   return @{$self->{_warnings}};
+}
+
+# The POD file name the link appears in
+sub file {
+   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
+}
+
+# The line in the file the link appears
+sub line {
+   return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
+}
+
+# The POD page the link appears on
+sub page {
+   return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
+}
+
+# The link destination
+sub node {
+   return (@_ > 1) ? ($_[0]->{-node} = $_[1]) : $_[0]->{-node};
+}
+
+# Potential alternative text
+sub alttext {
+   return (@_ > 1) ? ($_[0]->{-alttext} = $_[1]) : $_[0]->{-alttext};
+}
+
+# The type
+sub type {
+   return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
+}
+
+sub _invalid_link {
+    my ($msg) = @_;
+    # this sets @_
+    #eval { die "$msg\n" };
+    #chomp $@;
+    $@ = $msg; # this seems to work, too!
+    undef;
+}
+
+1;
diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm
index f7231e596c..1432895e91 100644
--- a/lib/Pod/InputObjects.pm
+++ b/lib/Pod/InputObjects.pm
@@ -11,7 +11,7 @@
 package Pod::InputObjects;
 
 use vars qw($VERSION);
-$VERSION = 1.085;  ## Current version of this package
+$VERSION = 1.090;  ## Current version of this package
 require  5.004;    ## requires this Perl version or later
 
 #############################################################################
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
index 8ef5a59f62..c9c67bd8e2 100644
--- a/lib/Pod/Parser.pm
+++ b/lib/Pod/Parser.pm
@@ -10,7 +10,7 @@
 package Pod::Parser;
 
 use vars qw($VERSION);
-$VERSION = 1.085;  ## Current version of this package
+$VERSION = 1.091;  ## Current version of this package
 require  5.004;    ## requires this Perl version or later
 
 #############################################################################
@@ -164,7 +164,7 @@ the POD sections of the input. Input paragraphs that are not part
 of the POD-format documentation are not made available to the caller
 (not even using B<preprocess_paragraph()>). Setting this option to a
 non-empty, non-zero value will allow B<preprocess_paragraph()> to see
-non-POD sectioins of the input as well as POD sections. The B<cutting()>
+non-POD sections of the input as well as POD sections. The B<cutting()>
 method can be used to determine if the corresponding paragraph is a POD
 paragraph, or some other input paragraph.
 
@@ -587,18 +587,20 @@ The value returned should correspond to the new text to use in its
 place If the empty string is returned or an undefined value is
 returned, then the given C<$text> is ignored (not processed).
 
-This method is invoked after gathering up all thelines in a paragraph
+This method is invoked after gathering up all the lines in a paragraph
+and after determining the cutting state of the paragraph,
 but before trying to further parse or interpret them. After
 B<preprocess_paragraph()> returns, the current cutting state (which
 is returned by C<$self-E<gt>cutting()>) is examined. If it evaluates
-to false then input text (including the given C<$text>) is cut (not
+to true then input text (including the given C<$text>) is cut (not
 processed) until the next POD directive is encountered.
 
 Please note that the B<preprocess_line()> method is invoked I<before>
 the B<preprocess_paragraph()> method. After all (possibly preprocessed)
-lines in a paragraph have been assembled together and it has been
+lines in a paragraph have been assembled together and either it has been
 determined that the paragraph is part of the POD documentation from one
-of the selected sections, then B<preprocess_paragraph()> is invoked.
+of the selected sections or the C<-want_nonPODs> option is true, 
+then B<preprocess_paragraph()> is invoked.
 
 The base class implementation of this method returns the given text.
 
@@ -876,17 +878,16 @@ sub parse_paragraph {
     local $_;
 
     ## See if we want to preprocess nonPOD paragraphs as well as POD ones.
-    my $wantNonPods = $myOpts{'-want_nonPODs'} || 0;
+    my $wantNonPods = $myOpts{'-want_nonPODs'};
+
+    ## Update cutting status
+    $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/;
 
     ## Perform any desired preprocessing if we wanted it this early
     $wantNonPods  and  $text = $self->preprocess_paragraph($text, $line_num);
 
-    ## This is the end of a non-empty paragraph
     ## Ignore up until next POD directive if we are cutting
-    if ($myData{_CUTTING}) {
-       return  unless ($text =~ /^={1,2}\S/);
-       $myData{_CUTTING} = 0;
-    }
+    return if $myData{_CUTTING};
 
     ## Now we know this is block of text in a POD section!
 
@@ -1196,7 +1197,7 @@ builtin is used to issue error messages (this is the default behavior).
             my $errorsub = $parser->errorsub()
             my $errmsg = "This is an error message!\n"
             (ref $errorsub) and &{$errorsub}($errmsg)
-                or (defined $errmsg) and $parser->$errorsub($errmsg)
+                or (defined $errorsub) and $parser->$errorsub($errmsg)
                     or  warn($errmsg);
 
 Returns a method name, or else a reference to the user-supplied subroutine
diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm
index e634533522..94ded8697a 100644
--- a/lib/Pod/Select.pm
+++ b/lib/Pod/Select.pm
@@ -10,7 +10,7 @@
 package Pod::Select;
 
 use vars qw($VERSION);
-$VERSION = 1.085;  ## Current version of this package
+$VERSION = 1.090;  ## Current version of this package
 require  5.004;    ## requires this Perl version or later
 
 #############################################################################
diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm
index 18fa22598f..6e6fb7bb80 100644
--- a/lib/Pod/Usage.pm
+++ b/lib/Pod/Usage.pm
@@ -10,7 +10,7 @@
 package Pod::Usage;
 
 use vars qw($VERSION);
-$VERSION = 1.085;  ## Current version of this package
+$VERSION = 1.090;  ## Current version of this package
 require  5.004;    ## requires this Perl version or later
 
 =head1 NAME
diff --git a/makedef.pl b/makedef.pl
index 428bfc38b4..40c9be3a26 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -369,6 +369,9 @@ unless ($define{'USE_ITHREADS'})
   skip_symbols [qw(
 PL_ptr_table
 Perl_dirp_dup
+Perl_cx_dup
+Perl_si_dup
+Perl_ss_dup
 Perl_fp_dup
 Perl_gp_dup
 Perl_he_dup
diff --git a/objXSUB.h b/objXSUB.h
index 8077c9dc26..e8b1ffb838 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -3534,6 +3534,18 @@
 #undef  boot_core_xsutils
 #define boot_core_xsutils	Perl_boot_core_xsutils
 #if defined(USE_ITHREADS)
+#undef  Perl_cx_dup
+#define Perl_cx_dup		pPerl->Perl_cx_dup
+#undef  cx_dup
+#define cx_dup			Perl_cx_dup
+#undef  Perl_si_dup
+#define Perl_si_dup		pPerl->Perl_si_dup
+#undef  si_dup
+#define si_dup			Perl_si_dup
+#undef  Perl_ss_dup
+#define Perl_ss_dup		pPerl->Perl_ss_dup
+#undef  ss_dup
+#define ss_dup			Perl_ss_dup
 #undef  Perl_he_dup
 #define Perl_he_dup		pPerl->Perl_he_dup
 #undef  he_dup
diff --git a/perl.c b/perl.c
index 093ac2fab1..9f3a8ae160 100644
--- a/perl.c
+++ b/perl.c
@@ -2690,7 +2690,7 @@ Perl_init_stacks(pTHX)
     PL_markstack_ptr = PL_markstack;
     PL_markstack_max = PL_markstack + REASONABLE(32);
 
-    SET_MARKBASE;
+    SET_MARK_OFFSET;
 
     New(54,PL_scopestack,REASONABLE(32),I32);
     PL_scopestack_ix = 0;
diff --git a/perlapi.c b/perlapi.c
index 2a7899cb37..02795ad30d 100755
--- a/perlapi.c
+++ b/perlapi.c
@@ -4857,6 +4857,27 @@ Perl_boot_core_xsutils(pTHXo)
 }
 #if defined(USE_ITHREADS)
 
+#undef  Perl_cx_dup
+PERL_CONTEXT*
+Perl_cx_dup(pTHXo_ PERL_CONTEXT* cx, I32 ix, I32 max)
+{
+    return ((CPerlObj*)pPerl)->Perl_cx_dup(cx, ix, max);
+}
+
+#undef  Perl_si_dup
+PERL_SI*
+Perl_si_dup(pTHXo_ PERL_SI* si)
+{
+    return ((CPerlObj*)pPerl)->Perl_si_dup(si);
+}
+
+#undef  Perl_ss_dup
+ANY*
+Perl_ss_dup(pTHXo_ ANY* ss, I32 ix, I32 max)
+{
+    return ((CPerlObj*)pPerl)->Perl_ss_dup(ss, ix, max);
+}
+
 #undef  Perl_he_dup
 HE*
 Perl_he_dup(pTHXo_ HE* e, bool shared)
diff --git a/pod/podchecker.PL b/pod/podchecker.PL
index 89c2899248..f7a820d0f7 100644
--- a/pod/podchecker.PL
+++ b/pod/podchecker.PL
@@ -45,7 +45,7 @@ print OUT <<'!NO!SUBS!';
 #############################################################################
 
 use strict;
-use diagnostics;
+#use diagnostics;
 
 =head1 NAME
 
@@ -53,7 +53,7 @@ podchecker - check the syntax of POD format documentation files
 
 =head1 SYNOPSIS
 
-B<podchecker> [B<-help>] [B<-man>] [I<file>S< >...]
+B<podchecker> [B<-help>] [B<-man>] [B<-(no)warnings>] [I<file>S< >...]
 
 =head1 OPTIONS AND ARGUMENTS
 
@@ -67,6 +67,10 @@ Print a brief help message and exit.
 
 Print the manual page and exit.
 
+=item B<-warnings> B<-nowarnings>
+
+Turn on/off printing of warnings.
+
 =item I<file>
 
 The pathname of a POD file to syntax-check (defaults to standard input).
@@ -83,13 +87,30 @@ indicating the number of errors found.
 B<podchecker> invokes the B<podchecker()> function exported by B<Pod::Checker>
 Please see L<Pod::Checker/podchecker()> for more details.
 
+=head1 RETURN VALUE
+
+B<podchecker> returns a 0 (zero) exit status if all specified
+POD files are ok.
+
+=head1 ERRORS
+
+B<podchecker> returns the exit status 1 if at least one of
+the given POD files has syntax errors.
+
+The status 2 indicates that at least one of the specified 
+files does not contain I<any> POD commands.
+
+Status 1 overrides status 2. If you want unambigouus
+results, call B<podchecker> with one single argument only.
+
 =head1 SEE ALSO
 
 L<Pod::Parser> and L<Pod::Checker>
 
-=head1 AUTHOR
+=head1 AUTHORS
 
-Brad Appleton E<lt>bradapp@enteract.comE<gt>
+Brad Appleton E<lt>bradapp@enteract.comE<gt>,
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
 
 Based on code for B<Pod::Text::pod2text(1)> written by
 Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
@@ -105,10 +126,11 @@ use Getopt::Long;
 my %options = (
         "help"     => 0,
         "man"      => 0,
+        "warnings" => 1,
 );
 
 ## Parse options
-GetOptions(\%options, "help", "man")  ||  pod2usage(2);
+GetOptions(\%options, "help", "man", "warnings!")  ||  pod2usage(2);
 pod2usage(1)  if ($options{help});
 pod2usage(-verbose => 2)  if ($options{man});
 
@@ -116,11 +138,20 @@ pod2usage(-verbose => 2)  if ($options{man});
 pod2usage(2) if ((@ARGV == 0) && (-t STDIN));
 
 ## Invoke podchecker()
-if(@ARGV) {
-   for (@ARGV) { podchecker($_) };
-} else {
-	podchecker("<&STDIN");
+my $status = 0;
+@ARGV = ("<&STDIN") unless(@ARGV);
+for (@ARGV) {
+    my $s = podchecker($_, undef, '-warnings' => $options{warnings});
+    if($s > 0) {
+        # errors occurred
+        $status = 1;
+    }
+    elsif($s < 0) {
+        # no pod found
+        $status = 2 unless($status);
+    }
 }
+exit $status;
 
 !NO!SUBS!
 
diff --git a/pp_sys.c b/pp_sys.c
index b2495a06dc..ebc5e2776c 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3582,7 +3582,22 @@ PP(pp_fork)
     PUSHi(childpid);
     RETURN;
 #else
+#  ifdef USE_ITHREADS
+    /* XXXXXX testing */
+    djSP; dTARGET;
+    /* XXX this just an approximation of what will eventually be run
+     * in a different thread */
+    PerlInterpreter *new_perl = perl_clone(my_perl, 0);
+    Perl_pp_enter(new_perl);
+    new_perl->Top = new_perl->Top->op_next; /* continue from next op */
+    CALLRUNOPS(new_perl);
+
+    /* parent returns with negative pseudo-pid */
+    PUSHi(-1);
+    RETURN;
+#  else
     DIE(aTHX_ PL_no_func, "Unsupported function fork");
+#  endif
 #endif
 }
 
diff --git a/proto.h b/proto.h
index db5e85d9c2..b0af759cc9 100644
--- a/proto.h
+++ b/proto.h
@@ -739,6 +739,9 @@ PERL_CALLCONV void	Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, O
 PERL_CALLCONV OP *	Perl_my_attrs(pTHX_ OP *o, OP *attrs);
 PERL_CALLCONV void	Perl_boot_core_xsutils(pTHX);
 #if defined(USE_ITHREADS)
+PERL_CALLCONV PERL_CONTEXT*	Perl_cx_dup(pTHX_ PERL_CONTEXT* cx, I32 ix, I32 max);
+PERL_CALLCONV PERL_SI*	Perl_si_dup(pTHX_ PERL_SI* si);
+PERL_CALLCONV ANY*	Perl_ss_dup(pTHX_ ANY* ss, I32 ix, I32 max);
 PERL_CALLCONV HE*	Perl_he_dup(pTHX_ HE* e, bool shared);
 PERL_CALLCONV REGEXP*	Perl_re_dup(pTHX_ REGEXP* r);
 PERL_CALLCONV PerlIO*	Perl_fp_dup(pTHX_ PerlIO* fp, char type);
diff --git a/sv.c b/sv.c
index ae22960afc..746f92956d 100644
--- a/sv.c
+++ b/sv.c
@@ -5842,8 +5842,6 @@ Perl_sv_dup(pTHX_ SV *sstr)
     if (dstr)
 	return dstr;
 
-    /* XXX TODO: sanity-check sv_dup() vs sv_dup_inc() appropriateness */
-
     /* create anew and remember what it is */
     new_SV(dstr);
     ptr_table_store(PL_ptr_table, sstr, dstr);
@@ -6151,6 +6149,65 @@ dup_pvcv:
     return dstr;
 }
 
+PERL_CONTEXT *
+Perl_cx_dup(pTHX_ PERL_CONTEXT *cx, I32 ix, I32 max)
+{
+    PERL_CONTEXT *ncx;
+
+    if (!cx)
+	return (PERL_CONTEXT*)NULL;
+
+    /* look for it in the table first */
+    ncx = ptr_table_fetch(PL_ptr_table, cx);
+    if (ncx)
+	return ncx;
+
+    /* create anew and remember what it is */
+    Newz(56, ncx, max + 1, PERL_CONTEXT);
+    ptr_table_store(PL_ptr_table, cx, ncx);
+
+    /* XXX todo */
+    /* ... */
+
+    return ncx;
+}
+
+PERL_SI *
+Perl_si_dup(pTHX_ PERL_SI *si)
+{
+    PERL_SI *nsi;
+
+    if (!si)
+	return (PERL_SI*)NULL;
+
+    /* look for it in the table first */
+    nsi = ptr_table_fetch(PL_ptr_table, si);
+    if (nsi)
+	return nsi;
+
+    /* create anew and remember what it is */
+    Newz(56, nsi, 1, PERL_SI);
+    ptr_table_store(PL_ptr_table, si, nsi);
+
+    nsi->si_stack	= av_dup_inc(si->si_stack);
+    nsi->si_cxix	= si->si_cxix;
+    nsi->si_cxmax	= si->si_cxmax;
+    nsi->si_cxstack	= cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax);
+    nsi->si_type	= si->si_type;
+    nsi->si_prev	= si_dup(si->si_prev);
+    nsi->si_next	= si_dup(si->si_next);
+    nsi->si_markoff	= si->si_markoff;
+
+    return nsi;
+}
+
+ANY *
+Perl_ss_dup(pTHX_ ANY *ss, I32 ix, I32 max)
+{
+    /* XXX todo */
+    return NULL;
+}
+
 PerlInterpreter *
 perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 		 struct IPerlMem* ipM, struct IPerlEnv* ipE,
@@ -6572,37 +6629,67 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     /* thrdvar.h stuff */
 
-/*    PL_curstackinfo	= clone_stackinfo(proto_perl->Tcurstackinfo);
-    clone_stacks();
-    PL_mainstack	= av_dup(proto_perl->Tmainstack);
-    PL_curstack		= av_dup(proto_perl->Tcurstack);
-
-    PL_stack_max	= (SV**)0;
-    PL_stack_base	= (SV**)0;
-    PL_stack_sp		= (SV**)0;
-
-    PL_scopestack	= (I32*)0;
-    PL_scopestack_ix	= (I32)0;
-    PL_scopestack_max	= (I32)0;
-
-    PL_savestack	= (ANY*)0;
-    PL_savestack_ix	= (I32)0;
-    PL_savestack_max	= (I32)0;
-
-    PL_tmps_stack	= (SV**)0;
-    PL_tmps_ix		= (I32)-1;
-    PL_tmps_floor	= (I32)-1;
-    PL_tmps_max		= (I32)0;
-
-    PL_markstack	= (I32*)0;
-    PL_markstack_ptr	= (I32*)0;
-    PL_markstack_max	= (I32*)0;
-
-    PL_retstack		= (OP**)0;
-    PL_retstack_ix	= (I32)0;
-    PL_retstack_max	= (I32)0;
-*/	/* XXXXXX */
-    init_stacks();
+    if (flags & 1) {
+	/* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */
+	PL_tmps_ix		= proto_perl->Ttmps_ix;
+	PL_tmps_max		= proto_perl->Ttmps_max;
+	PL_tmps_floor		= proto_perl->Ttmps_floor;
+	Newz(50, PL_tmps_stack, PL_tmps_max, SV*);
+	i = 0;
+	while (i <= PL_tmps_ix) {
+	    PL_tmps_stack[i]	= sv_dup_inc(proto_perl->Ttmps_stack[i]);
+	    ++i;
+	}
+
+	/* next PUSHMARK() sets *(PL_markstack_ptr+1) */
+	i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack;
+	Newz(54, PL_markstack, i, I32);
+	PL_markstack_max	= PL_markstack + (proto_perl->Tmarkstack_max
+						  - proto_perl->Tmarkstack);
+	PL_markstack_ptr	= PL_markstack + (proto_perl->Tmarkstack_ptr
+						  - proto_perl->Tmarkstack);
+	Copy(proto_perl->Tmarkstack, PL_markstack,
+	     PL_markstack_ptr - PL_markstack + 1, I32);
+
+	/* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix]
+	 * NOTE: unlike the others! */
+	PL_scopestack_ix	= proto_perl->Tscopestack_ix;
+	PL_scopestack_max	= proto_perl->Tscopestack_max;
+	Newz(54, PL_scopestack, PL_scopestack_max, I32);
+	Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32);
+
+	/* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix]
+	 * NOTE: unlike the others! */
+	PL_savestack_ix		= proto_perl->Tsavestack_ix;
+	PL_savestack_max	= proto_perl->Tsavestack_max;
+	/*Newz(54, PL_savestack, PL_savestack_max, ANY);*/
+	PL_savestack		= ss_dup(proto_perl->Tsavestack,
+					 PL_savestack_ix,
+					 PL_savestack_max);
+
+	/* next push_return() sets PL_retstack[PL_retstack_ix]
+	 * NOTE: unlike the others! */
+	PL_retstack_ix		= proto_perl->Tretstack_ix;
+	PL_retstack_max		= proto_perl->Tretstack_max;
+	Newz(54, PL_retstack, PL_retstack_max, OP*);
+	Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32);
+
+	/* NOTE: si_dup() looks at PL_markstack */
+	PL_curstackinfo		= si_dup(proto_perl->Tcurstackinfo);
+
+	/* PL_curstack		= PL_curstackinfo->si_stack; */
+	PL_curstack		= av_dup(proto_perl->Tcurstack);
+	PL_mainstack		= av_dup(proto_perl->Tmainstack);
+
+	/* next PUSHs() etc. set *(PL_stack_sp+1) */
+	PL_stack_base		= AvARRAY(PL_curstack);
+	PL_stack_sp		= PL_stack_base + (proto_perl->Tstack_sp
+						   - proto_perl->Tstack_base);
+	PL_stack_max		= PL_stack_base + AvMAX(PL_curstack);
+    }
+    else {
+	init_stacks();
+    }
 
     PL_start_env	= proto_perl->Tstart_env;	/* XXXXXX */
     PL_top_env		= &PL_start_env;
diff --git a/t/pod/poderrs.t b/t/pod/poderrs.t
index 9cbbeeeb91..9f7f6bd341 100755
--- a/t/pod/poderrs.t
+++ b/t/pod/poderrs.t
@@ -36,4 +36,81 @@ Camps is very,
 entertaining.
 And they say we'll have some fun if it stops raining!
 
+=head1 Additional tests
+
+=head2 item without over
+
+=item oops
+
+=head2 back without over
+
+=back
+
+=head2 over without back
+
+=over 4
+
+=item oops
+
+=head2 end without begin
+
+=end
+
+=head2 begin and begin
+
+=begin html
+
+=begin text
+
+=end
+
+=end
+
+=head2 Nested sequences of the same type
+
+C<code I<italic C<code again!>>>
+
+=head2 Garbled entities
+
+E<alea iacta est>
+E<C<auml>>
+E<abcI<bla>>
+
+=head2 Unresolved internal links
+
+L</"begin or begin">
+L<"end with begin">
+L</OoPs>
+
+=head2 Garbled (almost) links
+
+L<s s / s s / ss>
+L<".".":">
+L<"h"/"hh">
+L<a|b|c>
+
+=head2 Warnings
+
+L<passwd(5)>
+L<   some text|page/"section"   >
+
+=over 4
+
+=item bla
+
+=back 200
+
+=begin html
+
+What?
+
+=end xml
+
+=over 4
+
+=back
+
+see these unescaped < and > in the text?
+
 =cut
+
diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr
index 82d402d8b2..70408cd2f4 100644
--- a/t/pod/poderrs.xr
+++ b/t/pod/poderrs.xr
@@ -3,9 +3,33 @@
 *** ERROR: Unknown interior-sequence "D" at line 22 in file pod/poderrs.t
 *** ERROR: Unknown interior-sequence "Q" at line 25 in file pod/poderrs.t
 *** ERROR: Unknown interior-sequence "A" at line 26 in file pod/poderrs.t
-*** ERROR: Unknown interior-sequence "V" at line 27 in file pod/poderrs.t
 *** ERROR: Unknown interior-sequence "Y" at line 27 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence "V" at line 27 in file pod/poderrs.t
 ** Unterminated B<...> at pod/poderrs.t line 31
 ** Unterminated I<...> at pod/poderrs.t line 30
 ** Unterminated C<...> at pod/poderrs.t line 33
-pod/poderrs.t has 10 pod syntax errors.
+*** ERROR: =item without previous =over at line 43 in file pod/poderrs.t
+*** ERROR: =back without previous =over at line 47 in file pod/poderrs.t
+*** ERROR: unclosed =over (line 51) at head2 at line 55 in file pod/poderrs.t
+*** WARNING: =end without =begin at line 57 in file pod/poderrs.t
+*** ERROR: Nested =begin's (first at line 61:html) at line 63 in file pod/poderrs.t
+*** WARNING: =end without =begin at line 67 in file pod/poderrs.t
+*** ERROR: nested commands C<...C<...>...> at line 71 in file pod/poderrs.t
+*** ERROR: garbled entity E<alea iacta est> at line 75 in file pod/poderrs.t
+*** ERROR: garbled entity E<C<auml>> at line 76 in file pod/poderrs.t
+*** ERROR: garbled entity E<abcI<bla>> at line 77 in file pod/poderrs.t
+*** ERROR: malformed link L<>: garbled entry (spurious characters `s s / s s / ss') at line 87 in file pod/poderrs.t
+*** ERROR: malformed link L<>: garbled entry (spurious characters `".".":"') at line 88 in file pod/poderrs.t
+*** ERROR: malformed link L<>: garbled entry (spurious characters `"h"/"hh"') at line 89 in file pod/poderrs.t
+*** WARNING: brackets in `passwd(5)' at line 94 in file pod/poderrs.t
+*** WARNING: ignoring leading whitespace in link at line 95 in file pod/poderrs.t
+*** WARNING: ignoring trailing whitespace in link at line 95 in file pod/poderrs.t
+*** WARNING: Spurious character(s) after =back at line 101 in file pod/poderrs.t
+*** WARNING: Spurious character(s) after =end at line 107 in file pod/poderrs.t
+*** WARNING: No items in =over (at line 109) / =back list at line 111 in file pod/poderrs.t
+*** WARNING: 2 unescaped <> at line 113 in file pod/poderrs.t
+*** ERROR: unresolved internal link `begin or begin' at line 81 in file pod/poderrs.t
+*** ERROR: unresolved internal link `end with begin' at line 82 in file pod/poderrs.t
+*** ERROR: unresolved internal link `OoPs' at line 83 in file pod/poderrs.t
+*** ERROR: unresolved internal link `b|c' at line 90 in file pod/poderrs.t
+pod/poderrs.t has 25 pod syntax errors.