Author: pmichaud
Date: Wed Nov 16 11:41:02 2005
New Revision: 10031
Modified:
trunk/compilers/pge/PGE/Exp.pir
trunk/compilers/pge/PGE/Match.pir
trunk/compilers/pge/PGE/OPTable.pir
trunk/compilers/pge/PGE/P6Rule.pir
trunk/compilers/pge/PGE/Rule.pir
trunk/compilers/pge/PGE/TokenHash.pir
trunk/t/library/pge.t
Log:
Added guard against multiple loads of PGE.
Modified: trunk/compilers/pge/PGE/Exp.pir
==============================================================================
--- trunk/compilers/pge/PGE/Exp.pir (original)
+++ trunk/compilers/pge/PGE/Exp.pir Wed Nov 16 11:41:02 2005
@@ -12,6 +12,8 @@
.local pmc optable
.local pmc term
+ $I0 = find_type "PGE::Exp"
+ if $I0 goto end
$P0 = getclass "PGE::Match"
$P0 = subclass $P0, "PGE::Exp"
$P1 = subclass $P0, "PGE::Exp::Literal"
@@ -31,6 +33,7 @@
$P1 = subclass $P0, "PGE::Exp::Commit"
$P0 = new Integer
store_global "PGE::Exp", "$_serno", $P0
+ end:
.end
Modified: trunk/compilers/pge/PGE/Match.pir
==============================================================================
--- trunk/compilers/pge/PGE/Match.pir (original)
+++ trunk/compilers/pge/PGE/Match.pir Wed Nov 16 11:41:02 2005
@@ -12,6 +12,8 @@ This file implements match objects retur
.sub "__onload" :load
.local pmc base
+ $I0 = find_type "PGE::Match"
+ if $I0 goto end
$P0 = getclass "PerlHash"
base = subclass $P0, "PGE::Match"
addattribute base, "$:target" # target
@@ -19,6 +21,7 @@ This file implements match objects retur
addattribute base, "$:pos" # current match position
addattribute base, "&:corou" # match's corou
addattribute base, "@:capt" # subpattern captures
+ end:
.return ()
.end
Modified: trunk/compilers/pge/PGE/OPTable.pir
==============================================================================
--- trunk/compilers/pge/PGE/OPTable.pir (original)
+++ trunk/compilers/pge/PGE/OPTable.pir Wed Nov 16 11:41:02 2005
@@ -63,12 +63,15 @@ Creates the PGE::OPTable class.
.sub "__onload" :load
.local pmc base
+ $I0 = find_type "PGE::OPTable"
+ if $I0 goto end
base = newclass "PGE::OPTable"
addattribute base, "%:toktable"
addattribute base, "%:termtable"
addattribute base, "%:opertable"
addattribute base, "%:wstermtable"
addattribute base, "%:wsopertable"
+ end:
.end
=item C<__init()>
Modified: trunk/compilers/pge/PGE/P6Rule.pir
==============================================================================
--- trunk/compilers/pge/PGE/P6Rule.pir (original)
+++ trunk/compilers/pge/PGE/P6Rule.pir Wed Nov 16 11:41:02 2005
@@ -4,6 +4,8 @@
.sub "__onload" :load
.local pmc optable
+ $I0 = find_type "PGE::Exp::WS"
+ if $I0 goto end
$P0 = getclass "PGE::Exp::Subrule"
$P1 = subclass $P0, "PGE::Exp::WS"
$P0 = getclass "PGE::Exp"
@@ -81,6 +83,7 @@
$P0["h"] =
unicode:"\x09\x20\xa0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u202f\u205f\u3000"
$P0["n"] = unicode:"\x0a\x0d\x0c\x85\u2028\u2029"
# See http://www.unicode.org/Public/UNIDATA/PropList.txt for above
+ end:
.end
Modified: trunk/compilers/pge/PGE/Rule.pir
==============================================================================
--- trunk/compilers/pge/PGE/Rule.pir (original)
+++ trunk/compilers/pge/PGE/Rule.pir Wed Nov 16 11:41:02 2005
@@ -17,10 +17,13 @@ a number of built-in rules.
.sub "__onload" :load
.local pmc base
.local pmc p6rule
+ $I0 = find_type "PGE::Rule"
+ if $I0 goto end
base = getclass "PGE::Match"
$P0 = subclass base, "PGE::Rule"
$P0 = new Hash
store_global "PGE::Rule", "%:cache", $P0
+ end:
.return ()
.end
Modified: trunk/compilers/pge/PGE/TokenHash.pir
==============================================================================
--- trunk/compilers/pge/PGE/TokenHash.pir (original)
+++ trunk/compilers/pge/PGE/TokenHash.pir Wed Nov 16 11:41:02 2005
@@ -8,9 +8,12 @@ PGE::TokenHash - hash implementation to
.sub "__onload" :load
.local pmc class
+ $I0 = find_type "PGE::TokenHash"
+ if $I0 goto end
class = newclass "PGE::TokenHash"
addattribute class, ".ihash"
addattribute class, ".vhash"
+ end:
.return ()
.end
Modified: trunk/t/library/pge.t
==============================================================================
--- trunk/t/library/pge.t (original)
+++ trunk/t/library/pge.t Wed Nov 16 11:41:02 2005
@@ -94,6 +94,16 @@ ok
OUT
+# 2
+pir_output_is(<<'CODE'.$POST, <<OUT, 'load_bytecode PGE.pbc 2x');
+.sub 'main' :main
+ load_bytecode 'PGE.pbc'
+ load_bytecode 'PGE.pbc'
+CODE
+ok
+OUT
+
+
for my $file (sort keys %$ns_subs)
{
for my $ns (sort keys %{ $ns_subs->{$file} })
