Front page | perl.perl5.porters |
Postings from November 1999
[PATCH 5.005_62] use foo if bar
Thread Next
From:
Ilya Zakharevich
Date:
November 17, 1999 21:45
Subject:
[PATCH 5.005_62] use foo if bar
Message ID:
199911180545.AAA08288@monk.mps.ohio-state.edu
Currently one can fake conditional `use' statemenst with BEGIN blocks,
however, this works only for those `use's teh effect of which is not
lexically scoped. The following patch makes
use foo if bar; # same with unless
legal, which allows conditional pragmas (say, based on $^O and/or $]).
This patch is pretty lame: note how I use ->floor in perly.y, and a
nasty construct ${\$constsv} to emulate assignment to $constsv (which
is *not* readonly). An advice from yacc gurus on how to remove this
->floor hack is very welcome. (The ${\$constsv} hack is not
beautiful, but not many things in op.c are, so I will not be very
disappointed if it stays.)
Enjoy,
Ilya
--- ./perly.y~.pre Wed Nov 17 21:46:07 1999
+++ ./perly.y Thu Nov 18 00:27:11 1999
@@ -37,6 +37,7 @@ struct ysv {
int oldyychar;
YYSTYPE oldyyval;
YYSTYPE oldyylval;
+ I32 floor;
};
static void yydestruct(pTHXo_ void *ptr);
@@ -81,7 +82,7 @@ static void yydestruct(pTHXo_ void *ptr)
%type <ival> prog decl format startsub startanonsub startformsub
%type <ival> remember mremember '&'
-%type <opval> block mblock lineseq line loop cond else
+%type <opval> block mblock lineseq line loop cond else tool
%type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
%type <opval> listexpr listexprcom indirob listop method
@@ -305,6 +306,8 @@ decl : format
{ $$ = 0; }
| use
{ $$ = 0; }
+ | useif
+ { $$ = 0; }
;
format : FORMAT startformsub formname block
@@ -371,10 +374,20 @@ package : PACKAGE WORD ';'
{ package(Nullop); }
;
-use : USE startsub
+tool : USE startsub
{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
- WORD WORD listexpr ';'
- { utilize($1, $2, $4, $5, $6); }
+ WORD WORD listexpr
+ { ysave->floor = $2; $$ = utilize_build($1, $4, $5, $6); }
+ ;
+
+use : tool ';'
+ { utilize_if(ysave->floor, $1, Nullop, 0, 0); }
+ ;
+
+useif : tool IF startsub expr ';'
+ { utilize_if(ysave->floor, $1, $4, 1, $3); }
+ | tool UNLESS startsub expr ';'
+ { utilize_if(ysave->floor, $1, $4, 0, $3); }
;
expr : expr ANDOP expr
--- ./op.c~.pre Wed Nov 17 21:46:07 1999
+++ ./op.c Thu Nov 18 00:36:22 1999
@@ -2917,8 +2917,63 @@ Perl_package(pTHX_ OP *o)
}
void
+Perl_utilize_if(pTHX_ I32 floor, OP *tool, OP *doif, bool affirm, I32 floor2)
+{
+ if (doif != Nullop) { /* Calculate value of condition */
+ SV *sv = sv_newmortal();
+ /* We need newSVOP(OP_CONST, 0, sv), but avoid can't-modify error */
+ OP *o = newUNOP(OP_RV2SV, 0, newUNOP(OP_SREFGEN, 0,
+ newSVOP(OP_CONST, 0, sv)));
+
+ /* newSVOP() will destroy it on exit from BEGIN. Increment
+ refcount again. */
+ SvREFCNT_inc(sv);
+ /* Fake up the BEGIN {}, which does its thing immediately. */
+ newATTRSUB(floor2,
+ newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
+ Nullop,
+ Nullop,
+ append_elem(OP_LINESEQ,
+ newASSIGNOP(OPf_STACKED,
+ o,
+ 0, doif),
+ Nullop));
+ /* Now REFCOUNT of sv is 1, and it is mortal. */
+ if (affirm ? !SvTRUE(sv) : SvTRUE(sv)) {
+ op_free(tool);
+ tool = Nullop;
+ }
+ }
+
+ /* Fake up the BEGIN {}, which does its thing immediately. */
+ newATTRSUB(floor,
+ newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
+ Nullop,
+ Nullop,
+ tool);
+
+ PL_hints |= HINT_BLOCK_SCOPE;
+ PL_copline = NOLINE;
+ PL_expect = XSTATE;
+}
+
+void
Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
{
+ newATTRSUB(floor,
+ newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
+ Nullop,
+ Nullop,
+ Perl_utilize_build(pTHX_ aver, version, id, arg));
+
+ PL_hints |= HINT_BLOCK_SCOPE;
+ PL_copline = NOLINE;
+ PL_expect = XSTATE;
+}
+
+OP*
+Perl_utilize_build(pTHX_ int aver, OP *version, OP *id, OP *arg)
+{
OP *pack;
OP *meth;
OP *rqop;
@@ -2988,20 +3043,12 @@ Perl_utilize(pTHX_ int aver, I32 floor,
rqop = newUNOP(OP_REQUIRE, 0, id);
}
- /* Fake up the BEGIN {}, which does its thing immediately. */
- newATTRSUB(floor,
- newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
- Nullop,
- Nullop,
- append_elem(OP_LINESEQ,
- append_elem(OP_LINESEQ,
- newSTATEOP(0, Nullch, rqop),
- newSTATEOP(0, Nullch, veop)),
- newSTATEOP(0, Nullch, imop) ));
- PL_hints |= HINT_BLOCK_SCOPE;
- PL_copline = NOLINE;
- PL_expect = XSTATE;
+ return append_elem(OP_LINESEQ,
+ append_elem(OP_LINESEQ,
+ newSTATEOP(0, Nullch, rqop),
+ newSTATEOP(0, Nullch, veop)),
+ newSTATEOP(0, Nullch, imop) );
}
OP *
--- ./embed.pl~.pre Wed Nov 17 21:46:07 1999
+++ ./embed.pl Thu Nov 18 00:22:44 1999
@@ -1680,6 +1680,8 @@ p |void |unlock_condpair|void* svv
p |void |unsharepvn |const char* sv|I32 len|U32 hash
p |void |unshare_hek |HEK* hek
p |void |utilize |int aver|I32 floor|OP* version|OP* id|OP* arg
+p |OP* |utilize_build |int aver|OP* version|OP* id|OP* arg
+p |void |utilize_if |I32 floor|OP* tool|OP* doif|bool affir|I32 floor2
p |U8* |utf16_to_utf8 |U16* p|U8 *d|I32 bytelen
p |U8* |utf16_to_utf8_reversed|U16* p|U8 *d|I32 bytelen
p |I32 |utf8_distance |U8 *a|U8 *b
--- ./t/comp/use.t~.pre Wed Nov 17 21:46:07 1999
+++ ./t/comp/use.t Wed Nov 17 19:05:05 1999
@@ -5,7 +5,7 @@ BEGIN {
unshift @INC, '../lib';
}
-print "1..14\n";
+print "1..20\n";
my $i = 1;
@@ -98,4 +98,26 @@ unless ($@) {
print "ok ",$i++,"\n";
print "not " if $INC[0] eq "freda";
+print "ok ",$i++,"\n";
+
+$t = eval 'use lib 1.01 qw(freda) if length $^O eq -1; 12';
+print "# '$@'\nnot " if $@;
+print "ok ",$i++,"\n";
+
+print "not " if $t ne '12';
+print "ok ",$i++,"\n";
+
+$t = eval 'use lib 1.01 qw(freda) if length $^O ne -1; 12';
+print "not " unless $@;
+print "ok ",$i++,"\n";
+
+$t = eval 'use lib 1.01 qw(freda) unless length $^O ne -1; 12';
+print "# '$@'\nnot " if $@;
+print "ok ",$i++,"\n";
+
+print "not " if $t ne '12';
+print "ok ",$i++,"\n";
+
+$t = eval 'use lib 1.01 qw(freda) unless length $^O eq -1; 12';
+print "not " unless $@;
print "ok ",$i++,"\n";
Thread Next
-
[PATCH 5.005_62] use foo if bar
by Ilya Zakharevich