develooper Front page | perl.perl5.porters | Postings from July 2003

[PATCH] test for B::Bytecode/ByteLoader

From:
Enache Adrian
Date:
July 30, 2003 17:43
Subject:
[PATCH] test for B::Bytecode/ByteLoader
Message ID:
20030731004940.GB1266@ratsnest.hole
Purpose: test the basic functionality of B::Bytecode/ByteLoader.
(which was completely broken in 5.8.0, but now works again).

Regards,
Adi

--- /arc/bleadperl/MANIFEST	2003-07-30 13:44:56.000000000 +0300
+++ blead/MANIFEST	2003-07-31 03:26:30.000000000 +0300
@@ -109,6 +109,7 @@
 ext/B/t/assembler.t	See if B::Assembler, B::Disassembler comply
 ext/B/t/b.t		See if B works
 ext/B/t/bblock.t	See if B::Bblock works
+ext/B/t/bytecode.t	See whether B::Bytecode works
 ext/B/t/concise.t	See whether B::Concise works
 ext/B/t/debug.t		See if B::Debug works
 ext/B/t/deparse.t	See if B::Deparse works
--- /arc/bleadperl/ext/B/t/bytecode.t	1970-01-01 02:00:00.000000000 +0200
+++ blead/ext/B/t/bytecode.t	2003-07-31 03:43:08.000000000 +0300
@@ -0,0 +1,139 @@
+#! perl
+
+BEGIN { chdir 't' if -d 't'; @INC = qw(../lib) }
+use strict;
+
+my $test = 'bytecode.tmp';
+END { 1 while unlink $test }
+
+undef $/;
+my @tests = split /\n###+\n/, <DATA>;
+
+print "1..".($#tests+1)."\n";
+
+my $cnt = 1;
+for (@tests) {
+    my $got;
+    my ($script, $expect) = split />>>+\n/;
+    $expect =~ s/\n$//;
+    open T, ">$test"; print T $script; close T;
+    $got =`$^X -MO=Bytecode,-H,-o$test $test 2>&1`;
+    unless ($?) {
+	$got = `$^X $test`;
+	unless ($?) {
+	    if ($got =~ /^$expect$/) {
+		print "ok $cnt\n";
+		next;
+	    } else {
+		print <<"EOT"; next;
+not ok $cnt
+--------- SCRIPT
+$script
+--------- GOT
+$got
+--------- EXPECT
+$expect
+----------------
+
+EOT
+	    }
+	}
+    }
+    print <<"EOT";
+--------- SCRIPT
+$script
+--------- $?
+$got
+EOT
+} continue {
+    $cnt++;
+}
+
+__DATA__
+
+print 'hi'
+>>>>
+hi
+############################################################
+for (1,2,3) { print if /\d/ }
+>>>>
+123
+############################################################
+$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/ge; print $_
+>>>>
+zzz2y2y2
+############################################################
+$_ = "xyxyx"; %j=(1,2); s/x/$j{print('z')}/g; print $_
+>>>>
+z2y2y2
+############################################################
+split /a/,"bananarama"; print @_
+>>>>
+bnnrm
+############################################################
+{ package P; sub x { print 'ya' } x }
+>>>>
+ya
+############################################################
+@z = split /:/,"b:r:n:f:g"; print @z
+>>>>
+brnfg
+############################################################
+sub AUTOLOAD { print 1 } &{"a"}()
+>>>>
+1
+############################################################
+my $l = 3; $x = sub { print $l }; &$x
+>>>>
+3
+############################################################
+my $i = 1;
+my $foo = sub {$i = shift if @_};
+&$foo(3);
+############################################################
+print <.*>
+>>>>
+..*
+############################################################
+$_="\xff\xff"; use utf8; utf8::encode $_; print $_
+>>>>
+\xc3\xbf\xc3\xbf
+############################################################
+$x="Cannot use"; print index $x, "Can"
+>>>>
+0
+############################################################
+my $i=6; eval "print \$i\n"
+>>>>
+6
+############################################################
+BEGIN { %h=(1=>2,3=>4) } print $h{3}
+>>>>
+4
+############################################################
+open our $T,"a"
+############################################################
+print <DATA>
+__DATA__
+a
+b
+>>>>
+a
+b
+############################################################
+BEGIN { tie @a, __PACKAGE__; sub TIEARRAY { bless{} } sub FETCH { 1 } }
+print $a[1]
+>>>>
+1
+############################################################
+my $i=3; print 1 .. $i
+>>>>
+123
+############################################################
+my $h = { a=>3, b=>1 }; print sort {$h->{$a} <=> $h->{$b}} keys %$h
+>>>>
+ba
+############################################################
+print sort { my $p; $b <=> $a } 1,4,3
+>>>>
+431



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About