diff options
| -rw-r--r-- | doop.c | 4 | ||||
| -rw-r--r-- | embed.h | 12 | ||||
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | ext/File/Glob/Glob.pm | 3 | ||||
| -rwxr-xr-x | lib/ExtUtils/xsubpp | 27 | ||||
| -rw-r--r-- | lib/Net/Ping.pm | 6 | ||||
| -rw-r--r-- | lib/Pod/Html.pm | 8 | ||||
| -rw-r--r-- | lib/Pod/Man.pm | 2 | ||||
| -rw-r--r-- | lib/Pod/Text.pm | 2 | ||||
| -rw-r--r-- | lib/Text/Wrap.pm | 4 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | op.c | 31 | ||||
| -rw-r--r-- | perlapi.c | 7 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 22 | ||||
| -rw-r--r-- | pod/perlsub.pod | 2 | ||||
| -rw-r--r-- | pod/perltie.pod | 16 | ||||
| -rw-r--r-- | proto.h | 7 | ||||
| -rwxr-xr-x | t/lib/anydbm.t | 5 | ||||
| -rwxr-xr-x | t/lib/dprof.t | 6 | ||||
| -rwxr-xr-x | t/lib/dumper-ovl.t | 5 | ||||
| -rwxr-xr-x | t/lib/dumper.t | 5 | ||||
| -rwxr-xr-x | t/lib/hostname.t | 5 | ||||
| -rwxr-xr-x | t/lib/ipc_sysv.t | 4 | ||||
| -rwxr-xr-x | t/op/sprintf.t | 252 | ||||
| -rwxr-xr-x | t/op/taint.t | 7 | ||||
| -rw-r--r-- | utils/h2xs.PL | 67 | ||||
| -rw-r--r-- | vms/vms.c | 2 |
27 files changed, 448 insertions, 69 deletions
@@ -89,7 +89,7 @@ S_do_trans_simple(pTHX_ SV *sv) } } *d='\0'; - sv_setpvn(sv, dstart, d - dstart); + sv_setpvn(sv, (const char*)dstart, d - dstart); SvUTF8_on(sv); SvLEN_set(sv, 2*len+1); SvSETMAGIC(sv); @@ -263,7 +263,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ s += UTF8SKIP(s); } *d = '\0'; - sv_setpvn(sv, dstart, d - dstart); + sv_setpvn(sv, (const char*)dstart, d - dstart); SvSETMAGIC(sv); if (isutf) SvUTF8_on(sv); @@ -71,6 +71,7 @@ #define append_elem Perl_append_elem #define append_list Perl_append_list #define apply Perl_apply +#define apply_attrs_string Perl_apply_attrs_string #define avhv_delete_ent Perl_avhv_delete_ent #define avhv_exists_ent Perl_avhv_exists_ent #define avhv_fetch_ent Perl_avhv_fetch_ent @@ -893,6 +894,7 @@ #define cv_dump S_cv_dump #define cv_clone2 S_cv_clone2 #define scalar_mod_type S_scalar_mod_type +#define method_2entersub S_method_2entersub #define my_kid S_my_kid #define dup_attrlist S_dup_attrlist #define apply_attrs S_apply_attrs @@ -1091,6 +1093,7 @@ #define scan_trans S_scan_trans #define scan_word S_scan_word #define skipspace S_skipspace +#define swallow_bom S_swallow_bom #define checkcomma S_checkcomma #define force_ident S_force_ident #define incline S_incline @@ -1543,6 +1546,7 @@ #define append_elem(a,b,c) Perl_append_elem(aTHX_ a,b,c) #define append_list(a,b,c) Perl_append_list(aTHX_ a,b,c) #define apply(a,b,c) Perl_apply(aTHX_ a,b,c) +#define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d) #define avhv_delete_ent(a,b,c,d) Perl_avhv_delete_ent(aTHX_ a,b,c,d) #define avhv_exists_ent(a,b,c) Perl_avhv_exists_ent(aTHX_ a,b,c) #define avhv_fetch_ent(a,b,c,d) Perl_avhv_fetch_ent(aTHX_ a,b,c,d) @@ -2336,6 +2340,7 @@ #define cv_dump(a) S_cv_dump(aTHX_ a) #define cv_clone2(a,b) S_cv_clone2(aTHX_ a,b) #define scalar_mod_type(a,b) S_scalar_mod_type(aTHX_ a,b) +#define method_2entersub(a,b,c) S_method_2entersub(aTHX_ a,b,c) #define my_kid(a,b) S_my_kid(aTHX_ a,b) #define dup_attrlist(a) S_dup_attrlist(aTHX_ a) #define apply_attrs(a,b,c) S_apply_attrs(aTHX_ a,b,c) @@ -2533,6 +2538,7 @@ #define scan_trans(a) S_scan_trans(aTHX_ a) #define scan_word(a,b,c,d,e) S_scan_word(aTHX_ a,b,c,d,e) #define skipspace(a) S_skipspace(aTHX_ a) +#define swallow_bom(a) S_swallow_bom(aTHX_ a) #define checkcomma(a,b,c) S_checkcomma(aTHX_ a,b,c) #define force_ident(a,b) S_force_ident(aTHX_ a,b) #define incline(a) S_incline(aTHX_ a) @@ -2995,6 +3001,8 @@ #define append_list Perl_append_list #define Perl_apply CPerlObj::Perl_apply #define apply Perl_apply +#define Perl_apply_attrs_string CPerlObj::Perl_apply_attrs_string +#define apply_attrs_string Perl_apply_attrs_string #define Perl_avhv_delete_ent CPerlObj::Perl_avhv_delete_ent #define avhv_delete_ent Perl_avhv_delete_ent #define Perl_avhv_exists_ent CPerlObj::Perl_avhv_exists_ent @@ -4565,6 +4573,8 @@ #define cv_clone2 S_cv_clone2 #define S_scalar_mod_type CPerlObj::S_scalar_mod_type #define scalar_mod_type S_scalar_mod_type +#define S_method_2entersub CPerlObj::S_method_2entersub +#define method_2entersub S_method_2entersub #define S_my_kid CPerlObj::S_my_kid #define my_kid S_my_kid #define S_dup_attrlist CPerlObj::S_dup_attrlist @@ -4925,6 +4935,8 @@ #define scan_word S_scan_word #define S_skipspace CPerlObj::S_skipspace #define skipspace S_skipspace +#define S_swallow_bom CPerlObj::S_swallow_bom +#define swallow_bom S_swallow_bom #define S_checkcomma CPerlObj::S_checkcomma #define checkcomma S_checkcomma #define S_force_ident CPerlObj::S_force_ident @@ -1375,6 +1375,7 @@ Ap |bool |Gv_AMupdate |HV* stash p |OP* |append_elem |I32 optype|OP* head|OP* tail p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last p |I32 |apply |I32 type|SV** mark|SV** sp +Afp |void |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len Ap |SV* |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash Ap |bool |avhv_exists_ent|AV *ar|SV* keysv|U32 hash Ap |SV** |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash @@ -2470,6 +2471,7 @@ s |char* |scan_trans |char *start s |char* |scan_word |char *s|char *dest|STRLEN destlen \ |int allow_package|STRLEN *slp s |char* |skipspace |char *s +s |char* |swallow_bom |char *s s |void |checkcomma |char *s|char *name|char *what s |void |force_ident |char *s|int kind s |void |incline |char *s diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm index 98ee34d57d..57bfa0d1c1 100644 --- a/ext/File/Glob/Glob.pm +++ b/ext/File/Glob/Glob.pm @@ -138,6 +138,9 @@ sub csh_glob { $pat = $_ unless defined $pat; # extract patterns + $pat =~ s/^\s+//; # Protect against empty elements in + $pat =~ s/\s+$//; # things like < *.c> and <*.c >. + # These alone shouldn't trigger ParseWords. if ($pat =~ /\s/) { # XXX this is needed for compatibility with the csh # implementation in Perl. Need to support a flag diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index eb085f542f..1e9ff45cc9 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -288,7 +288,7 @@ $END = "!End!\n\n"; # "impossible" keyword (multiple newline) # Match an XS keyword $BLOCK_re= '\s*(' . join('|', qw( REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT - CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE + CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL )) . "|$END)\\s*:"; @@ -573,6 +573,15 @@ sub GetAliases if $line ; } +sub ATTRS_handler () +{ + for (; !/^$BLOCK_re/o; $_ = shift(@line)) { + next unless /\S/; + TrimWhitespace($_) ; + push @Attributes, $_; + } +} + sub ALIAS_handler () { for (; !/^$BLOCK_re/o; $_ = shift(@line)) { @@ -1056,7 +1065,7 @@ while (fetch_para()) { last; } $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ; - %XsubAliases = %XsubAliasValues = %Interfaces = (); + %XsubAliases = %XsubAliasValues = %Interfaces = @Attributes = (); $DoSetMagic = 1; $orig_args =~ s/\\\s*/ /g; # process line continuations @@ -1227,7 +1236,7 @@ EOF $gotRETVAL = 0; INPUT_handler() ; - process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ; + process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|ATTRS|PROTOTYPE|SCOPE") ; print Q<<"EOF" if $ScopeThisXSUB; # ENTER; @@ -1269,7 +1278,7 @@ EOF } print $deferred; - process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; + process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ; if (check_keyword("PPCODE")) { print_section(); @@ -1313,7 +1322,7 @@ EOF # $wantRETVAL set if 'RETVAL =' autogenerated ($wantRETVAL, $ret_type) = (0, 'void') if $RETVAL_no_return; undef %outargs ; - process_keyword("POSTCALL|OUTPUT|ALIAS|PROTOTYPE"); + process_keyword("POSTCALL|OUTPUT|ALIAS|ATTRS|PROTOTYPE"); # all OUTPUT done, so now push the return value on the stack if ($gotRETVAL && $RETVAL_code) { @@ -1358,7 +1367,7 @@ EOF generate_output($var_types{$_}, $num++, $_, 0, 1) for @in_out; # do cleanup - process_keyword("CLEANUP|ALIAS|PROTOTYPE") ; + process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE") ; print Q<<"EOF" if $ScopeThisXSUB; # ]] @@ -1448,6 +1457,12 @@ EOF EOF } } + elsif (@Attributes) { + push(@InitFileCode, Q<<"EOF"); +# cv = newXS(\"$pname\", XS_$Full_func_name, file); +# apply_attrs_string("$Package", cv, "@Attributes", 0); +EOF + } elsif ($interface) { while ( ($name, $value) = each %Interfaces) { $name = "$Package\::$name" unless $name =~ /::/; diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 2713383a00..40da9f3817 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -442,7 +442,11 @@ hosts on a network. A ping object is first created with optional parameters, a variable number of hosts may be pinged multiple times and then the connection is closed. -You may choose one of three different protocols to use for the ping. +You may choose one of three different protocols to use for the +ping. The "udp" protocol is the default. Note that a live remote host +may still fail to be pingable by one or more of these protocols. For +example, www.microsoft.com is generally alive but not pingable. + With the "tcp" protocol the ping() method attempts to establish a connection to the remote host's echo port. If the connection is successfully established, the remote host is considered reachable. No diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index 89e3d0f432..346495f3de 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -1438,8 +1438,10 @@ sub process_text1($$;$$){ } elsif( $func eq 'E' ){ # E<x> - convert to character - $$rstr =~ s/^(\w+)>//; - $res = "&$1;"; + $$rstr =~ s/^([^>]*)>//; + my $escape = $1; + $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i; + $res = "&$escape;"; } elsif( $func eq 'F' ){ # F<filename> - italizice @@ -1940,7 +1942,7 @@ sub depod1($;$$){ $res .= $$rstr; } elsif( $func eq 'E' ){ # E<x> - convert to character - $$rstr =~ s/^(\w+)>//; + $$rstr =~ s/^([^>]*)>//; $res .= $E2c{$1} || ""; } elsif( $func eq 'X' ){ # X<> - ignore diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm index 8673ba4795..439b22c35b 100644 --- a/lib/Pod/Man.pm +++ b/lib/Pod/Man.pm @@ -194,6 +194,8 @@ $PREAMBLE = <<'----END OF PREAMBLE----'; 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote + 'sol' => '/', # solidus + 'verbar' => '|', # vertical bar 'Aacute' => "A\\*'", # capital A, acute accent 'aacute' => "a\\*'", # small a, acute accent diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm index f5c1e3d0cf..47dcee584f 100644 --- a/lib/Pod/Text.pm +++ b/lib/Pod/Text.pm @@ -53,6 +53,8 @@ $VERSION = 2.04; 'lt' => '<', # left chevron, less-than 'gt' => '>', # right chevron, greater-than 'quot' => '"', # double quote + 'sol' => '/', # solidus + 'verbar' => '|', # vertical bar "Aacute" => "\xC1", # capital A, acute accent "aacute" => "\xE1", # small a, acute accent diff --git a/lib/Text/Wrap.pm b/lib/Text/Wrap.pm index 5f95edb69c..04efe19296 100644 --- a/lib/Text/Wrap.pm +++ b/lib/Text/Wrap.pm @@ -6,7 +6,7 @@ require Exporter; @EXPORT = qw(wrap fill); @EXPORT_OK = qw($columns $break $huge); -$VERSION = 98.112902; +$VERSION = 2000.06292219; #GMT use vars qw($VERSION $columns $debug $break $huge); use strict; @@ -33,7 +33,7 @@ sub wrap my $remainder = ""; while ($t !~ /^\s*$/) { - if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//xm) { + if ($t =~ s/^([^\n]{0,$ll})($break|\Z(?!\n))//x) { $r .= unexpand($nl . $lead . $1); $remainder = $2; } elsif ($huge eq 'wrap' && $t =~ s/^([^\n]{$ll})//) { @@ -35,6 +35,10 @@ #define Perl_Gv_AMupdate pPerl->Perl_Gv_AMupdate #undef Gv_AMupdate #define Gv_AMupdate Perl_Gv_AMupdate +#undef Perl_apply_attrs_string +#define Perl_apply_attrs_string pPerl->Perl_apply_attrs_string +#undef apply_attrs_string +#define apply_attrs_string Perl_apply_attrs_string #undef Perl_avhv_delete_ent #define Perl_avhv_delete_ent pPerl->Perl_avhv_delete_ent #undef avhv_delete_ent @@ -1851,6 +1851,37 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs) LEAVE; } +void +Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, + char *attrstr, STRLEN len) +{ + OP *attrs = Nullop; + + if (!len) { + len = strlen(attrstr); + } + + while (len) { + for (; isSPACE(*attrstr) && len; --len, ++attrstr) ; + if (len) { + char *sstr = attrstr; + for (; !isSPACE(*attrstr) && len; --len, ++attrstr) ; + attrs = append_elem(OP_LIST, attrs, + newSVOP(OP_CONST, 0, + newSVpvn(sstr, attrstr-sstr))); + } + } + + Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS, + newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1), + Nullsv, prepend_elem(OP_LIST, + newSVOP(OP_CONST, 0, newSVpv(stashpv,0)), + prepend_elem(OP_LIST, + newSVOP(OP_CONST, 0, + newRV((SV*)cv)), + attrs))); +} + STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs) { @@ -85,6 +85,13 @@ Perl_Gv_AMupdate(pTHXo_ HV* stash) return ((CPerlObj*)pPerl)->Perl_Gv_AMupdate(stash); } +#undef Perl_apply_attrs_string +void +Perl_apply_attrs_string(pTHXo_ char *stashpv, CV *cv, char *attrstr, STRLEN len) +{ + ((CPerlObj*)pPerl)->Perl_apply_attrs_string(stashpv, cv, attrstr, len); +} + #undef Perl_avhv_delete_ent SV* Perl_avhv_delete_ent(pTHXo_ AV *ar, SV* keysv, I32 flags, U32 hash) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 00fc8601a4..78a631883e 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -1265,11 +1265,11 @@ there was an error. In the first form, the return value of EXPR is parsed and executed as if it were a little Perl program. The value of the expression (which is itself determined within scalar context) is first parsed, and if there weren't any -errors, executed in the context of the current Perl program, so that any -variable settings or subroutine and format definitions remain afterwards. -Note that the value is parsed every time the eval executes. If EXPR is -omitted, evaluates C<$_>. This form is typically used to delay parsing -and subsequent execution of the text of EXPR until run time. +errors, executed in the lexical context of the current Perl program, so +that any variable settings or subroutine and format definitions remain +afterwards. Note that the value is parsed every time the eval executes. +If EXPR is omitted, evaluates C<$_>. This form is typically used to +delay parsing and subsequent execution of the text of EXPR until run time. In the second form, the code within the BLOCK is parsed only once--at the same time the code surrounding the eval itself was parsed--and executed @@ -2078,9 +2078,9 @@ or equivalently, @foo = grep {!/^#/} @bar; # weed out comments -Note that, because C<$_> is a reference into the list value, it can -be used to modify the elements of the array. While this is useful and -supported, it can cause bizarre results if the LIST is not a named array. +Note that C<$_> is an alias to the list value, so it can be used to +modify the elements of the LIST. While this is useful and supported, +it can cause bizarre results if the elements of LIST are not variables. Similarly, grep returns aliases into the original list, much as a for loop's index variable aliases the list elements. That is, modifying an element of a list returned by grep (for example, in a C<foreach>, C<map> @@ -2462,9 +2462,9 @@ is just a funny way to write $hash{getkey($_)} = $_; } -Note that, because C<$_> is a reference into the list value, it can -be used to modify the elements of the array. While this is useful and -supported, it can cause bizarre results if the LIST is not a named array. +Note that C<$_> is an alias to the list value, so it can be used to +modify the elements of the LIST. While this is useful and supported, +it can cause bizarre results if the elements of LIST are not variables. Using a regular C<foreach> loop for this purpose would be clearer in most cases. See also L</grep> for an array composed of those items of the original list for which the BLOCK or EXPR evaluates to true. diff --git a/pod/perlsub.pod b/pod/perlsub.pod index f45f5494f6..997631674f 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -39,7 +39,7 @@ To call subroutines: Like many languages, Perl provides for user-defined subroutines. These may be located anywhere in the main program, loaded in from other files via the C<do>, C<require>, or C<use> keywords, or -generated on the fly using C<eval> or anonymous subroutines (closures). +generated on the fly using C<eval> or anonymous subroutines. You can even call a function indirectly using a variable containing its name or a CODE reference. diff --git a/pod/perltie.pod b/pod/perltie.pod index 49bf98999c..b39d7d5336 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -310,14 +310,14 @@ the following output demonstrates: =head2 Tying Hashes -As the first Perl data type to be tied (see dbmopen()), hashes have the -most complete and useful tie() implementation. A class implementing a -tied hash should define the following methods: TIEHASH is the constructor. -FETCH and STORE access the key and value pairs. EXISTS reports whether a -key is present in the hash, and DELETE deletes one. CLEAR empties the -hash by deleting all the key and value pairs. FIRSTKEY and NEXTKEY -implement the keys() and each() functions to iterate over all the keys. -And DESTROY is called when the tied variable is garbage collected. +Hashes were the first Perl data type to be tied (see dbmopen()). A class +implementing a tied hash should define the following methods: TIEHASH is +the constructor. FETCH and STORE access the key and value pairs. EXISTS +reports whether a key is present in the hash, and DELETE deletes one. +CLEAR empties the hash by deleting all the key and value pairs. FIRSTKEY +and NEXTKEY implement the keys() and each() functions to iterate over all +the keys. And DESTROY is called when the tied variable is garbage +collected. If this seems like a lot, then feel free to inherit from merely the standard Tie::Hash module for most of your methods, redefining only the @@ -61,6 +61,11 @@ PERL_CALLCONV bool Perl_Gv_AMupdate(pTHX_ HV* stash); PERL_CALLCONV OP* Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail); PERL_CALLCONV OP* Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last); PERL_CALLCONV I32 Perl_apply(pTHX_ I32 type, SV** mark, SV** sp); +PERL_CALLCONV void Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, char *attrstr, STRLEN len) +#ifdef CHECK_FORMAT + __attribute__((format(printf,pTHX_3,pTHX_4))) +#endif +; PERL_CALLCONV SV* Perl_avhv_delete_ent(pTHX_ AV *ar, SV* keysv, I32 flags, U32 hash); PERL_CALLCONV bool Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash); PERL_CALLCONV SV** Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash); @@ -1010,6 +1015,7 @@ STATIC char* S_gv_ename(pTHX_ GV *gv); STATIC void S_cv_dump(pTHX_ CV *cv); STATIC CV* S_cv_clone2(pTHX_ CV *proto, CV *outside); STATIC bool S_scalar_mod_type(pTHX_ OP *o, I32 type); +STATIC OP * S_method_2entersub(pTHX_ OP *o, OP *o2, OP *svop); STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs); STATIC OP * S_dup_attrlist(pTHX_ OP *o); STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs); @@ -1219,6 +1225,7 @@ STATIC char* S_scan_subst(pTHX_ char *start); STATIC char* S_scan_trans(pTHX_ char *start); STATIC char* S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp); STATIC char* S_skipspace(pTHX_ char *s); +STATIC char* S_swallow_bom(pTHX_ char *s); STATIC void S_checkcomma(pTHX_ char *s, char *name, char *what); STATIC void S_force_ident(pTHX_ char *s, int kind); STATIC void S_incline(pTHX_ char *s); diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t index a7fca17811..e304766fc1 100755 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -5,6 +5,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){ + print "1..0 # Skipping (no DB_File or [A-Z]DBM_File)\n"; + exit 0; + } } require AnyDBM_File; use Fcntl; diff --git a/t/lib/dprof.t b/t/lib/dprof.t index 4d6f7823c3..fc5bd050cb 100755 --- a/t/lib/dprof.t +++ b/t/lib/dprof.t @@ -3,6 +3,11 @@ BEGIN { chdir( 't' ) if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bDevel\/DProf\b/){ + print "1..0 # Skip: Devel::DProf was not built\n"; + exit 0; + } } END { @@ -11,7 +16,6 @@ END { use Benchmark qw( timediff timestr ); use Getopt::Std 'getopts'; -use Config '%Config'; getopts('vI:p:'); # -v Verbose diff --git a/t/lib/dumper-ovl.t b/t/lib/dumper-ovl.t index 8c095e59be..b8c8719318 100755 --- a/t/lib/dumper-ovl.t +++ b/t/lib/dumper-ovl.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { + print "1..0 # Skip: Data::Dumper was not built\n"; + exit 0; + } } use Data::Dumper; diff --git a/t/lib/dumper.t b/t/lib/dumper.t index b9680bd5e6..7b5a611b7d 100755 --- a/t/lib/dumper.t +++ b/t/lib/dumper.t @@ -6,6 +6,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bData\/Dumper\b/) { + print "1..0 # Skip: Data::Dumper was not built\n"; + exit 0; + } } use Data::Dumper; diff --git a/t/lib/hostname.t b/t/lib/hostname.t index 6f61fb9dad..8a34e9c4e7 100755 --- a/t/lib/hostname.t +++ b/t/lib/hostname.t @@ -3,6 +3,11 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bSys\/Hostname\b/) { + print "1..0 # Skip: Sys::Hostname was not built\n"; + exit 0; + } } use Sys::Hostname; diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t index a4f3e3f367..d2991e3eac 100755 --- a/t/lib/ipc_sysv.t +++ b/t/lib/ipc_sysv.t @@ -9,7 +9,9 @@ BEGIN { my $reason; - if ($Config{'d_sem'} ne 'define') { + if ($Config{'extensions'} !~ /\bIPC\/SysV\b/) { + $reason = 'IPC::SysV was not built'; + } elsif ($Config{'d_sem'} ne 'define') { $reason = '$Config{d_sem} undefined'; } elsif ($Config{'d_msg'} ne 'define') { $reason = '$Config{d_msg} undefined'; diff --git a/t/op/sprintf.t b/t/op/sprintf.t index 4d54d2c317..d731ac4138 100755 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -1,6 +1,10 @@ #!./perl -# $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $ +# Tests sprintf, excluding handling of 64-bit integers or long +# doubles (if supported), of machine-specific short and long +# integers, machine-specific floating point exceptions (infinity, +# not-a-number ...), of the effects of locale, and of features +# specific to multi-byte characters (under use utf8 and such). BEGIN { chdir 't' if -d 't'; @@ -8,31 +12,239 @@ BEGIN { } use warnings; -print "1..4\n"; +while (<DATA>) { + s/^\s*>//; s/<\s*$//; + push @tests, [split(/<\s*>/, $_, 4)]; +} + +print '1..', scalar @tests, "\n"; $SIG{__WARN__} = sub { if ($_[0] =~ /^Invalid conversion/) { - $w++; + $w = ' INVALID' } else { - warn @_; + warn @_; } }; -$w = 0; -$x = sprintf("%3s %-4s%%foo %.0d%5d %#x%c%3.1f %b %x %X %#b %#x %#X","hi",123,0,456,0,ord('A'),3.0999,11,171,171,11,171,171); -if ($x eq ' hi 123 %foo 456 0A3.1 1011 ab AB 0b1011 0xab 0XAB' && $w == 0) { - print "ok 1\n"; -} else { - print "not ok 1 '$x'\n"; -} - -for $i (2 .. 4) { - $f = ('%6 .6s', '%6. 6s', '%6.6 s')[$i - 2]; - $w = 0; - $x = sprintf($f, ''); - if ($x eq $f && $w == 1) { - print "ok $i\n"; - } else { - print "not ok $i '$x' '$f' '$w'\n"; +for ($i = 1; @tests; $i++) { + ($template, $data, $result, $comment) = @{shift @tests}; + $evalData = eval $data; + $w = undef; + $x = sprintf(">$template<", + defined @$evalData ? @$evalData : $evalData); + substr($x, -1, 0) = $w if $w; + if ($x eq ">$result<") { + print "ok $i\n"; + } + else { + print("not ok $i >$template< >$data< >$result< $x", + $comment ? " # $comment\n" : "\n"); } } + +# In each of the the following lines, there are three required fields: +# printf template, data to be formatted (as a Perl expression), and +# expected result of formatting. An optional fourth field can contain +# a comment. Each field is delimited by a starting '>' and a +# finishing '<'; any whitespace outside these start and end marks is +# not part of the field. If formatting requires more than one data +# item (for example, if variable field widths are used), the Perl data +# expression should return a reference to an array having the requisite +# number of elements. Even so, subterfuge is sometimes required: see +# tests for %n and %p. +# +# template data result +__END__ +>%6 .6s< >''< >%6 .6s INVALID< >First test from old sprintf.t< +>%6. 6s< >''< >%6. 6s INVALID< >(See use of $w in code above)< +>%6.6 s< >''< >%6.6 s INVALID< +>%3s< >'hi'< > hi< +>%-4s< >123< >123 < +>%%foo< >'bar'< >%foo< +>%.0d< >0< >< +>%5d< >456< > 456< +>%#x< >0< >0< +>%c< >ord('A')< >A< +>%3.1f< >3.0999< >3.1< +>%b< >11< >1011< +>%x< >171< >ab< +>%X< >171< >AB< +>%#b< >11< >0b1011< +>%#x< >171< >0xab< +>%#X< >171< >0XAB< >Last test from old sprintf.t< +>%A< >''< >%A INVALID< >First new test< +>%B< >''< >%B INVALID< +>%C< >''< >%C INVALID< +>%D< >0x7fffffff< >2147483647< >Synonym for %ld< +>%E< >123456.789< >1.234568E+05< >Like %e, but using upper-case "E"< +>%F< >123456.789< >123456.789000< >Synonym for %f< +>%G< >1234567.89< >1.23457E+06< >Like %g, but using upper-case "E"< +>%G< >12345.6789< >12345.7< +>%H< >''< >%H INVALID< +>%I< >''< >%I INVALID< +>%J< >''< >%J INVALID< +>%K< >''< >%K INVALID< +>%L< >''< >%L INVALID< +>%M< >''< >%M INVALID< +>%N< >''< >%N INVALID< +>%O< >2**32-1< >37777777777< >Synonym for %lo< +>%P< >''< >%P INVALID< +>%Q< >''< >%Q INVALID< +>%R< >''< >%R INVALID< +>%S< >''< >%S INVALID< +>%T< >''< >%T INVALID< +>%U< >2**32-1< >4294967295< >Synonym for %lu< +>%V< >''< >%V INVALID< +>%W< >''< >%W INVALID< +>%X< >2**32-1< >FFFFFFFF< >Like %x, but with u/c letters< +>%#X< >2**32-1< >0XFFFFFFFF< +>%Y< >''< >%Y INVALID< +>%Z< >''< >%Z INVALID< +>%a< >''< >%a INVALID< +>%b< >2**32-1< >11111111111111111111111111111111< +>%+b< >2**32-1< >11111111111111111111111111111111< +>%#b< >2**32-1< >0b11111111111111111111111111111111< +>%34b< >2**32-1< > 11111111111111111111111111111111< +>%034b< >2**32-1< >0011111111111111111111111111111111< +>%-34b< >2**32-1< >11111111111111111111111111111111 < +>%-034b< >2**32-1< >11111111111111111111111111111111 < +>%c< >ord('A')< >A< +>%10c< >ord('A')< > A< +>%#10c< >ord('A')< > A< ># modifier: no effect< +>%010c< >ord('A')< >000000000A< +>%10lc< >ord('A')< > A< >l modifier: no effect< +>%10hc< >ord('A')< > A< >h modifier: no effect< +>%10.5c< >ord('A')< > A< >precision: no effect< +>%-10c< >ord('A')< >A < +>%d< >123456.789< >123456< +>%d< >-123456.789< >-123456< +>%d< >0< >0< +>%+d< >0< >+0< +>%0d< >0< >0< +>%.0d< >0< >< +>%+.0d< >0< >+< +>%.0d< >1< >1< +>%d< >1< >1< +>%+d< >1< >+1< +>%#3.2d< >1< > 01< ># modifier: no effect< +>%3.2d< >1< > 01< +>%03.2d< >1< >001< +>%-3.2d< >1< >01 < +>%-03.2d< >1< >01 < >zero pad + left just.: no effect< +>%d< >-1< >-1< +>%+d< >-1< >-1< +>%hd< >1< >1< >More extensive testing of< +>%ld< >1< >1< >length modifiers would be< +>%Vd< >1< >1< >platform-specific< +>%vd< >chr(1)< >1< +>%+vd< >chr(1)< >+1< +>%#vd< >chr(1)< >1< +>%vd< >"\01\02\03"< >1.2.3< +>%v.3d< >"\01\02\03"< >001.002.003< +>%v03d< >"\01\02\03"< >001.002.003< +>%v-3d< >"\01\02\03"< >1 .2 .3 < +>%v+-3d< >"\01\02\03"< >+1 .2 .3 < +>%v4.3d< >"\01\02\03"< > 001. 002. 003< +>%v04.3d< >"\01\02\03"< >0001.0002.0003< +>%*v02d< >['-', "\0\6\35"]< >00-06-29< +>%e< >1234.875< >1.234875e+03< +>%+e< >1234.875< >+1.234875e+03< +>%#e< >1234.875< >1.234875e+03< +>%e< >-1234.875< >-1.234875e+03< +>%+e< >-1234.875< >-1.234875e+03< +>%#e< >-1234.875< >-1.234875e+03< +>%.0e< >1234.875< >1e+03< +>%.*e< >[0, 1234.875]< >1e+03< +>%.1e< >1234.875< >1.2e+03< +>%-12.4e< >1234.875< >1.2349e+03 < +>%12.4e< >1234.875< > 1.2349e+03< +>%+-12.4e< >1234.875< >+1.2349e+03 < +>%+12.4e< >1234.875< > +1.2349e+03< +>%+-12.4e< >-1234.875< >-1.2349e+03 < +>%+12.4e< >-1234.875< > -1.2349e+03< +>%f< >1234.875< >1234.875000< +>%+f< >1234.875< >+1234.875000< +>%#f< >1234.875< >1234.875000< +>%f< >-1234.875< >-1234.875000< +>%+f< >-1234.875< >-1234.875000< +>%#f< >-1234.875< >-1234.875000< +>%6f< >1234.875< >1234.875000< +>%*f< >[6, 1234.875]< >1234.875000< +>%.0f< >1234.875< >1235< +>%.1f< >1234.875< >1234.9< +>%-8.1f< >1234.875< >1234.9 < +>%8.1f< >1234.875< > 1234.9< +>%+-8.1f< >1234.875< >+1234.9 < +>%+8.1f< >1234.875< > +1234.9< +>%+-8.1f< >-1234.875< >-1234.9 < +>%+8.1f< >-1234.875< > -1234.9< +>%*.*f< >[5, 2, 12.3456]< >12.35< +>%g< >12345.6789< >12345.7< +>%+g< >12345.6789< >+12345.7< +>%#g< >12345.6789< >12345.7< +>%.0g< >12345.6789< >1e+04< +>%.2g< >12345.6789< >1.2e+04< +>%.*g< >[2, 12345.6789]< >1.2e+04< +>%.9g< >12345.6789< >12345.6789< +>%12.9g< >12345.6789< > 12345.6789< +>%012.9g< >12345.6789< >0012345.6789< +>%-12.9g< >12345.6789< >12345.6789 < +>%*.*g< >[-12, 9, 12345.6789]< >12345.6789 < +>%-012.9g< >12345.6789< >12345.6789 < +>%g< >-12345.6789< >-12345.7< +>%+g< >-12345.6789< >-12345.7< +>%g< >1234567.89< >1.23457e+06< +>%+g< >1234567.89< >+1.23457e+06< +>%#g< >1234567.89< >1.23457e+06< +>%g< >-1234567.89< >-1.23457e+06< +>%+g< >-1234567.89< >-1.23457e+06< +>%#g< >-1234567.89< >-1.23457e+06< +>%13g< >1234567.89< > 1.23457e+06< +>%+13g< >1234567.89< > +1.23457e+06< +>%013g< >1234567.89< >001.23457e+06< +>%-13g< >1234567.89< >1.23457e+06 < +>%h< >''< >%h INVALID< +>%i< >123456.789< >123456< >Synonym for %d< +>%j< >''< >%j INVALID< +>%k< >''< >%k INVALID< +>%l< >''< >%l INVALID< +>%m< >''< >%m INVALID< +>%s< >sprintf('%%n%n %d', $n, $n)< >%n 2< >Slight sneakiness to test %n< +>%o< >2**32-1< >37777777777< +>%+o< >2**32-1< >37777777777< +>%#o< >2**32-1< >037777777777< +>%d< >$p=sprintf('%p',$p);$p=~/^[0-9a-f]+$/< >1< >Coarse hack: hex from %p?< +>%q< >''< >%q INVALID< +>%r< >''< >%r INVALID< +>%s< >'string'< >string< +>%10s< >'string'< > string< +>%+10s< >'string'< > string< +>%#10s< >'string'< > string< +>%010s< >'string'< >0000string< +>%0*s< >[10, 'string']< >0000string< +>%-10s< >'string'< >string < +>%3s< >'string'< >string< +>%.3s< >'string'< >str< +>%.*s< >[3, 'string']< >str< +>%t< >''< >%t INVALID< +>%u< >2**32-1< >4294967295< +>%+u< >2**32-1< >4294967295< +>%#u< >2**32-1< >4294967295< +>%12u< >2**32-1< > 4294967295< +>%012u< >2**32-1< >004294967295< +>%-12u< >2**32-1< >4294967295 < +>%-012u< >2**32-1< >4294967295 < +>%v< >''< >%v INVALID< +>%w< >''< >%w INVALID< +>%x< >2**32-1< >ffffffff< +>%+x< >2**32-1< >ffffffff< +>%#x< >2**32-1< >0xffffffff< +>%10x< >2**32-1< > ffffffff< +>%010x< >2**32-1< >00ffffffff< +>%-10x< >2**32-1< >ffffffff < +>%-010x< >2**32-1< >ffffffff < +>%0-10x< >2**32-1< >ffffffff < +>%0*x< >[-10, ,2**32-1]< >ffffffff < +>%y< >''< >%y INVALID< +>%z< >''< >%z INVALID< diff --git a/t/op/taint.t b/t/op/taint.t index 6548b46f59..af578347cc 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -24,7 +24,8 @@ BEGIN { $ENV{PATH} = $ENV{PATH}; $ENV{TERM} = $ENV{TERM} ne ''? $ENV{TERM} : 'dummy'; } - if ($Config{d_shm} || $Config{d_msg}) { + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ + && ($Config{d_shm} || $Config{d_msg})) { require IPC::SysV; IPC::SysV->import(qw(IPC_PRIVATE IPC_RMID IPC_CREAT S_IRWXU)); } @@ -612,7 +613,7 @@ else { # test shmread { - if ($Config{d_shm}) { + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ && $Config{d_shm}) { no strict 'subs'; my $sent = "foobar"; my $rcvd; @@ -646,7 +647,7 @@ else { # test msgrcv { - if ($Config{d_msg}) { + if ($Config{'extensions'} =~ /\bIPC\/SysV\b/ && $Config{d_msg}) { no strict 'subs'; my $id = msgget(IPC_PRIVATE, IPC_CREAT | S_IRWXU); diff --git a/utils/h2xs.PL b/utils/h2xs.PL index 84c69237ff..2885c6f5ee 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -13,9 +13,9 @@ use Cwd; # This forces PL files to create target in same directory as PL file. # This is so that make depend always knows where to find PL derivatives. -$origdir = cwd; +my $origdir = cwd; chdir dirname($0); -$file = basename($0, '.PL'); +my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; open OUT,">$file" or die "Can't create $file: $!"; @@ -41,7 +41,7 @@ h2xs - convert .h C header files to Perl extensions =head1 SYNOPSIS -B<h2xs> [B<-ACOPXcdf>] [B<-v> version] [B<-n> module_name] [B<-p> prefix] [B<-s> sub] [headerfile ... [extra_libraries]] +B<h2xs> [B<-ACOPXacdfkmx>] [B<-F> addflags] [B<-M> fmask] [B<-n> module_name] [B<-o> tmask] [B<-p> prefix] [B<-s> subs] [B<-v> version] [headerfile ... [extra_libraries]] B<h2xs> B<-h> @@ -78,7 +78,7 @@ S<C<use AutoLoader>> statement from the .pm file. Omits creation of the F<Changes> file, and adds a HISTORY section to the POD template. -=item B<-F> +=item B<-F> I<addflags> Additional flags to specify to C preprocessor when scanning header for function declarations. Should not be used without B<-x>. @@ -191,6 +191,18 @@ hand-editing. Such may be objects which cannot be converted from/to a pointer (like C<long long>), pointers to functions, or arrays. See also the section on L<LIMITATIONS of B<-x>>. +=item B<-b> I<version> + +Generates a .pm file which is backwards compatible with the specified +perl version. + +For versions < 5.6.0, the changes are. + - no use of 'our' (uses 'use vars' instead) + - no 'use warnings' + +Specifying a compatibility version higher than the version of perl you +are using to run h2xs will have no effect. + =back =head1 EXAMPLES @@ -332,12 +344,13 @@ use strict; my( $H2XS_VERSION ) = ' $Revision: 1.20 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; +my $compat_version = $]; use Getopt::Std; sub usage{ warn "@_\n" if @_; - die "h2xs [-ACOPXcdfh] [-v version] [-n module_name] [-p prefix] [-s subs] [headerfile [extra_libraries]] + die "h2xs [-ACOPXacdfhkmx] [-F addflags] [-M fmask] [-n module_name] [-o tmask] [-p prefix] [-s subs] [-v version] [headerfile [extra_libraries]] version: $H2XS_VERSION -A Omit all autoloading facilities (implies -c). -C Omit creating the Changes file, add HISTORY heading to stub POD. @@ -359,6 +372,7 @@ version: $H2XS_VERSION -s Create subroutines for specified macros. -v Specify a version number for this extension. -x Autogenerate XSUBs using C::Scan. + -b Specify a perl version to be backwards compatibile with extra_libraries are any libraries that might be needed for loading the extension, e.g. -lm would try to link in the math library. @@ -366,12 +380,22 @@ extra_libraries } -getopts("ACF:M:OPXacdfhkmn:o:p:s:v:x") || usage; +getopts("ACF:M:OPXacdfhkmn:o:p:s:v:xb:") || usage; use vars qw($opt_A $opt_C $opt_F $opt_M $opt_O $opt_P $opt_X $opt_a $opt_c $opt_d - $opt_f $opt_h $opt_k $opt_m $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x); + $opt_f $opt_h $opt_k $opt_m $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x + $opt_b); usage if $opt_h; +if( $opt_b ){ + usage "You cannot use -b and -m at the same time.\n" if ($opt_b && $opt_m); + $opt_b =~ /^\d+\.\d+\.\d+/ || + usage "You must provide the backwards compatibility version in X.Y.Z form. " . + "(i.e. 5.5.0)\n"; + my ($maj,$min,$sub) = split(/\./,$opt_b,3); + $compat_version = sprintf("%d.%03d%02d",$maj,$min,$sub); +} + if( $opt_v ){ $TEMPLATE_VERSION = $opt_v; } @@ -685,6 +709,15 @@ open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n" $" = "\n\t"; warn "Writing $ext$modpname/$modfname.pm\n"; +if ( $compat_version < 5.006 ) { +print PM <<"END"; +package $module; + +use $compat_version; +use strict; +END +} +else { print PM <<"END"; package $module; @@ -692,6 +725,7 @@ use 5.006; use strict; use warnings; END +} unless( $opt_X || $opt_c || $opt_A ){ # we'll have an AUTOLOAD(), and it will have $AUTOLOAD and @@ -721,15 +755,25 @@ unless ($opt_A) { # no autoloader whatsoever. } } +if ( $compat_version < 5.006 ) { + if ( $opt_X || $opt_c || $opt_A ) { + print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);'; + } else { + print PM 'use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);'; + } +} + # Determine @ISA. my $myISA = 'our @ISA = qw(Exporter'; # We seem to always want this. $myISA .= ' DynaLoader' unless $opt_X; # no XS $myISA .= ');'; +$myISA =~ s/^our // if $compat_version < 5.006; + print PM "\n$myISA\n\n"; my @exported_names = (@const_names, @fnames_no_prefix, map '$'.$_, @vdecls); -print PM<<"END"; +my $tmp=<<"END"; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. @@ -750,10 +794,15 @@ our \$VERSION = '$TEMPLATE_VERSION'; END +$tmp =~ s/^our //mg if $compat_version < 5.006; +print PM $tmp; + if (@vdecls) { printf PM "our(@{[ join ', ', map '$'.$_, @vdecls ]});\n\n"; } + +$tmp = ( $compat_version < 5.006 ? "" : "our \$AUTOLOAD;" ); print PM <<"END" unless $opt_c or $opt_X; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() @@ -761,7 +810,7 @@ sub AUTOLOAD { # to the AUTOLOAD in AutoLoader. my \$constname; - our \$AUTOLOAD; + $tmp (\$constname = \$AUTOLOAD) =~ s/.*:://; croak "&$module::constant not defined" if \$constname eq 'constant'; my \$val = constant(\$constname, \@_ ? \$_[0] : 0); @@ -394,7 +394,7 @@ prime_env_iter(void) $DESCRIPTOR(clidsc,"DCL"); $DESCRIPTOR(clitabdsc,"DCLTABLES"); $DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM"); $DESCRIPTOR(local,"_LOCAL"); $DESCRIPTOR(mbxdsc,mbxnam); -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) static perl_mutex primenv_mutex; MUTEX_INIT(&primenv_mutex); #endif |