This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate changes#6268..6282 from cfgperl branch
authorGurusamy Sarathy <gsar@cpan.org>
Mon, 20 Nov 2000 11:51:00 +0000 (11:51 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Mon, 20 Nov 2000 11:51:00 +0000 (11:51 +0000)
       Subject: [PATCH perl-current] Make op/sprintf.t more comprehensive
       From: Dominic Dunlop <domo@computer.org>
       Date: Thu, 29 Jun 2000 12:32:39 +0200
       Message-Id: <p04320403b580cc1338db@[192.168.1.4]>

       Regen headers for #6261 (and update embed.pl for this) and #6267,
       silence few compiler warnings.

       Subject: PATCH (Re: [ID 20000612.004] Should regression tests fail if user doesn't build XS extensions?)
       From: Nicholas Clark <nick@talking.bollo.cx>
       Date: Fri, 23 Jun 2000 16:21:15 +0100
       Message-ID: <20000623162115.A19894@Bagpuss.unfortu.net>

       Subject: PATCH pod/perltie.pod
       From: Ian Phillipps <Ian.Phillipps@iname.com>
       Date: Fri, 16 Jun 2000 00:17:19 +0100
       Message-ID: <20000616001719.A17108@homer.diplex.co.uk>
       (only the first hunk, the second hunk had already been done
        by some other patch)

       Subject: [ID 20000614.005] [patch] Tweak to Net::Ping docs
       From: Tom Phoenix <rootbeer@redcat.com>
       Received: (qmail 6398 invoked by uid 508); 15 Jun 2000 00:30:54 -0000
       Date: Wed, 14 Jun 2000 17:30:37 -0700 (PDT)

       Subject: [PATCH] xsub attributes
       From: Doug MacEachern <dougm@covalent.net>
       Date: Wed, 14 Jun 2000 15:09:22 -0700 (PDT)
       Message-ID: <Pine.LNX.4.10.10006141456050.340-100000@mojo.covalent.net>

       Subject: [ID 20000614.003] 5.6.0 File/Glob.pm incompatibility
       From: Andy Dougherty <doughera@lafayette.edu>
       Date: Wed, 14 Jun 2000 13:33:32 -0400 (EDT)
       Message-Id: <Pine.SOL.4.10.10006141332220.3643-100000@maxwell.phys.lafayette.edu>

       Subject: [PATCH] 5.6.0 lib/Pod/{Html,Man,Text}.pm
       From: "Daniel S. Lewart" <d-lewart@uiuc.edu>
       Date: Tue, 13 Jun 2000 02:43:48 -0500
       Message-ID: <20000613024347.A28388@staff2.cso.uiuc.edu>

       Subject: [PATCH] Re: eval documentation: context
       From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
       Date: Mon, 12 Jun 2000 15:07:29 +0100
       Message-Id: <E131UsD-0002ke-00@ursa.cus.cam.ac.uk>

       Subject: [PATCH] Re: [ID 20000612.001] map {chop; $_} (Literals problem)
       From: "M.J.T. Guy" <mjtg@cus.cam.ac.uk>
       Date: Mon, 12 Jun 2000 14:55:59 +0100
       Message-Id: <E131Uh5-0002cj-00@ursa.cus.cam.ac.uk>

       Subject: [ID 20000609.002] Text::Wrap::wrap does not handle multiline strings properly
       From: "Milton L. Hankins" <mlh@swl.msd.ray.com>
       Date: Fri, 09 Jun 2000 12:39:27 -0400
       Message-Id: <39411DBF.A04BB1A@swl.msd.ray.com>
       (plus update the version "number" of Text::Wrap)

       Subject: [ID 20000602.002] [PATCH] perlsub.pod: ambiguous usage of "closure"
       From: Tim Ayers <tayers@bridge.com>
       Date: Thu, 08 Jun 2000 08:11:06 +0200
       Message-id: <393F38FA.9B5F4C7D@m.dasa.de>
       [resent by Richard Foley, Message-Id probably wrong]

       Subject: Re: backwards compatibility in h2xs and makemaker  [PATCH]
       From: rspier@pobox.com (Robert Spier)
       Date: Wed, 7 Jun 2000 12:47:37 -0400 (EDT)
       Message-ID: <14654.31913.845602.610277@rls.cx>

       Subject: [PATCH 5.6.0] utils/h2xs.PL
       From: "Daniel S. Lewart" <d-lewart@uiuc.edu>
       Date: Wed, 7 Jun 2000 04:02:04 -0500
       Message-ID: <20000607040201.A22568@staff1.cso.uiuc.edu>

       Subject: [PATCH 5.6.0]ITHREADs for VMS
       From: Dan Sugalski <dan@sidhe.org>
       Date: Tue, 06 Jun 2000 11:59:50 -0400
       Message-Id: <4.3.2.7.0.20000606115752.01c82220@24.8.96.48>

p4raw-link: @6282 on //depot/cfgperl: d4817f5b97d4072a6efac47844b617245b179f2c
p4raw-link: @6268 on //depot/cfgperl: 22e04bdb3a09a4c369fd1666143349eab2eba9d4
p4raw-link: @24 on //depot/perl: 5dc0d6134ebb76636f69238201dde15cec972fd0

p4raw-id: //depot/maint-5.6/perl@7770
p4raw-integrated: from //depot/cfgperl@7769 'copy in' lib/Net/Ping.pm
lib/Text/Wrap.pm t/lib/dprof.t t/lib/dumper-ovl.t
t/lib/hostname.t (@5586..) lib/Pod/Html.pm (@5608..)
t/lib/ipc_sysv.t (@5812..) t/lib/dumper.t (@5972..)
ext/File/Glob/Glob.pm (@6026..) lib/Pod/Man.pm lib/Pod/Text.pm
(@6034..) t/lib/anydbm.t (@6072..) lib/ExtUtils/xsubpp
(@6156..) pod/perlsub.pod pod/perltie.pod (@6206..) 'edit in'
utils/h2xs.PL (@6280..)
p4raw-integrated: from //depot/cfgperl@6282 'merge in' vms/vms.c
(@6238..)
p4raw-integrated: from //depot/cfgperl@6277 'edit in' pod/perlfunc.pod
(@6276..)
p4raw-integrated: from //depot/cfgperl@6273 'copy in' embed.h (@6254..)
'edit in' embed.pl global.sym objXSUB.h op.c proto.h (@6269..)
'ignore' perlapi.h (@6243..) embedvar.h (@6254..) 'merge in'
perlapi.c (@6243..)
p4raw-integrated: from //depot/cfgperl@6270 'copy in' t/op/taint.t
(@5857..)
p4raw-integrated: from //depot/cfgperl@6269 'ignore' toke.c (@6261..)
'merge in' doop.c (@6263..)
p4raw-integrated: from //depot/cfgperl@6268 'copy in' t/op/sprintf.t
(@6267..)

28 files changed:
doop.c
embed.h
embed.pl
ext/File/Glob/Glob.pm
global.sym
lib/ExtUtils/xsubpp
lib/Net/Ping.pm
lib/Pod/Html.pm
lib/Pod/Man.pm
lib/Pod/Text.pm
lib/Text/Wrap.pm
objXSUB.h
op.c
perlapi.c
pod/perlfunc.pod
pod/perlsub.pod
pod/perltie.pod
proto.h
t/lib/anydbm.t
t/lib/dprof.t
t/lib/dumper-ovl.t
t/lib/dumper.t
t/lib/hostname.t
t/lib/ipc_sysv.t
t/op/sprintf.t
t/op/taint.t
utils/h2xs.PL
vms/vms.c

diff --git a/doop.c b/doop.c
index ff54461..3c49109 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -87,7 +87,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);
@@ -261,7 +261,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);
diff --git a/embed.h b/embed.h
index f419792..f5ce052 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -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
 #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
 #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
 #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)
 #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)
 #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)
 #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
 #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
 #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
