From: chromatic <chromatic@wgz.org>
Date: Sat, 1 Dec 2001 12:41:58 +0000 (-0700)
Subject: Strictures, dual variables
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4eba29c16427db5c6e3c4ba0fcffbe875258d98d;p=p5sagit%2Fp5-mst-13.2.git

Strictures, dual variables
Message-ID: <20011201194946.50449.qmail@onion.perl.org>

p4raw-id: //depot/perl@13415
---

diff --git a/lib/DB.t b/lib/DB.t
index 0b4548c..401c1af 100644
--- a/lib/DB.t
+++ b/lib/DB.t
@@ -1,10 +1,18 @@
-#!./perl
+#!./perl -w
 
 BEGIN {
 	chdir 't' if -d 't';
 	@INC = '../lib';
 }
 
+# symbolic references used later
+use strict qw( vars subs );
+
+# @DB::dbline values have both integer and string components (Benjamin Goldberg)
+use Scalar::Util qw( dualvar );
+my $dualfalse = dualvar(0, 'false');
+my $dualtrue = dualvar(1, 'true');
+
 use Test::More tests => 106;
 
 # must happen at compile time for DB:: package variable localizations to work
@@ -198,6 +206,7 @@ SKIP: {
 
 	my $db = DB->loadfile($file);
 	like( $db, qr!$file\z!, '... should find loaded file from partial name');
+
 	is( *DB::dbline, *{ "_<$db" } , 
 		'... should set *DB::dbline to associated glob');
 	is( $DB::filename, $db, '... should set $DB::filename to file name' );
@@ -207,9 +216,12 @@ SKIP: {
 
 # test DB::lineevents()
 {
+	use vars qw( *baz );
+
 	local $DB::filename = 'baz';
 	local *baz = *{ "main::_<baz" };
-	@baz = ( 1 .. 5 );
+	
+	@baz = map { dualvar(1, $_) } qw( one two three four five );
 	%baz = (
 		1 => "foo\0bar",
 		3 => "boo\0far",
@@ -219,7 +231,7 @@ SKIP: {
 	is( scalar keys %ret, 3, 'DB::lineevents() should pick up defined lines' );
 
 	# array access in DB::lineevents() starts at element 1, not 0
-	is( join(' ', @{ $ret{1} }), '2 foo bar', '... should stash data in hash');
+	is( join(' ', @{ $ret{1} }), 'two foo bar', '... should stash data in hash');
 }
 
 # test DB::set_break()
@@ -233,7 +245,7 @@ SKIP: {
 		4 => "\0abc",
 	);
 
-	*DB::dbline = [ 0, 1, 0, 0, 1 ];
+	*DB::dbline = [ $dualfalse, $dualtrue, $dualfalse, $dualfalse, $dualtrue ];
 
 	local %DB::sub = (
 		'main::foo'	=> 'foo:1-4',
@@ -268,7 +280,7 @@ SKIP: {
 # test DB::set_tbreak()
 {
 	local ($DB::lineno, *DB::dbline, $DB::package);
-	*DB::dbline = [ 0, 1, 0, 0, 1 ];
+	*DB::dbline = [ $dualfalse, $dualtrue, $dualfalse, $dualfalse, $dualtrue ];
 
 	DB->set_tbreak(1);
 	is( $DB::dbline{1}, ';9', 'DB::set_tbreak() should set tbreak condition' );
@@ -300,7 +312,7 @@ SKIP: {
 		'bar::bar'	=> 'foo:10-16',
 	);
 
-	$foo[11] = 1;
+	$foo[11] = $dualtrue;
 
 	is( DB::_find_subline('TEST::foo'), 11, 
 		'DB::_find_subline() should find fully qualified sub' );
@@ -312,7 +324,7 @@ SKIP: {
 	is( DB::_find_subline('bar'), 11, 
 		'... should resolve unqualified name with $DB::package, if defined' );
 	
-	$foo[11] = 0;
+	$foo[11] = $dualfalse;
 
 	is( DB::_find_subline('TEST::foo'), 15, 
 		'... should increment past lines with no events' );
@@ -378,7 +390,7 @@ SKIP: {
 		2 => "\0abc",
 	);
 
-	*DB::dbline = [ 0, 0, 1, 1 ];
+	*DB::dbline = [ $dualfalse, $dualfalse, $dualtrue, $dualtrue ];
 
 	DB->set_action(2, 'def');
 	is( $DB::dbline{2}, "\0def", 
@@ -407,7 +419,7 @@ SKIP: {
 	);
 
 	%DB::dbline = %lines;
-	*DB::dbline = [ 1, 1, 1, 1 ];
+	*DB::dbline = [ ($dualtrue) x 4 ];
 
 	DB->clr_actions(1 .. 4);