author-test all code examples

MANIFEST

@@ -82,7 +82,6 @@ t/16_subclass.t
 t/99_end.t
 t/no_const.class
 t/no_const.java
-t/pod_test.pl
 t/shared.java
 t/t13.txt
 t/t16subclass.jar
@@ -91,3 +90,4 @@ t/types.class
 t/types.java
 TODO
 xt/manifest.t
+xt/pod_test.t

t/pod_test.pl → xt/pod_test.t

@@ -1,10 +1,11 @@
 use strict ;
-
-use blib ;
+use warnings ;
+use Test::More;
 use Getopt::Long ;
-
 require Inline::Java ;
+use Cwd;
 
+my $start_dir = getcwd;
 my %opts = () ;
 GetOptions (\%opts,
 	"d",    	# debug
@@ -14,8 +15,13 @@
 
 my $skip_to = $opts{s} || 0 ;
 my $cnt = -1 ;
+my @PODS = qw(
+  lib/Inline/Java.pod
+  lib/Inline/Java/Callback.pod
+);
+#push @PODS, 'Java/PerlNatives/PerlNatives.pod' if 
 
-foreach my $podf ('Java.pod', 'Java/Callback.pod', 'Java/PerlNatives/PerlNatives.pod'){
+foreach my $podf (@PODS) {
 	open(POD, "<$podf") or 
 		die("Can't open $podf file") ;
 	my $pod = join("", <POD>) ;
@@ -25,49 +31,45 @@
 
 	my @code_blocks = ($pod =~ m/$del(.*?)$del/gs) ;
 
-	foreach my $code (@code_blocks){
+	foreach my $code (@code_blocks) {
 		$cnt++ ;
 
 		if ((defined($opts{o}))&&($opts{o} != $cnt)){
-			print "skipped\n" ;
+			note "skipped $cnt";
 			next ;
 		}
-
 		if ($cnt < $skip_to){
-			print "skipped\n" ;
+			note "skipped $cnt";
 			next ;
 		}
-
-		print "-> Code Block $cnt ($podf)\n" ;
-
-		$code =~ s/(\n)(   )/$1/gs ;  
-		$code =~ s/(((END(_OF_JAVA_CODE)?)|STUDY)\')/$1, NAME => "main::main" / ;  
-		$code =~ s/(STUDY\')/$1, AUTOSTUDY => 1 / ;  
-
-		if (($code =~ /SHARED_JVM/)&&($opts{o} != $cnt)){
-			print "skipped\n" ;
+		if (
+		  ($code =~ /shared_jvm/) &&
+		  !(defined($opts{o}) && ($opts{o} == $cnt))
+		) {
+			note "skipped $cnt, shared_jvm";
 			next ;
 		}
 
+		note "-> Code Block $cnt ($podf)";
+
+		$code =~ s/(\n)(   )/$1/gs ;
 		$code =~ s/print\((.*) \. \"\\n\"\) ; # prints (.*)/{
-			"print (((($1) eq ('$2')) ? \"ok\" : \"not ok ('$1' ne '$2')\") . \"\\n\") ;" ;
+			"is(($1), ('$2'));" ;
 		}/ge ;
 
-		my $Entry = '$Entry' ;
 		debug($code) ;
 
 		eval $code ;
-		if ($@){
-			die $@ ;
-		}
+		is $@, '' or diag "Failed: $code";
+		chdir $start_dir; # I::J does chdir which is bad if blows up
 	}
 }
 
+done_testing;
 
 sub debug {
 	my $msg = shift ;
 	if ($opts{d}){
-		print $msg ;
+		diag $msg ;
 	}
 }
-