index bf41a0a..a411bca 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -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
@@ -2469,6 +2470,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
index 98ee34d..57bfa0d 100644 (file)
@@ -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
index 1f03877..4990e03 100644 (file)
@@ -21,6 +21,7 @@ Perl_get_context
 Perl_set_context
 Perl_amagic_call
 Perl_Gv_AMupdate
+Perl_apply_attrs_string
 Perl_avhv_delete_ent
 Perl_avhv_exists_ent
 Perl_avhv_fetch_ent
index eb085f5..1e9ff45 100755 (executable)
@@ -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 =~ /::/;
index 2713383..40da9f3 100644 (file)
@@ -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
index 89e3d0f..346495f 100644 (file)
@@ -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
index 8673ba4..439b22c 100644 (file)
@@ -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
index f5c1e3d..47dcee5 100644 (file)
@@ -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
index 5f95edb..04efe19 100644 (file)
@@ -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})//) {
index e30258b..245b75c 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
 #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
diff --git a/op.c b/op.c
index 8098b38..df729de 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1850,6 +1850,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)
 {
index f4111e2..7663307 100644 (file)
--- a/perlapi.c
+++ b/perlapi.c
@@ -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)
index 00fc860..78a6318 100644 (file)
@@ -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.
index f45f549..9976316 100644 (file)
@@ -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.
 
index 49bf989..b39d7d5 100644 (file)
@@ -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
diff --git a/proto.h b/proto.h
index 0d70332..f251d20 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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);
@@ -1009,6 +1014,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);
@@ -1218,6 +1224,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);
index a7fca17..e304766 100755 (executable)
@@ -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;
index 4d6f782..fc5bd05 100755 (executable)
@@ -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
index 8c095e5..b8c8719 100755 (executable)
@@ -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;
index b9680bd..7b5a611 100755 (executable)
@@ -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;
index 6f61fb9..8a34e9c 100755 (executable)
@@ -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;
index a4f3e3f..d2991e3 100755 (executable)
@@ -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';
index 4d54d2c..d731ac4 100755 (executable)
@@ -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<
index 6548b46..af57834 100755 (executable)
@@ -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);
 
index 84c6923..2885c6f 100644 (file)
@@ -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);
index dd65271..40348e0 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -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