richter 00/12/19 01:11:11
Modified: . Tag: Embperl2c Embperl.pm Embperl.xs ep.h epmain.c
eputil.c test.pl
Log:
Embperl 2 - new cleanup
Revision Changes Path
No revision
No revision
1.118.4.20 +182 -160 embperl/Embperl.pm
Index: Embperl.pm
===================================================================
RCS file: /home/cvs/embperl/Embperl.pm,v
retrieving revision 1.118.4.19
retrieving revision 1.118.4.20
diff -u -r1.118.4.19 -r1.118.4.20
--- Embperl.pm 2000/12/18 12:43:22 1.118.4.19
+++ Embperl.pm 2000/12/19 09:11:02 1.118.4.20
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: Embperl.pm,v 1.118.4.19 2000/12/18 12:43:22 richter Exp $
+# $Id: Embperl.pm,v 1.118.4.20 2000/12/19 09:11:02 richter Exp $
#
###################################################################################
@@ -86,7 +86,7 @@
##ep2##
-$VERSION = '2.0a16' ;
+$VERSION = '2.0a17' ;
##/ep2##
##ep1##$VERSION = '1.3b8_dev';
@@ -1225,199 +1225,215 @@
sub cleanup
{
- # --- return 0 ;
-
- #log_svs ("cleanup entry") ;
- my $glob ;
- my $val ;
- my $key ;
- local $^W = 0 ;
- my $package ;
my %seen ;
- my $Debugflags ;
- my $packfile ;
- my %addcleanup ;
- my $varfile ;
- my %revinc = map { ($_ => 1) } values (%INC) if ($multiplicity) ;
- my ($k, $v) ;
-
- $seen{''} = 1 ;
- $seen{'dbgShowCleanup'} = 1 ;
- foreach $package (@cleanups)
- {
- $Debugflags = dbgShowCleanup if ($package eq 'dbgShowCleanup') ;
- next if ($seen{$package}) ;
-
- $seen{$package} = 1 ;
-
- #print LOG "GVFile $package\::__ANON__\n" ;
- $packfile = GVFile (*{"$package\::__ANON__"}) ;
- if ($multiplicity && !$revinc{$packfile})
- {
- print LOG "$packfile -> -- eval --\n" ;
- $packfile = "-- eval --" ;
- }
- $packfile = '-> No Perl in Source <-' if ($packfile eq ('_<' . __FILE__) ||
$packfile eq __FILE__) ;
- $addcleanup = \%{"$package\:\:CLEANUP"} ;
- $addcleanup -> {'CLEANUP'} = 0 ;
- $addcleanup -> {'EXPIRES'} = 0 ;
- $addcleanup -> {'CACHE_KEY'} = 0 ;
- if ($Debugflags & dbgShowCleanup)
- {
- print LOG "[$$]CUP: ***** Cleanup package: $package *****\n" ;
- print LOG "[$$]CUP: Source $packfile\n" ;
- }
- if (defined (&{"$package\:\:CLEANUP"}))
- {
- #$package =~ /^([a-zA-Z0-9\:\:\_]+)$/ ;
- #eval "\&$1\:\:CLEANUP;" ;
- eval "\&$package\:\:CLEANUP;" ;
- print LOG "[$$]CUP: Call \&$package\:\:CLEANUP;\n" if ($Debugflags &
dbgShowCleanup);
- logevalerr ($@) if ($@) ;
- }
+ my $package ;
- if ($Debugflags & dbgShowCleanup)
+ if (!$ENV{EMBPERL_EP1COMPAT})
+ {
+ $seen{''} = 1 ;
+ $seen{'dbgShowCleanup'} = 1 ;
+ foreach $package (@cleanups)
{
- my @vars = sort keys %{*{"$package\::"}} ;
- my $cleanfile = \%{"$package\:\:CLEANUPFILE"} ;
- foreach $key (@vars)
- {
- $val = ${*{"$package\::"}}{$key} ;
- local(*ENTRY) = $val;
- #print LOG "$key = " . GVFile (*ENTRY) . "\n" ;
- $varfile = GVFile (*ENTRY) ;
- if ($multiplicity && !$revinc{$varfile})
- {
- print LOG "$varfile -> -- eval --\n" ;
- $varfile = "-- eval --" ;
- }
-
- $glob = $package.'::'.$key ;
- if (defined (*ENTRY{SCALAR}) && defined (${$glob}) && ref (${$glob})
eq 'DBIx::Recordset')
- {
- print LOG "[$$]CUP: Recordset $key\n" ;
- eval { DBIx::Recordset::Undef ($glob) ; } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- }
- elsif (($packfile eq $varfile || $addcleanup -> {$key} ||
- $cleanfile->{$varfile}) &&
- (!($key =~ /\:\:$/) && !(defined ($addcleanup -> {$key}) &&
$addcleanup -> {$key} == 0)))
- { # Only cleanup vars which are defined in the sourcefile
- # ignore all imported vars, unless they are in the CLEANUP hash
which is set by VARS
- if (defined (*ENTRY{SCALAR}) && defined (${$glob}))
- {
- print LOG "[$$]CUP: \$$key = ${$glob}\n" ;
- eval { undef ${$glob} } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- }
- if (defined (*ENTRY{IO}))
- {
- print LOG "[$$]CUP: IO $key\n" ;
- eval { close *{$glob} ; } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- }
- if (defined (*ENTRY{HASH}))
- {
- print LOG "[$$]CUP: \%$key = (" ;
- my $i = 0 ;
- my $k ;
- my $v ;
- eval { # ignore errors here (for ActiveState Perl)
- while (($k, $v) = each (%{$glob}))
- {
- if ($i++ > 5)
- {
- print LOG '...' ;
- last
- }
- print LOG "$k => $v, "
- } } ;
- print LOG ")\n" ;
- eval { untie %{$glob} ; } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- eval { undef %{$glob} ; } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- }
- if (defined (*ENTRY{ARRAY}))
- {
- print LOG "[$$]CUP: \@$key = (" ;
- my $i = 0 ;
- my $v ;
- foreach $v (@{$glob})
- {
- if ($i++ > 5)
- {
- print LOG '...' ;
- last
- }
- print LOG "$v, "
- }
- print LOG ")\n" ;
- eval { untie @{$glob} ; } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- eval { undef @{$glob} ; } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- }
- print LOG "[$$]CUP: leave unchanged LVALUE $key\n" if
(defined (*ENTRY{LVALUE})) ;
- print LOG "[$$]CUP: leave unchanged FORMAT $key\n" if
(defined (*ENTRY{FORMAT})) ;
- print LOG "[$$]CUP: leave unchanged \&$key\n" if
(defined (*ENTRY{CODE})) ;
- }
- }
+ $Debugflags = dbgShowCleanup if ($package eq 'dbgShowCleanup') ;
+ next if ($seen{$package}) ;
+
+ $seen{$package} = 1 ;
+ ClearSymtab ($package) ;
}
- else
+ }
+ else
+ {
+ #log_svs ("cleanup entry") ;
+ my $glob ;
+ my $val ;
+ my $key ;
+ local $^W = 0 ;
+ my $Debugflags ;
+ my $packfile ;
+ my %addcleanup ;
+ my $varfile ;
+ my %revinc = map { ($_ => 1) } values (%INC) if ($multiplicity) ;
+ my ($k, $v) ;
+
+ $seen{''} = 1 ;
+ $seen{'dbgShowCleanup'} = 1 ;
+ foreach $package (@cleanups)
{
- my $cleanfile = \%{"$package\:\:CLEANUPFILE"} ;
- while (($key,$val) = each(%{*{"$package\::"}}))
+ $Debugflags = dbgShowCleanup if ($package eq 'dbgShowCleanup') ;
+ next if ($seen{$package}) ;
+
+ $seen{$package} = 1 ;
+
+ #print LOG "GVFile $package\::__ANON__\n" ;
+ $packfile = GVFile (*{"$package\::__ANON__"}) ;
+ if ($multiplicity && !$revinc{$packfile})
{
- local(*ENTRY) = $val;
- $glob = $package.'::'.$key ;
- if (defined (*ENTRY{SCALAR}) && defined (${$glob}) && ref (${$glob})
eq 'DBIx::Recordset')
+ print LOG "$packfile -> -- eval --\n" ;
+ $packfile = "-- eval --" ;
+ }
+ $packfile = '-> No Perl in Source <-' if ($packfile eq ('_<' .
__FILE__) || $packfile eq __FILE__) ;
+ $addcleanup = \%{"$package\:\:CLEANUP"} ;
+ $addcleanup -> {'CLEANUP'} = 0 ;
+ $addcleanup -> {'EXPIRES'} = 0 ;
+ $addcleanup -> {'CACHE_KEY'} = 0 ;
+ if ($Debugflags & dbgShowCleanup)
+ {
+ print LOG "[$$]CUP: ***** Cleanup package: $package *****\n" ;
+ print LOG "[$$]CUP: Source $packfile\n" ;
+ }
+ if (defined (&{"$package\:\:CLEANUP"}))
+ {
+ #$package =~ /^([a-zA-Z0-9\:\:\_]+)$/ ;
+ #eval "\&$1\:\:CLEANUP;" ;
+ eval "\&$package\:\:CLEANUP;" ;
+ print LOG "[$$]CUP: Call \&$package\:\:CLEANUP;\n" if ($Debugflags &
dbgShowCleanup);
+ logevalerr ($@) if ($@) ;
+ }
+
+
+ if ($Debugflags & dbgShowCleanup)
+ {
+ my @vars = sort keys %{*{"$package\::"}} ;
+ my $cleanfile = \%{"$package\:\:CLEANUPFILE"} ;
+ foreach $key (@vars)
{
- eval { DBIx::Recordset::Undef ($glob) ; } ;
- print LOG "[$$]CUP: Error: $@\n" if ($@) ;
- }
- else
- {
+ $val = ${*{"$package\::"}}{$key} ;
+ local(*ENTRY) = $val;
+ #print LOG "$key = " . GVFile (*ENTRY) . "\n" ;
$varfile = GVFile (*ENTRY) ;
if ($multiplicity && !$revinc{$varfile})
{
print LOG "$varfile -> -- eval --\n" ;
$varfile = "-- eval --" ;
}
-
- if (($packfile eq $varfile || $addcleanup -> {$key} ||
- $cleanfile->{$varfile}) &&
+
+ $glob = $package.'::'.$key ;
+ if (defined (*ENTRY{SCALAR}) && defined (${$glob}) && ref
(${$glob}) eq 'DBIx::Recordset')
+ {
+ print LOG "[$$]CUP: Recordset $key\n" ;
+ eval { DBIx::Recordset::Undef ($glob) ; } ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
+ }
+ elsif (($packfile eq $varfile || $addcleanup -> {$key} ||
+ $cleanfile->{$varfile}) &&
(!($key =~ /\:\:$/) && !(defined ($addcleanup -> {$key}) &&
$addcleanup -> {$key} == 0)))
{ # Only cleanup vars which are defined in the sourcefile
# ignore all imported vars, unless they are in the CLEANUP
hash which is set by VARS
if (defined (*ENTRY{SCALAR}) && defined (${$glob}))
{
- eval { undef ${$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \$$glob: $@\n" if
($@) ;
+ print LOG "[$$]CUP: \$$key = ${$glob}\n" ;
+ eval { undef ${$glob} } ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
}
if (defined (*ENTRY{IO}))
{
- eval { close *{"$package\:\:$key"} ; } ;
- print LOG "[$$]CUP: Error while closing $glob: $@\n" if
($@) ;
+ print LOG "[$$]CUP: IO $key\n" ;
+ eval { close *{$glob} ; } ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
}
if (defined (*ENTRY{HASH}))
{
+ print LOG "[$$]CUP: \%$key = (" ;
+ my $i = 0 ;
+ my $k ;
+ my $v ;
+ eval { # ignore errors here (for ActiveState Perl)
+ while (($k, $v) = each (%{$glob}))
+ {
+ if ($i++ > 5)
+ {
+ print LOG '...' ;
+ last
+ }
+ print LOG "$k => $v, "
+ } } ;
+ print LOG ")\n" ;
eval { untie %{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \%$glob: $@\n" if
($@) ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
eval { undef %{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \%$glob: $@\n" if
($@) ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
}
if (defined (*ENTRY{ARRAY}))
{
+ print LOG "[$$]CUP: \@$key = (" ;
+ my $i = 0 ;
+ my $v ;
+ foreach $v (@{$glob})
+ {
+ if ($i++ > 5)
+ {
+ print LOG '...' ;
+ last
+ }
+ print LOG "$v, "
+ }
+ print LOG ")\n" ;
eval { untie @{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \@$glob: $@\n" if
($@) ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
eval { undef @{$glob} ; } ;
- print LOG "[$$]CUP: Error while cleanup \@$glob: $@\n" if
($@) ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
}
+ print LOG "[$$]CUP: leave unchanged LVALUE $key\n" if
(defined (*ENTRY{LVALUE})) ;
+ print LOG "[$$]CUP: leave unchanged FORMAT $key\n" if
(defined (*ENTRY{FORMAT})) ;
+ print LOG "[$$]CUP: leave unchanged \&$key\n" if
(defined (*ENTRY{CODE})) ;
}
}
- }
+ }
+ else
+ {
+ my $cleanfile = \%{"$package\:\:CLEANUPFILE"} ;
+ while (($key,$val) = each(%{*{"$package\::"}}))
+ {
+ local(*ENTRY) = $val;
+ $glob = $package.'::'.$key ;
+ if (defined (*ENTRY{SCALAR}) && defined (${$glob}) && ref
(${$glob}) eq 'DBIx::Recordset')
+ {
+ eval { DBIx::Recordset::Undef ($glob) ; } ;
+ print LOG "[$$]CUP: Error: $@\n" if ($@) ;
+ }
+ else
+ {
+ $varfile = GVFile (*ENTRY) ;
+ if ($multiplicity && !$revinc{$varfile})
+ {
+ print LOG "$varfile -> -- eval --\n" ;
+ $varfile = "-- eval --" ;
+ }
+
+ if (($packfile eq $varfile || $addcleanup -> {$key} ||
+ $cleanfile->{$varfile}) &&
+ (!($key =~ /\:\:$/) && !(defined ($addcleanup -> {$key})
&& $addcleanup -> {$key} == 0)))
+ { # Only cleanup vars which are defined in the sourcefile
+ # ignore all imported vars, unless they are in the
CLEANUP hash which is set by VARS
+ if (defined (*ENTRY{SCALAR}) && defined (${$glob}))
+ {
+ eval { undef ${$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \$$glob:
$@\n" if ($@) ;
+ }
+ if (defined (*ENTRY{IO}))
+ {
+ eval { close *{"$package\:\:$key"} ; } ;
+ print LOG "[$$]CUP: Error while closing $glob: $@\n"
if ($@) ;
+ }
+ if (defined (*ENTRY{HASH}))
+ {
+ eval { untie %{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \%$glob:
$@\n" if ($@) ;
+ eval { undef %{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \%$glob:
$@\n" if ($@) ;
+ }
+ if (defined (*ENTRY{ARRAY}))
+ {
+ eval { untie @{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \@$glob:
$@\n" if ($@) ;
+ eval { undef @{$glob} ; } ;
+ print LOG "[$$]CUP: Error while cleanup \@$glob:
$@\n" if ($@) ;
+ }
+ }
+ }
+ }
+ }
}
}
@@ -1897,6 +1913,12 @@
#print LOG "[$$]MEM: Created Aliases for $package\n" ;
+ my $addcleanup = \%{"$package\:\:CLEANUP"} ;
+ $addcleanup -> {'CLEANUP'} = 0 ;
+ $addcleanup -> {'EXPIRES'} = 0 ;
+ $addcleanup -> {'CACHE_KEY'} = 0 ;
+ $addcleanup -> {'OUT'} = 0 ;
+ $addcleanup -> {'LOG'} = 0 ;
}
1.29.4.7 +6 -0 embperl/Embperl.xs
Index: Embperl.xs
===================================================================
RCS file: /home/cvs/embperl/Embperl.xs,v
retrieving revision 1.29.4.6
retrieving revision 1.29.4.7
diff -u -r1.29.4.6 -r1.29.4.7
--- Embperl.xs 2000/11/08 21:40:17 1.29.4.6
+++ Embperl.xs 2000/12/19 09:11:02 1.29.4.7
@@ -319,6 +319,12 @@
sv_unmagic(ERRSV, 'U');
+void
+embperl_ClearSymtab(sPackage)
+ char * sPackage
+CODE:
+ ClearSymtab (pCurrReq, sPackage) ;
+
################################################################################
1.27.4.7 +2 -0 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27.4.6
retrieving revision 1.27.4.7
diff -u -r1.27.4.6 -r1.27.4.7
--- ep.h 2000/11/15 07:21:52 1.27.4.6
+++ ep.h 2000/12/19 09:11:03 1.27.4.7
@@ -461,6 +461,8 @@
/*in*/ const char * sName) ;
+void ClearSymtab (/*i/o*/ register req * r,
+ /*in*/ const char * sPackage) ;
/* ---- from epeval.c ----- */
1.75.4.21 +1 -0 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.20
retrieving revision 1.75.4.21
diff -u -r1.75.4.20 -r1.75.4.21
--- epmain.c 2000/12/18 20:41:41 1.75.4.20
+++ epmain.c 2000/12/19 09:11:03 1.75.4.21
@@ -1272,6 +1272,7 @@
pSV = perl_get_sv (sVarName, TRUE) ;
sv_magic (pSV, NULL, 0, sVarName, strlen (sVarName)) ;
+ sv_setiv (pSV, 0) ;
pMagic = mg_find (pSV, 0) ;
if (pMagic)
1.15.4.2 +155 -1 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.1
retrieving revision 1.15.4.2
diff -u -r1.15.4.1 -r1.15.4.2
--- eputil.c 2000/11/15 08:11:27 1.15.4.1
+++ eputil.c 2000/12/19 09:11:03 1.15.4.2
@@ -822,4 +822,158 @@
*ppSV = newSViv (nPos) ;
return ok ;
- }
\ No newline at end of file
+ }
+
+
+
+/* ------------------------------------------------------------------------- */
+/* */
+/* SetSubTextPos */
+/* */
+/* */
+/* in sName = name of sub */
+/* in nPos = position within the file for a given Embperl sub */
+/* */
+/* ------------------------------------------------------------------------- */
+
+
+
+void ClearSymtab (/*i/o*/ register req * r,
+ /*in*/ const char * sPackage)
+
+ {
+ SV * val;
+ char * key;
+ I32 klen;
+ int bDebug = 1 ;
+ SV * sv;
+ HV * hv;
+ AV * av;
+ struct io * io ;
+ HV * symtab ;
+ STRLEN l ;
+ CV * pCV ;
+ SV * pSV ;
+ SV * * ppSV ;
+ SV * pSVErr ;
+ HV * pCleanupHV ;
+ char * s ;
+ GV * pFileGV ;
+ GV * symtabgv ;
+ GV * symtabfilegv ;
+
+ dTHR;
+
+ if ((symtab = gv_stashpv ((char *)sPackage, 0)) == NULL)
+ return ;
+
+ ppSV = hv_fetch (symtab, "__ANON__", 8, 0) ;
+ if (!ppSV || !*ppSV)
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: No Perl code in %s\n", r -> nPid, sPackage) ;
+ return ;
+ }
+
+ symtabgv = (GV *)*ppSV ;
+ symtabfilegv = (GV *)GvFILEGV (symtabgv) ;
+
+ pSV = newSVpvf ("%s::CLEANUP", sPackage) ;
+ s = SvPV (pSV, l) ;
+ pCV = perl_get_cv (s, 0) ;
+ if (pCV)
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Call &%s::CLEANUP\n", r -> nPid, sPackage) ;
+ perl_call_sv ((SV *)pCV, G_EVAL | G_NOARGS | G_DISCARD) ;
+ pSVErr = ERRSV ;
+ if (SvTRUE (pSVErr))
+ {
+ STRLEN l ;
+ char * p = SvPV (pSVErr, l) ;
+ if (l > sizeof (r -> errdat1) - 1)
+ l = sizeof (r -> errdat1) - 1 ;
+ strncpy (r -> errdat1, p, l) ;
+ if (l > 0 && r -> errdat1[l-1] == '\n')
+ l-- ;
+ r -> errdat1[l] = '\0' ;
+
+ LogError (r, rcEvalErr) ;
+
+ sv_setpv(pSVErr,"");
+ }
+ }
+
+
+ pCleanupHV = perl_get_hv (s, 1) ;
+
+ SvREFCNT_dec(pSV) ;
+
+ (void)hv_iterinit(symtab);
+ while ((val = hv_iternextsv(symtab, &key, &klen)))
+ {
+ if(SvTYPE(val) != SVt_PVGV)
+ continue;
+
+ s = GvNAME((GV *)val) ;
+ l = strlen (s) ;
+
+ ppSV = hv_fetch (pCleanupHV, s, l, 0) ;
+
+ if (ppSV && *ppSV && SvIV (*ppSV) == 0)
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Ignore %s because it's in %%CLEANUP\n", r ->
nPid, s) ;
+ continue ;
+ }
+
+
+ if (!(ppSV && *ppSV && SvIV (*ppSV) == 1))
+ {
+ if(GvIMPORTED((GV*)val))
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Ignore %s because it's imported\n", r ->
nPid, s) ;
+ continue ;
+ }
+
+ pFileGV = GvFILEGV ((GV *)val) ;
+ if (pFileGV != symtabfilegv)
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: Ignore %s because it's defined in another
source file\n", r -> nPid, s) ;
+ continue ;
+ }
+ }
+
+ if((sv = GvSV((GV*)val)) && SvOK (sv))
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: $%s = %s\n", r -> nPid, s, SvPV (sv, l)) ;
+
+ sv_unmagic (sv, 'q') ; /* untie */
+ sv_setsv(sv, &sv_undef);
+ }
+ if((hv = GvHV((GV*)val)))
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: %%%s = ...\n", r -> nPid, s) ;
+ sv_unmagic ((SV *)hv, 'P') ; /* untie */
+ hv_clear(hv);
+ }
+ if((av = GvAV((GV*)val)))
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: @%s = ...\n", r -> nPid, s) ;
+ sv_unmagic ((SV *)av, 'P') ; /* untie */
+ av_clear(av);
+ }
+ if((io = GvIO((GV*)val)))
+ {
+ if (bDebug)
+ lprintf (r, "[%d]CUP: IO %s = ...\n", r -> nPid, s) ;
+ //sv_unmagic ((SV *)io, 'q') ; /* untie */
+ //do_close((GV *)val, 0);
+ }
+ }
+ }
1.70.4.24 +1 -1 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.23
retrieving revision 1.70.4.24
diff -u -r1.70.4.23 -r1.70.4.24
--- test.pl 2000/12/04 09:17:36 1.70.4.23
+++ test.pl 2000/12/19 09:11:03 1.70.4.24
@@ -1141,7 +1141,7 @@
$testnum = -1 + $startnumber ;
#next if (($ep1compat && !($opt_ep1)) || (!$ep1compat &&
!($opt_offline)));
- $ENV{EMBPERL_EP1COMPAT} = $ep1compat ;
+ $ENV{EMBPERL_EP1COMPAT} = $ep1compat?1:0 ;
print "\nTesting Embperl 1.x compatibility mode...\n\n" if ($ep1compat) ;
foreach $testno (@tests)
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
