summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2000-02-26 16:43:11 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2000-02-26 16:43:11 +0000
commit397e9ec96cc690f8c3dff6027df09974bc82b9be (patch)
treed9d49b6c1f90ff3c4e05384c3104462462b28f9a
parent6e553f519dfd5c86896bb6ab836c1c352c02f5f4 (diff)
parent30168b04c3ba9bfb3a1fc4685e8e8d51ebd3e3f4 (diff)
downloadperl-397e9ec96cc690f8c3dff6027df09974bc82b9be.tar.gz
Integrate with Sarathy.
p4raw-id: //depot/cfgperl@5275
-rw-r--r--Makefile.SH3
-rw-r--r--README.vms87
-rw-r--r--av.c2
-rw-r--r--configure.com50
-rw-r--r--embed.h4
-rwxr-xr-xembed.pl1
-rw-r--r--global.sym1
-rwxr-xr-xinstallperl2
-rw-r--r--lib/ExtUtils/MM_Unix.pm57
-rw-r--r--lib/ExtUtils/MM_VMS.pm2
-rw-r--r--lib/Pod/Checker.pm198
-rw-r--r--lib/Pod/InputObjects.pm2
-rw-r--r--lib/Pod/ParseUtils.pm53
-rw-r--r--lib/Pod/Parser.pm4
-rw-r--r--lib/Pod/Select.pm2
-rw-r--r--lib/Pod/Usage.pm2
-rw-r--r--mg.h2
-rw-r--r--objXSUB.h4
-rwxr-xr-xperlapi.c7
-rw-r--r--pod/perlfunc.pod79
-rw-r--r--pp_sys.c8
-rw-r--r--proto.h1
-rw-r--r--scope.c6
-rwxr-xr-xt/comp/use.t67
-rwxr-xr-xt/pod/poderrs.t4
-rw-r--r--t/pod/poderrs.xr62
-rw-r--r--toke.c31
-rw-r--r--universal.c57
-rw-r--r--vms/descrip_mms.template13
-rw-r--r--vms/sockadapt.h2
-rw-r--r--vms/subconfigure.com12
-rw-r--r--vms/vms.c25
-rw-r--r--vms/vmsish.h30
-rw-r--r--win32/config.vc3
34 files changed, 644 insertions, 239 deletions
diff --git a/Makefile.SH b/Makefile.SH
index 0817c99c2e..56c5d91f1c 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -534,7 +534,6 @@ extra.pods: miniperl
$(LNS) ../$$x "pod/perl"$$nx".pod" ; \
echo "pod/perl"$$nx".pod" >> extra.pods ; \
done
- -@test -f README.vms && $(LNS) ../README.vms pod/README_vms.pod && echo "pod/README_vms.pod" >> extra.pods
-@test -f vms/perlvms.pod && $(LNS) ../vms/perlvms.pod pod/perlvms.pod && echo "pod/perlvms.pod" >> extra.pods
install-strip:
@@ -558,9 +557,7 @@ install.man: all installman
# XXX Experimental. Hardwired values, but useful for testing.
# Eventually Configure could ask for some of these values.
install.html: all installhtml
- -@test -f pod/README_vms.pod && rm -f pod/README_vms.pod
-@test -f README.vms && $(LNS) ../README.vms vms/README_vms.pod
- -@test -f pod/perlvms.pod && rm -f pod/perlvms.pod
$(LDLIBPTH) ./perl installhtml \
--podroot=. --podpath=. --recurse \
--htmldir=$(privlib)/html \
diff --git a/README.vms b/README.vms
index e58e6ddfd7..f6d970f05d 100644
--- a/README.vms
+++ b/README.vms
@@ -327,70 +327,73 @@ rebuild attempt. They might not, too, so it is best to be sure and do it.
There are several steps you need to take to get Perl installed and
running.
-1) Create a directory somewhere and define the concealed logical PERL_ROOT
-to point to it. For example,
+=over 4
- CREATE/DIRECTORY dka200:[perl]
- DEFINE/TRANS=(CONC,TERM) PERL_ROOT dka200:[perl.]
+=item 1
-2) Run the install script via:
+Check your default file protections with
- MMS install
+ SHOW PROTECTION /DEFAULT
-or
+and adjust if necessary with SET PROTECTION=(code)/DEFAULT.
- MMK install
+=item 2
-If for some reason it complains about target INSTALL being up to date,
-throw a /FORCE switch on the MMS or MMK command.
+Create a directory somewhere and either run @perl_setup or
+define the concealed logical PERL_ROOT to point to it by hand.
+For example,
-The DCL script [.VMS]PERL_SETUP.COM that is written by CONFIGURE.COM
-will take care of most of the following:
+ CREATE/DIRECTORY dka200:[perl]
+ @PERL_SETUP
+ SHOW LOGICAL PERL_ROOT
-3) Either create the global foreign symbol PERL somewhere, such as
-SYS$MANAGER:SYLOGIN.COM, to be
+or,
- $ PERL :== "$PERL_ROOT:[000000]PERL.EXE"
+ CREATE/DIRECTORY dka200:[perl]
+ DEFINE/TRANS=(CONC,TERM) PERL_ROOT dka200:[perl.]
-or install Perl into DCLTABLES.EXE (Check out the section "Installing Perl
-into DCLTABLES (optional)" for more information), or put the image in a
-directory that's in your DCL$PATH (if you're using VMS V6.2 or higher).
-4) Either define the logical name PERLSHR somewhere
-(such as in PERL_SETUP.COM) like so
+=item 3
- $ DEFINE/NOLOG PERLSHR PERL_ROOT:[000000]PERLSHR.EXE
+Run the install script via:
-or copy the file into the system shareable library directory with
+ MMS install
- copy perl_root:[000000]perlshr.exe sys$share:
+or
-5) Optionally define the command PERLDOC as
+ MMK install
- $ PERLDOC == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB.POD]PERLDOC.COM -t"
+If for some reason it complains about target INSTALL being up to date,
+throw a /FORCE switch on the MMS or MMK command.
-(See above for where to find the B<most> pager for use with perldoc).
+=back
+
+The DCL script PERL_SETUP.COM that is written by CONFIGURE.COM
+will help you with the definition of PERL_ROOT, PERLSHR and the PERL
+Foreign symbol. Take a look at PERL_SETUP.COM and modify it if you want
+to. Then copy PERL_SETUP.COM to a place accessible to your perl users.
+For example:
-6) Optionally define the command PERLBUG (the Perl bug report generator) as
+ COPY PERL_SETUP.COM SYS$LIBRARY:
- $ PERLBUG == "$PERL_ROOT:[000000]PERL PERL_ROOT:[LIB]PERLBUG.COM"
+If you want to have everyone on the system have access to perl
+then add a line that reads
-7) Optionally define the command POD2MAN (Converts POD files to nroff
-source suitable for converting to man pages. Also quiets complaints during
-module builds) as
+ $ @sys$library:perl_setup
- $ DEFINE/NOLOG POD2MAN PERL_ROOT:[LIB.POD]POD2MAN.COM
- $ POD2MAN == "$PERL_ROOT:[000000]PERL POD2MAN"
+to SYS$MANAGER:SYLOGIN.COM.
-8) Optionally define the command POD2TEXT (Converts POD files to text,
-which is required for B<perldoc -f> to work properly) as
+Two alternatives to the foreign symbol would be to install PERL into
+DCLTABLES.EXE (Check out the section "Installing Perl into DCLTABLES
+(optional)" for more information), or put the image in a
+directory that's in your DCL$PATH (if you're using VMS V6.2 or higher).
- $ DEFINE/NOLOG POD2TEXT PERL_ROOT:[LIB.POD]POD2TEXT.COM
- $ POD2TEXT == "$PERL_ROOT:[000000]PERL POD2TEXT"
+An alternative to having PERL_SETUP.COM define the PERLSHR logical name
+is to simply copy it into the system shareable library directory with:
+
+ copy perl_root:[000000]perlshr.exe sys$share:
-In all these cases, if you've got PERL defined as a foreign command symbol,
-you can replace $PERL_ROOT:[000000]PERL with ''perl'. If you have installed
-perl into DCLTABLES, replace it with just perl.
+See also the "INSTALLing images (optional)" section.
=head2 Installing Perl into DCLTABLES (optional)
@@ -567,7 +570,7 @@ of extending vmsperl with CPAN modules after Perl has been installed.
=head1 AUTHORS
-Last revised 13-February-2000 by Peter Prymmer pvhp@best.com.
+Last revised 25-February-2000 by Peter Prymmer pvhp@best.com.
Revised 27-October-1999 by Craig Berry craig.berry@metamorgs.com.
Revised 01-March-1999 by Dan Sugalski dan@sidhe.org.
Originally by Charles Bailey bailey@newman.upenn.edu.
@@ -601,6 +604,8 @@ missed someone. That said, special thanks are due to the following:
the Stanford Synchrotron Radiation Laboratory and the
Laboratory of Nuclear Studies at Cornell University for
the opportunity to test and develop for the AXP,
+ John Hasstedt John.Hasstedt@sunysb.edu
+ for VAX VMS V7.2 support
and to the entire VMSperl group for useful advice and suggestions. In
addition the perl5-porters deserve credit for their creativity and
diff --git a/av.c b/av.c
index adc65496a1..c7ccfae080 100644
--- a/av.c
+++ b/av.c
@@ -393,7 +393,7 @@ Perl_av_clear(pTHX_ register AV *av)
SV** ary;
#ifdef DEBUGGING
- if (SvREFCNT(av) <= 0 && ckWARN_d(WARN_DEBUGGING)) {
+ if (SvREFCNT(av) == 0 && ckWARN_d(WARN_DEBUGGING)) {
Perl_warner(aTHX_ WARN_DEBUGGING, "Attempt to clear deleted array");
}
#endif
diff --git a/configure.com b/configure.com
index 813127ca4d..ccb66bd262 100644
--- a/configure.com
+++ b/configure.com
@@ -4,12 +4,12 @@ $!
$! For example, if you unpacked perl into: [USER.PERL5_00n...] then you will
$! want to cd into the tree and execute Configure:
$!
-$! $ SET DEFAULT [USER.PERL5_00n]
+$! $ SET DEFAULT [USER.PERL5_xxx]
$! $ @Configure
$!
$! or
$!
-$! $ SET DEFAULT [USER.PERL5_00n]
+$! $ SET DEFAULT [USER.PERL5_xxx]
$! $ @Configure "-des"
$!
$! That's it. If you get into a bind trying to build perl on VMS then
@@ -19,7 +19,7 @@ $!
$! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
$!
$! send suggestions to:
-$! Dan Sugalski <sugalskd@ous.edu>
+$! Dan Sugalski <dan@sidhe.org>
$! Thank you!!!!
$!
$! Adapted and converted from Larry Wall & Andy Dougherty's
@@ -39,7 +39,7 @@ $ cat = "type"
$ gcc_symbol = "gcc"
$ ans = ""
$ macros = ""
-$ use_vmsdebug_perl = "N"
+$ use_vmsdebug_perl = "n"
$ use_debugging_perl = "Y"
$ use_64bitint = "n"
$ C_Compiler_Replace = "CC="
@@ -167,8 +167,8 @@ $ P'i' = P'i' - "f"
$ config_sh = P'i'
$ IF (F$SEARCH(config_sh).NES."")
$ THEN
-$ test = F$FILE_ATTRIBUTES(config_sh,"PRO")
-$ IF (F$LOCATE("R",test).NE.F$LENGTH(test))
+$ test_config_sh = F$FILE_ATTRIBUTES(config_sh,"PRO")
+$ IF (F$LOCATE("R",test_config_sh).NE.F$LENGTH(test_config_sh))
$ THEN
$ CONTINUE !at this point check UIC && if test allows...
$ !to be continued ?
@@ -395,7 +395,7 @@ $ ELSE
$! MANIFEST. has been found and we have set def'ed there -
$! time to bail out before it's too late.
$ tmp = f$extract(1,3,f$edit(f$getsyi("VERSION"),"TRIM,COLLAPSE"))
-$ IF tmp .GES. "7.2" THEN GOTO Beyond_depth_check
+$ IF (tmp .GES. "7.2") .AND. (F$GETSYI("HW_MODEL") .GE. 1024) THEN GOTO Beyond_depth_check
$ IF (F$ELEMENT(max_allowed_dir_depth,".",F$ENVIRONMENT("Default")).nes.".")
$ THEN
$ TYPE SYS$INPUT:
@@ -590,7 +590,7 @@ $ user = F$EDIT(F$GETJPI("","USERNAME"),"TRIM,COLLAPSE")
$ IF .NOT.(F$SEARCH("[-.CONFIG]INSTRUCT.").EQS."")
$ THEN
$ messages = F$ENVIRONMENT("MESSAGE")
-$ SET MESSAGE/NOFAC/NOSEV/NOIDENT/NOTEXT !sorry :-(
+$ SET MESSAGE/NOFAC/NOSEV/NOIDENT/NOTEXT
$ contains /NOOUTPUT [-.CONFIG]INSTRUCT. 'user'
$ IF .NOT.($status.EQ.%X08D78053)
$ THEN
@@ -600,7 +600,7 @@ $ rp = "Would you like to see the instructions? [''dflt'] "
$ GOSUB myread
$ if .NOT.ans THEN needman=""
$ ENDIF
-$ SET MESSAGE 'messages' !hope you made it here :-)
+$ SET MESSAGE 'messages'
$ ENDIF
$ if (fastread.AND.silent.AND.(alldone.eqs."cont")) THEN needman=""
$!
@@ -618,9 +618,9 @@ brackets; typing carriage return will give you the default.
$ READ SYS$COMMAND/PROMPT="Type carriage return to continue " ans
$ TYPE SYS$INPUT:
-In a hurry? You may run '@Configure -d'. This will bypass nearly all
+In a hurry? You may run '@Configure "-d"'. This will bypass nearly all
the questions and use the computed defaults (or the previous answers provided
-there was already a config.sh file). Type '@Configure -h' for a list of
+there was already a config.sh file). Type '@Configure "-h"' for a list of
options.
$ READ SYS$COMMAND/PROMPT="Type carriage return to continue " ans
@@ -1925,9 +1925,9 @@ $Build_probe:
$ build = F$ELEMENT(n,"/",builders)
$ probe = F$ELEMENT(n,"!",probers)
$ echo "Testing whether you have ''build' on your system..."
-$ SET NOON !sorry :-(
-$ ON CONTROL_Y THEN GOTO Reenable_messages_build !sorry :-(
-$ SET MESSAGE/NOFAC/NOSEV/NOIDENT/NOTEXT !sorry :-(
+$ SET NOON
+$ ON CONTROL_Y THEN GOTO Reenable_messages_build
+$ SET MESSAGE/NOFAC/NOSEV/NOIDENT/NOTEXT
$ 'build' 'probe'
$ IF ($SEVERITY .EQ. 1)
$ THEN
@@ -1942,9 +1942,9 @@ $ IF (.NOT. default_set) THEN dflt = build
$ ELSE
$ echo "Nope."
$ ENDIF
-$Reenable_messages_build: !hope you made it here :-)
-$ SET MESSAGE 'messages' !hope you made it here :-)
-$ SET ON !hope you made it here :-)
+$Reenable_messages_build:
+$ SET MESSAGE 'messages'
+$ SET ON
$ n = n + 1
$ IF (n .LT. max_build) THEN GOTO Build_probe
$!
@@ -2084,7 +2084,7 @@ $ ENDIF
$ EXIT
$ ENDSUBROUTINE ! Bad_environment
$ echo ""
-$ echo4 "%Config-I-VMS, Checking for dangerous pre extant global symbols and logical names."
+$ echo4 "%Config-I-VMS, Checking for dangerous pre-existing global symbols and logical names."
$ CALL Bad_environment "TMP"
$ CALL Bad_environment "LIB"
$ CALL Bad_environment "T"
@@ -2097,7 +2097,7 @@ $! %Config-I-VMS, write perl_setup.com here
$!
$ echo ""
$ echo4 "%Config-I-VMS, The perl_setup.com file is now being written..."
-$ file_2_find = "[-.vms]perl_setup.com"
+$ file_2_find = "[-]perl_setup.com"
$ OPEN/WRITE CONFIG 'file_2_find'
$ WRITE CONFIG "$!"
$ WRITE CONFIG "$! Perl_Setup.com ''cf_time'"
@@ -2126,6 +2126,9 @@ $ else
$ WRITE CONFIG "$ perl :== $Perl_Root:[000000]Perl'ext'"
$ WRITE CONFIG "$ define PerlShr Perl_Root:[000000]PerlShr'ext'"
$ endif
+$ WRITE CONFIG "$ define/nolog pod2text Perl_Root:[lib.pod]pod2text.com"
+$ WRITE CONFIG "$ define/nolog pod2html Perl_Root:[lib.pod]pod2html.com"
+$ WRITE CONFIG "$ define/nolog pod2man Perl_Root:[lib.pod]pod2man.com"
$!
$ IF (tzneedset)
$ THEN
@@ -2136,7 +2139,14 @@ $ ENDIF
$ WRITE CONFIG "$!"
$ WRITE CONFIG "$! Symbols for commonly used scripts:"
$ WRITE CONFIG "$!"
-$ WRITE CONFIG "$ Perldoc == ""'"+"'Perl' Perl_Root:[lib.pod]Perldoc.com -t"""
+$ WRITE CONFIG "$ Perldoc == ""'"+"'Perl' Perl_Root:[lib.pod]Perldoc.com -t"""
+$ WRITE CONFIG "$ pod2text == ""'"+"'Perl' pod2text"""
+$ WRITE CONFIG "$ pod2html == ""'"+"'Perl' pod2html"""
+$ WRITE CONFIG "$!pod2man == ""'"+"'Perl' pod2man"""
+$ WRITE CONFIG "$!Perlbug == ""'"+"'Perl' Perl_Root:[lib]Perlbug.com"""
+$ WRITE CONFIG "$!c2ph == ""'"+"'Perl' c2ph"""
+$ WRITE CONFIG "$!h2ph == ""'"+"'Perl' h2ph"""
+$ WRITE CONFIG "$!h2xs == ""'"+"'Perl' h2xs"""
$ CLOSE CONFIG
$!
$ echo ""
diff --git a/embed.h b/embed.h
index d0e0946d8f..f03f499630 100644
--- a/embed.h
+++ b/embed.h
@@ -686,6 +686,7 @@
#define sv_usepvn Perl_sv_usepvn
#define sv_vcatpvfn Perl_sv_vcatpvfn
#define sv_vsetpvfn Perl_sv_vsetpvfn
+#define str_to_version Perl_str_to_version
#define swash_init Perl_swash_init
#define swash_fetch Perl_swash_fetch
#define taint_env Perl_taint_env
@@ -2113,6 +2114,7 @@
#define sv_usepvn(a,b,c) Perl_sv_usepvn(aTHX_ a,b,c)
#define sv_vcatpvfn(a,b,c,d,e,f,g) Perl_sv_vcatpvfn(aTHX_ a,b,c,d,e,f,g)
#define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g)
+#define str_to_version(a) Perl_str_to_version(aTHX_ a)
#define swash_init(a,b,c,d,e) Perl_swash_init(aTHX_ a,b,c,d,e)
#define swash_fetch(a,b) Perl_swash_fetch(aTHX_ a,b)
#define taint_env() Perl_taint_env(aTHX)
@@ -4145,6 +4147,8 @@
#define sv_vcatpvfn Perl_sv_vcatpvfn
#define Perl_sv_vsetpvfn CPerlObj::Perl_sv_vsetpvfn
#define sv_vsetpvfn Perl_sv_vsetpvfn
+#define Perl_str_to_version CPerlObj::Perl_str_to_version
+#define str_to_version Perl_str_to_version
#define Perl_swash_init CPerlObj::Perl_swash_init
#define swash_init Perl_swash_init
#define Perl_swash_fetch CPerlObj::Perl_swash_fetch
diff --git a/embed.pl b/embed.pl
index a3f9ef3495..d4fe1f2d65 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2004,6 +2004,7 @@ Apd |void |sv_vcatpvfn |SV* sv|const char* pat|STRLEN patlen \
Apd |void |sv_vsetpvfn |SV* sv|const char* pat|STRLEN patlen \
|va_list* args|SV** svargs|I32 svmax \
|bool *maybe_tainted
+Ap |NV |str_to_version |SV *sv
Ap |SV* |swash_init |char* pkg|char* name|SV* listsv \
|I32 minbits|I32 none
Ap |UV |swash_fetch |SV *sv|U8 *ptr
diff --git a/global.sym b/global.sym
index fee76148b9..b38fc6f519 100644
--- a/global.sym
+++ b/global.sym
@@ -431,6 +431,7 @@ Perl_sv_upgrade
Perl_sv_usepvn
Perl_sv_vcatpvfn
Perl_sv_vsetpvfn
+Perl_str_to_version
Perl_swash_init
Perl_swash_fetch
Perl_taint_env
diff --git a/installperl b/installperl
index 920f0367b5..387f4b3560 100755
--- a/installperl
+++ b/installperl
@@ -240,7 +240,7 @@ my @corefiles;
if ($Is_VMS) { # We did core file selection during build
my $coredir = "lib/$Config{'arch'}/$ver";
$coredir =~ tr/./_/;
- @corefiles = <$coredir/*.*>;
+ @corefiles = map { s|^$coredir/||i; } <$coredir/*.*>;
}
else {
# [als] hard-coded 'libperl' name... not good!
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index 428a3f7c67..5b4178b99a 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -2883,16 +2883,53 @@ $(PERL_ARCHLIB)/Config.pm: $(PERL_SRC)/config.sh
push @m, q{
PERL_HDRS = \
-$(PERL_INC)/EXTERN.h $(PERL_INC)/gv.h $(PERL_INC)/pp.h \
-$(PERL_INC)/INTERN.h $(PERL_INC)/handy.h $(PERL_INC)/proto.h \
-$(PERL_INC)/XSUB.h $(PERL_INC)/hv.h $(PERL_INC)/regcomp.h \
-$(PERL_INC)/av.h $(PERL_INC)/keywords.h $(PERL_INC)/regexp.h \
-$(PERL_INC)/config.h $(PERL_INC)/mg.h $(PERL_INC)/scope.h \
-$(PERL_INC)/cop.h $(PERL_INC)/op.h $(PERL_INC)/sv.h \
-$(PERL_INC)/cv.h $(PERL_INC)/opcode.h $(PERL_INC)/unixish.h \
-$(PERL_INC)/dosish.h $(PERL_INC)/patchlevel.h $(PERL_INC)/util.h \
-$(PERL_INC)/embed.h $(PERL_INC)/perl.h $(PERL_INC)/iperlsys.h \
-$(PERL_INC)/form.h $(PERL_INC)/perly.h
+ $(PERL_INC)/EXTERN.h \
+ $(PERL_INC)/INTERN.h \
+ $(PERL_INC)/XSUB.h \
+ $(PERL_INC)/av.h \
+ $(PERL_INC)/cc_runtime.h \
+ $(PERL_INC)/config.h \
+ $(PERL_INC)/cop.h \
+ $(PERL_INC)/cv.h \
+ $(PERL_INC)/dosish.h \
+ $(PERL_INC)/embed.h \
+ $(PERL_INC)/embedvar.h \
+ $(PERL_INC)/fakethr.h \
+ $(PERL_INC)/form.h \
+ $(PERL_INC)/gv.h \
+ $(PERL_INC)/handy.h \
+ $(PERL_INC)/hv.h \
+ $(PERL_INC)/intrpvar.h \
+ $(PERL_INC)/iperlsys.h \
+ $(PERL_INC)/keywords.h \
+ $(PERL_INC)/mg.h \
+ $(PERL_INC)/nostdio.h \
+ $(PERL_INC)/objXSUB.h \
+ $(PERL_INC)/op.h \
+ $(PERL_INC)/opcode.h \
+ $(PERL_INC)/opnames.h \
+ $(PERL_INC)/patchlevel.h \
+ $(PERL_INC)/perl.h \
+ $(PERL_INC)/perlapi.h \
+ $(PERL_INC)/perlio.h \
+ $(PERL_INC)/perlsdio.h \
+ $(PERL_INC)/perlsfio.h \
+ $(PERL_INC)/perlvars.h \
+ $(PERL_INC)/perly.h \
+ $(PERL_INC)/pp.h \
+ $(PERL_INC)/pp_proto.h \
+ $(PERL_INC)/proto.h \
+ $(PERL_INC)/regcomp.h \
+ $(PERL_INC)/regexp.h \
+ $(PERL_INC)/regnodes.h \
+ $(PERL_INC)/scope.h \
+ $(PERL_INC)/sv.h \
+ $(PERL_INC)/thrdvar.h \
+ $(PERL_INC)/thread.h \
+ $(PERL_INC)/unixish.h \
+ $(PERL_INC)/utf8.h \
+ $(PERL_INC)/util.h \
+ $(PERL_INC)/warnings.h
$(OBJECT) : $(PERL_HDRS)
} if $self->{OBJECT};
diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm
index 5eccf78b8e..44fa7e2496 100644
--- a/lib/ExtUtils/MM_VMS.pm
+++ b/lib/ExtUtils/MM_VMS.pm
@@ -717,7 +717,7 @@ sub cflags {
$self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
if ($self->{OPTIMIZE} !~ m!/!) {
- if ($self->{OPTIMIZE} =~ m!\b-g\b!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
+ if ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
$self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
}
diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm
index b5f980bba7..281bd11be7 100644
--- a/lib/Pod/Checker.pm
+++ b/lib/Pod/Checker.pm
@@ -10,7 +10,7 @@
package Pod::Checker;
use vars qw($VERSION);
-$VERSION = 1.097; ## Current version of this package
+$VERSION = 1.098; ## Current version of this package
require 5.004; ## requires this Perl version or later
use Pod::ParseUtils; ## for hyperlinks and lists
@@ -26,6 +26,7 @@ Pod::Checker, podchecker() - check pod documents for syntax errors
$syntax_okay = podchecker($filepath, $outputpath, %options);
my $checker = new Pod::Checker %options;
+ $checker->parse_from_file($filepath, \*STDERR);
=head1 OPTIONS/ARGUMENTS
@@ -57,13 +58,13 @@ It is hoped that curious/ambitious user will help flesh out and add the
additional features they wish to see in B<Pod::Checker> and B<podchecker>
and verify that the checks are consistent with L<perlpod>.
-The following checks are preformed:
+The following checks are currently preformed:
=over 4
=item *
-Unknown '=xxxx' commands, unknown 'X<...>' interior-sequences,
+Unknown '=xxxx' commands, unknown 'XE<lt>...E<gt>' interior-sequences,
and unterminated interior sequences.
=item *
@@ -97,14 +98,6 @@ to something else.
=back
-=head2 Additional Features
-
-While checking, this module collects document properties, e.g. the nodes
-for hyperlinks (C<=headX>, C<=item>). POD translators can use this feature
-to syntax-check and get the nodes in a first pass before actually starting
-to convert. This is expensive in terms of execution time, but allows for
-very robust conversions.
-
=head1 DIAGNOSTICS
=head2 Errors
@@ -188,6 +181,10 @@ syntax described in L<perlpod>.
The C<ZE<lt>E<gt>> sequence is supposed to be empty.
+=item * empty XE<lt>E<gt>
+
+The index entry specified contains nothing but whitespace.
+
=item * Spurious text after =pod / =cut
The commands C<=pod> and C<=cut> do not take any arguments.
@@ -293,13 +290,13 @@ there were no POD commands at all found in the file.
I<[T.B.D.]>
-=head1 AUTHOR
+=head1 INTERFACE
-Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
-Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
-
-Based on code for B<Pod::Text::pod2text()> written by
-Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+While checking, this module collects document properties, e.g. the nodes
+for hyperlinks (C<=headX>, C<=item>) and index entries (C<XE<lt>E<gt>>).
+POD translators can use this feature to syntax-check and get the nodes in
+a first pass before actually starting to convert. This is expensive in terms
+of execution time, but allows for very robust conversions.
=cut
@@ -477,7 +474,7 @@ sub podchecker( $ ; $ % ) {
## Now check the pod document for errors
$checker->parse_from_file($infile, $outfile);
-
+
## Return the number of errors found
return $checker->num_errors();
}
@@ -509,11 +506,42 @@ sub initialize {
$self->{_have_begin} = ''; # stores =begin
$self->{_links} = []; # stack for internal hyperlinks
$self->{_nodes} = []; # stack for =head/=item nodes
+ $self->{_index} = []; # text in X<>
# print warnings?
$self->{-warnings} = 1 unless(defined $self->{-warnings});
$self->{_current_head1} = ''; # the current =head1 block
}
+##################################
+
+=over 4
+
+=item C<$checker-E<gt>poderror( @args )>
+
+=item C<$checker-E<gt>poderror( {%opts}, @args )>
+
+Internal method for printing errors and warnings. If no options are
+given, simply prints "@_". The following options are recognized and used
+to form the output:
+
+ -msg
+
+A message to print prior to C<@args>.
+
+ -line
+
+The line number the error occurred in.
+
+ -file
+
+The file (name) the error occurred in.
+
+ -severity
+
+The error level, should be 'WARNING' or 'ERROR'.
+
+=cut
+
# Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args )
sub poderror {
my $self = shift;
@@ -537,18 +565,43 @@ sub poderror {
if($self->{-warnings} || !%opts || $opts{-severity} ne 'WARNING');
}
-# set/retrieve the number of errors found
+##################################
+
+=item C<$checker-E<gt>num_errors()>
+
+Set (if argument specified) and retrieve the number of errors found.
+
+=cut
+
sub num_errors {
return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS};
}
-# set and/or retrieve canonical name of POD
+##################################
+
+=item C<$checker-E<gt>name()>
+
+Set (if argument specified) and retrieve the canonical name of POD as
+found in the C<=head1 NAME> section.
+
+=cut
+
sub name {
return (@_ > 1 && $_[1]) ?
($_[0]->{-name} = $_[1]) : $_[0]->{-name};
}
-# set/return nodes of the current POD
+##################################
+
+=item C<$checker-E<gt>node()>
+
+Add (if argument specified) and retrieve the nodes (as defined by C<=headX>
+and C<=item>) of the current POD. The nodes are returned in the order of
+their occurence. They consist of plain text, each piece of whitespace is
+collapsed to a single blank.
+
+=cut
+
sub node {
my ($self,$text) = @_;
if(defined $text) {
@@ -557,12 +610,49 @@ sub node {
# add node, order important!
push(@{$self->{_nodes}}, $text);
# keep also a uniqueness counter
- $self->{_unique_nodes}->{$text}++;
+ $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
return $text;
}
@{$self->{_nodes}};
}
+##################################
+
+=item C<$checker-E<gt>idx()>
+
+Add (if argument specified) and retrieve the index entries (as defined by
+C<XE<lt>E<gt>>) of the current POD. They consist of plain text, each piece
+of whitespace is collapsed to a single blank.
+
+=cut
+
+# set/return index entries of current POD
+sub idx {
+ my ($self,$text) = @_;
+ if(defined $text) {
+ $text =~ s/\s+$//s; # strip trailing whitespace
+ $text =~ s/\s+/ /gs; # collapse whitespace
+ # add node, order important!
+ push(@{$self->{_index}}, $text);
+ # keep also a uniqueness counter
+ $self->{_unique_nodes}->{$text}++ if($text !~ /^\s*$/s);
+ return $text;
+ }
+ @{$self->{_index}};
+}
+
+##################################
+
+=item C<$checker-E<gt>hyperlink()>
+
+Add (if argument specified) and retrieve the hyperlinks (as defined by
+C<LE<lt>E<gt>>) of the current POD. They consist of an 2-item array: line
+number and C<Pod::Hyperlink> object.
+
+=back
+
+=cut
+
# set/return hyperlinks of the current POD
sub hyperlink {
my $self = shift;
@@ -605,14 +695,22 @@ sub end_pod {
}
}
foreach($self->hyperlink()) {
- my $line = '';
- s/^(\d+):// && ($line = $1);
- if($_ && !$nodes{$_}) {
- $self->poderror({ -line => $line, -file => $infile,
- -severity => 'ERROR',
- -msg => "unresolved internal link '$_'"});
+ my ($line,$link) = @$_;
+ # _TODO_ what if there is a link to the page itself by the name,
+ # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION">
+ if($link->node() && !$link->page() && $link->type() ne 'hyperlink') {
+ my $node = $self->_check_ptree($self->parse_text($link->node(),
+ $line), $line, $infile, 'L');
+ if($node && !$nodes{$node}) {
+ $self->poderror({ -line => $line || '', -file => $infile,
+ -severity => 'ERROR',
+ -msg => "unresolved internal link '$node'"});
+ }
}
}
+
+ # check the internal nodes for uniqueness. This pertains to
+ # =headX, =item and X<...>
foreach(grep($self->{_unique_nodes}->{$_} > 1,
keys %{$self->{_unique_nodes}})) {
$self->poderror({ -line => '-', -file => $infile,
@@ -758,6 +856,7 @@ sub command {
}
}
elsif($cmd =~ /^head(\d+)/) {
+ # check whether the previous =head section had some contents
if(defined $self->{_commands_in_head} &&
$self->{_commands_in_head} == 0 &&
defined $self->{_last_head} &&
@@ -996,15 +1095,8 @@ sub _check_ptree {
# check the link text
$text .= $self->_check_ptree($self->parse_text($link->text(),
$line), $line, $file, "$nestlist$cmd");
- my $node = '';
- # remember internal link
- # _TODO_ what if there is a link to the page itself by the name,
- # e.g. in Tk::Pod : L<Tk::Pod/"DESCRIPTION">
- if($link->node() && !$link->page() && $link->type() ne 'hyperlink') {
- $node = $self->_check_ptree($self->parse_text($link->node(),
- $line), $line, $file, "$nestlist$cmd");
- $self->hyperlink("$line:$node") if($node);
- }
+ # remember link
+ $self->hyperlink([$line,$link]);
}
elsif($cmd =~ /[BCFIS]/) {
# add the guts
@@ -1017,16 +1109,26 @@ sub _check_ptree {
-msg => "Nonempty Z<>"});
}
}
- else { # X<>
- # check, but add nothing to $text
- $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+ elsif($cmd eq 'X') {
+ my $idx = $self->_check_ptree($contents, $line, $file, "$nestlist$cmd");
+ if($idx =~ /^\s*$/s) {
+ $self->poderror({ -line => $line, -file => $file,
+ -severity => 'ERROR',
+ -msg => "Empty X<>"});
+ }
+ else {
+ # remember this node
+ $self->idx($idx);
+ }
+ }
+ else {
+ # not reached
+ die "internal error";
}
}
$text;
}
-# _TODO_ overloadable methods for BC..Z<...> expansion?
-
# process a block of verbatim text
sub verbatim {
## Nothing particular to check
@@ -1076,3 +1178,15 @@ sub _preproc_par
1;
+__END__
+
+=head1 AUTHOR
+
+Brad Appleton E<lt>bradapp@enteract.comE<gt> (initial version),
+Marek Rouchal E<lt>marek@saftsack.fs.uni-bayreuth.deE<gt>
+
+Based on code for B<Pod::Text::pod2text()> written by
+Tom Christiansen E<lt>tchrist@mox.perl.comE<gt>
+
+=cut
+
diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm
index 7544fb76c5..2f89cb91f1 100644
--- a/lib/Pod/InputObjects.pm
+++ b/lib/Pod/InputObjects.pm
@@ -11,7 +11,7 @@
package Pod::InputObjects;
use vars qw($VERSION);
-$VERSION = 1.10; ## Current version of this package
+$VERSION = 1.11; ## Current version of this package
require 5.004; ## requires this Perl version or later
#############################################################################
diff --git a/lib/Pod/ParseUtils.pm b/lib/Pod/ParseUtils.pm
index 2b3734fef9..00f516e99c 100644
--- a/lib/Pod/ParseUtils.pm
+++ b/lib/Pod/ParseUtils.pm
@@ -320,6 +320,16 @@ sub parse {
($alttext, $page, $node) = ($1, $2, $3);
$type = 'section';
}
+ # alttext and page
+ elsif(m!^(.+?)\s*[|]\s*($page_rx)$!o) {
+ ($alttext, $page) = ($1, $2);
+ $type = 'page';
+ }
+ # alttext and "section"
+ elsif(m!^(.+?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
+ ($alttext, $node) = ($1,$2);
+ $type = 'section';
+ }
# page and "section"
elsif(m!^($page_rx)\s*/\s*"(.+)"$!o) {
($page, $node) = ($1, $2);
@@ -350,16 +360,6 @@ sub parse {
($alttext, $page, $node) = ($1, $2, $3);
$type = 'item';
}
- # alttext and page
- elsif(m!^(.+?)\s*[|]\s*($page_rx)$!o) {
- ($alttext, $page) = ($1, $2);
- $type = 'page';
- }
- # alttext and "section"
- elsif(m!^(.+?)\s*[|]\s*(?:/\s*|)"(.+)"$!) {
- ($alttext, $node) = ($1,$2);
- $type = 'section';
- }
# alttext and item
elsif(m!^(.+?)\s*[|]\s*/(.+)$!) {
($alttext, $node) = ($1,$2);
@@ -777,9 +777,9 @@ sub nodes {
=item find_node($name)
-Look for a node named C<$name> in the object's node list. Returns the
-unique id of the node (i.e. the second element of the array stored in
-the node arry) or undef if not found.
+Look for a node or index entry named C<$name> in the object.
+Returns the unique id of the node (i.e. the second element of the array
+stored in the node arry) or undef if not found.
=back
@@ -787,7 +787,10 @@ the node arry) or undef if not found.
sub find_node {
my ($self,$node) = @_;
- foreach(@{$self->{-nodes}}) {
+ my @search;
+ push(@search, @{$self->{-nodes}}) if($self->{-nodes});
+ push(@search, @{$self->{-idx}}) if($self->{-idx});
+ foreach(@search) {
if($_->[0] eq $node) {
return $_->[1]; # id
}
@@ -795,6 +798,28 @@ sub find_node {
undef;
}
+=item idx()
+
+Add an index entry (or a list of them) to the document's index list. Note that
+the order is kept, i.e. start with the first node and end with the last.
+If no argument is given, the current list of index entries is returned in the
+same order the entries have been added.
+An index entry can be any scalar, but usually is a pair of string and
+unique id.
+
+=cut
+
+# The POD index entries
+sub idx {
+ my ($self,@idx) = @_;
+ if(@idx) {
+ push(@{$self->{-idx}}, @idx);
+ return @idx;
+ }
+ else {
+ return @{$self->{-idx}};
+ }
+}
=head1 AUTHOR
diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm
index 22b3e49c61..a00f0ee83b 100644
--- a/lib/Pod/Parser.pm
+++ b/lib/Pod/Parser.pm
@@ -10,7 +10,7 @@
package Pod::Parser;
use vars qw($VERSION);
-$VERSION = 1.10; ## Current version of this package
+$VERSION = 1.11; ## Current version of this package
require 5.004; ## requires this Perl version or later
#############################################################################
@@ -1062,7 +1062,7 @@ sub parse_from_filehandle {
next unless (($textline =~ /^(\s*)$/) && (length $paragraph));
## Issue a warning about any non-empty blank lines
- if ( length($1) > 1 ) {
+ if (length($1) > 1 and ! $self->{_CUTTING}) {
my $errorsub = $self->errorsub();
my $file = $self->input_file();
my $errmsg = "*** WARNING: line containing nothing but whitespace".
diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm
index 230dc8f03b..53e27e513a 100644
--- a/lib/Pod/Select.pm
+++ b/lib/Pod/Select.pm
@@ -10,7 +10,7 @@
package Pod::Select;
use vars qw($VERSION);
-$VERSION = 1.10; ## Current version of this package
+$VERSION = 1.11; ## Current version of this package
require 5.004; ## requires this Perl version or later
#############################################################################
diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm
index 84a936e396..b8abe7d41b 100644
--- a/lib/Pod/Usage.pm
+++ b/lib/Pod/Usage.pm
@@ -10,7 +10,7 @@
package Pod::Usage;
use vars qw($VERSION);
-$VERSION = 1.10; ## Current version of this package
+$VERSION = 1.11; ## Current version of this package
require 5.004; ## requires this Perl version or later
=head1 NAME
diff --git a/mg.h b/mg.h
index baedde5a6e..ad50f5a0ae 100644
--- a/mg.h
+++ b/mg.h
@@ -40,7 +40,7 @@ struct magic {
#define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR)
#define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR)
-#define MgPV(mg,lp) (((lp = (mg)->mg_len) == HEf_SVKEY) ? \
+#define MgPV(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \
SvPV((SV*)((mg)->mg_ptr),lp) : \
(mg)->mg_ptr)
diff --git a/objXSUB.h b/objXSUB.h
index 44dc1e9238..86200bc9a1 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1737,6 +1737,10 @@
#define Perl_sv_vsetpvfn pPerl->Perl_sv_vsetpvfn
#undef sv_vsetpvfn
#define sv_vsetpvfn Perl_sv_vsetpvfn
+#undef Perl_str_to_version
+#define Perl_str_to_version pPerl->Perl_str_to_version
+#undef str_to_version
+#define str_to_version Perl_str_to_version
#undef Perl_swash_init
#define Perl_swash_init pPerl->Perl_swash_init
#undef swash_init
diff --git a/perlapi.c b/perlapi.c
index add96c4013..e26f9f1a63 100755
--- a/perlapi.c
+++ b/perlapi.c
@@ -3140,6 +3140,13 @@ Perl_sv_vsetpvfn(pTHXo_ SV* sv, const char* pat, STRLEN patlen, va_list* args, S
((CPerlObj*)pPerl)->Perl_sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, maybe_tainted);
}
+#undef Perl_str_to_version
+NV
+Perl_str_to_version(pTHXo_ SV *sv)
+{
+ return ((CPerlObj*)pPerl)->Perl_str_to_version(sv);
+}
+
#undef Perl_swash_init
SV*
Perl_swash_init(pTHXo_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none)
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index f9b4a6bac3..525d26ef7a 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -442,44 +442,51 @@ L<perlipc/"Sockets: Client/Server Communication">.
=item binmode FILEHANDLE
Arranges for FILEHANDLE to be read or written in "binary" mode on
-systems whose run-time libraries force the programmer to guess
-between binary and text files. If FILEHANDLE is an expression, the
-value is taken as the name of the filehandle. binmode() should be
-called after the C<open> but before any I/O is done on the filehandle.
-The only way to reset binary mode on a filehandle is to reopen the
-file.
+systems where the run-time libraries distinguish between binary and
+text files. If FILEHANDLE is an expression, the value is taken as the
+name of the filehandle. binmode() should be called after open() but
+before any I/O is done on the filehandle. The only way to reset
+binary mode on a filehandle is to reopen the file.
+
+On many systems binmode() has no effect, and on some systems it is
+necessary when you're not working with a text file. For the sake of
+portability it is a good idea to always use it when appropriate, and
+to never use it when it isn't appropriate.
+
+In other words: Regardless of platform, use binmode() on binary
+files, and do not use binmode() on text files.
The operating system, device drivers, C libraries, and Perl run-time
-system all conspire to let the programmer conveniently treat a
-simple, one-byte C<\n> as the line terminator, irrespective of its
-external representation. On Unix and its brethren, the native file
-representation exactly matches the internal representation, making
-everyone's lives unbelievably simpler. Consequently, L<binmode>
-has no effect under Unix, Plan9, or Mac OS, all of which use C<\n>
-to end each line. (Unix and Plan9 think C<\n> means C<\cJ> and
-C<\r> means C<\cM>, whereas the Mac goes the other way--it uses
-C<\cM> for c<\n> and C<\cJ> to mean C<\r>. But that's ok, because
-it's only one byte, and the internal and external representations
-match.)
-
-In legacy systems like MS-DOS and its embellishments, your program
-sees a C<\n> as a simple C<\cJ> (just as in Unix), but oddly enough,
-that's not what's physically stored on disk. What's worse, these
-systems refuse to help you with this; it's up to you to remember
-what to do. And you mustn't go applying binmode() with wild abandon,
-either, because if your system does care about binmode(), then using
-it when you shouldn't is just as perilous as failing to use it when
-you should.
-
-That means that on any version of Microsoft WinXX that you might
-care to name (or not), binmode() causes C<\cM\cJ> sequences on disk
-to be converted to C<\n> when read into your program, and causes
-any C<\n> in your program to be converted back to C<\cM\cJ> on
-output to disk. This sad discrepancy leads to no end of
-problems in not just the readline operator, but also when using
-seek(), tell(), and read() calls. See L<perlport> for other painful
-details. See the C<$/> and C<$\> variables in L<perlvar> for how
-to manually set your input and output line-termination sequences.
+system all work together to let the programmer treat a single
+character (C<\n>) as the line terminator, irrespective of the external
+representation. On many operating systems, the native text file
+representation matches the internal representation, but on some
+platforms the external representation of C<\n> is made up of more than
+one character.
+
+Mac OS and all variants of Unix use a single character to end each line
+in the external representation of text (even though that single
+character is not necessarily the same across these platforms).
+Consequently binmode() has no effect on these operating systems. In
+other systems like VMS, MS-DOS and the various flavors of MS-Windows
+your program sees a C<\n> as a simple C<\cJ>, but what's stored in text
+files are the two characters C<\cM\cJ>. That means that, if you don't
+use binmode() on these systems, C<\cM\cJ> sequences on disk will be
+converted to C<\n> on input, and any C<\n> in your program will be
+converted back to C<\cM\cJ> on output. This is what you want for text
+files, but it can be disastrous for binary files.
+
+Another consequence of using binmode() (on some systems) is that
+special end-of-file markers will be seen as part of the data stream.
+For systems from the Microsoft family this means that if your binary
+data contains C<\cZ>, the I/O subsystem will ragard it as the end of
+the file, unless you use binmode().
+
+binmode() is not only important for readline() and print() operations,
+but also when using read(), seek(), sysread(), syswrite() and tell()
+(see L<perlport> for more details). See the C<$/> and C<$\> variables
+in L<perlvar> for how to manually set your input and output
+line-termination sequences.
=item bless REF,CLASSNAME
diff --git a/pp_sys.c b/pp_sys.c
index ffe6af9ff7..6fa9c10eac 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1076,7 +1076,7 @@ PP(pp_getc)
GV *gv;
MAGIC *mg;
- if (MAXARG <= 0)
+ if (MAXARG == 0)
gv = PL_stdingv;
else
gv = (GV*)POPs;
@@ -1686,7 +1686,7 @@ PP(pp_eof)
GV *gv;
MAGIC *mg;
- if (MAXARG <= 0) {
+ if (MAXARG == 0) {
if (PL_op->op_flags & OPf_SPECIAL) { /* eof() */
IO *io;
gv = PL_last_in_gv = PL_argvgv;
@@ -1730,7 +1730,7 @@ PP(pp_tell)
GV *gv;
MAGIC *mg;
- if (MAXARG <= 0)
+ if (MAXARG == 0)
gv = PL_last_in_gv;
else
gv = PL_last_in_gv = (GV*)POPs;
@@ -1965,7 +1965,7 @@ PP(pp_flock)
#ifdef FLOCK
argtype = POPi;
- if (MAXARG <= 0)
+ if (MAXARG == 0)
gv = PL_last_in_gv;
else
gv = (GV*)POPs;
diff --git a/proto.h b/proto.h
index c7b6aa4c66..3013bd7c68 100644
--- a/proto.h
+++ b/proto.h
@@ -768,6 +768,7 @@ PERL_CALLCONV bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt);
PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len);
PERL_CALLCONV void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
PERL_CALLCONV void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted);
+PERL_CALLCONV NV Perl_str_to_version(pTHX_ SV *sv);
PERL_CALLCONV SV* Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none);
PERL_CALLCONV UV Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr);
PERL_CALLCONV void Perl_taint_env(pTHX);
diff --git a/scope.c b/scope.c
index 740000a44d..3680a88e5f 100644
--- a/scope.c
+++ b/scope.c
@@ -316,7 +316,7 @@ Perl_save_ary(pTHX_ GV *gv)
av = GvAVn(gv);
if (SvMAGIC(oav)) {
SvMAGIC(av) = SvMAGIC(oav);
- SvFLAGS(av) |= SvMAGICAL(oav);
+ SvFLAGS((SV*)av) |= SvMAGICAL(oav);
SvMAGICAL_off(oav);
SvMAGIC(oav) = 0;
PL_localizing = 1;
@@ -341,7 +341,7 @@ Perl_save_hash(pTHX_ GV *gv)
hv = GvHVn(gv);
if (SvMAGIC(ohv)) {
SvMAGIC(hv) = SvMAGIC(ohv);
- SvFLAGS(hv) |= SvMAGICAL(ohv);
+ SvFLAGS((SV*)hv) |= SvMAGICAL(ohv);
SvMAGICAL_off(ohv);
SvMAGIC(ohv) = 0;
PL_localizing = 1;
@@ -715,7 +715,7 @@ Perl_leave_scope(pTHX_ I32 base)
if (GvAV(gv)) {
AV *goner = GvAV(gv);
SvMAGIC(av) = SvMAGIC(goner);
- SvFLAGS(av) |= SvMAGICAL(goner);
+ SvFLAGS((SV*)av) |= SvMAGICAL(goner);
SvMAGICAL_off(goner);
SvMAGIC(goner) = 0;
SvREFCNT_dec(goner);
diff --git a/t/comp/use.t b/t/comp/use.t
index dbbda5c038..c3cdb70709 100755
--- a/t/comp/use.t
+++ b/t/comp/use.t
@@ -5,7 +5,7 @@ BEGIN {
unshift @INC, '../lib';
}
-print "1..15\n";
+print "1..27\n";
my $i = 1;
eval "use 5.000"; # implicit semicolon
@@ -103,3 +103,68 @@ print "ok ",$i++,"\n";
print "not " if $INC[0] eq "freda";
print "ok ",$i++,"\n";
+
+{
+ local $lib::VERSION = 35.36;
+ eval "use lib v33.55";
+ print "not " if $@;
+ print "ok ",$i++,"\n";
+
+ eval "use lib v100.105";
+ unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) {
+ print "not ";
+ }
+ print "ok ",$i++,"\n";
+
+ eval "use lib 33.55";
+ print "not " if $@;
+ print "ok ",$i++,"\n";
+
+ eval "use lib 100.105";
+ unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) {
+ print "not ";
+ }
+ print "ok ",$i++,"\n";
+
+ local $lib::VERSION = '35.36';
+ eval "use lib v33.55";
+ print "not " if $@;
+ print "ok ",$i++,"\n";
+
+ eval "use lib v100.105";
+ unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) {
+ print "not ";
+ }
+ print "ok ",$i++,"\n";
+
+ eval "use lib 33.55";
+ print "not " if $@;
+ print "ok ",$i++,"\n";
+
+ eval "use lib 100.105";
+ unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) {
+ print "not ";
+ }
+ print "ok ",$i++,"\n";
+
+ local $lib::VERSION = v35.36;
+ eval "use lib v33.55";
+ print "not " if $@;
+ print "ok ",$i++,"\n";
+
+ eval "use lib v100.105";
+ unless ($@ =~ /lib version v100\.105 required--this is only version v35\.36/) {
+ print "not ";
+ }
+ print "ok ",$i++,"\n";
+
+ eval "use lib 33.55";
+ print "not " if $@;
+ print "ok ",$i++,"\n";
+
+ eval "use lib 100.105";
+ unless ($@ =~ /lib version 100\.105 required--this is only version 35\.036/) {
+ print "not ";
+ }
+ print "ok ",$i++,"\n";
+}
diff --git a/t/pod/poderrs.t b/t/pod/poderrs.t
index bec2a198b6..ec632c2538 100755
--- a/t/pod/poderrs.t
+++ b/t/pod/poderrs.t
@@ -10,6 +10,10 @@ my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash
my $passed = testpodchecker \%options, $0;
exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE};
+### Deliberately throw in some blank but non-empty lines
+
+### The above line should contain spaces
+
__END__
diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr
index 2848faa46a..3e9c42b874 100644
--- a/t/pod/poderrs.xr
+++ b/t/pod/poderrs.xr
@@ -1,33 +1,33 @@
-*** ERROR: Unknown command 'unknown1' at line 21 in file pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'Q' at line 25 in file pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'A' at line 26 in file pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'Y' at line 27 in file pod/poderrs.t
-*** ERROR: Unknown interior-sequence 'V' at line 27 in file pod/poderrs.t
-*** WARNING: unterminated B<...> at line 31 in file pod/poderrs.t
-*** WARNING: unterminated I<...> at line 30 in file pod/poderrs.t
-*** WARNING: unterminated C<...> at line 33 in file pod/poderrs.t
-*** WARNING: line containing nothing but whitespace in paragraph at line 41 in file pod/poderrs.t
-*** ERROR: =item without previous =over at line 48 in file pod/poderrs.t
-*** ERROR: =back without previous =over at line 52 in file pod/poderrs.t
-*** ERROR: =over on line 56 without closing =back (at head2) at line 60 in file pod/poderrs.t
-*** ERROR: =end without =begin at line 62 in file pod/poderrs.t
-*** ERROR: Nested =begin's (first at line 66:html) at line 68 in file pod/poderrs.t
-*** ERROR: =end without =begin at line 72 in file pod/poderrs.t
-*** ERROR: nested commands C<...C<...>...> at line 76 in file pod/poderrs.t
-*** ERROR: garbled entity E<alea iacta est> at line 80 in file pod/poderrs.t
-*** ERROR: garbled entity E<C<auml>> at line 81 in file pod/poderrs.t
-*** ERROR: garbled entity E<abcI<bla>> at line 82 in file pod/poderrs.t
-*** WARNING: collapsing newlines to blanks at line 92 in file pod/poderrs.t
-*** ERROR: malformed link L<> : empty link at line 94 in file pod/poderrs.t
-*** WARNING: ignoring leading whitespace in link at line 100 in file pod/poderrs.t
-*** WARNING: ignoring trailing whitespace in link at line 100 in file pod/poderrs.t
-*** ERROR: Spurious character(s) after =back at line 106 in file pod/poderrs.t
-*** WARNING: No items in =over (at line 114) / =back list at line 116 in file pod/poderrs.t
-*** WARNING: 2 unescaped <> in paragraph at line 118 in file pod/poderrs.t
-*** ERROR: unresolved internal link 'begin or begin' at line 86 in file pod/poderrs.t
-*** ERROR: unresolved internal link 'end with begin' at line 87 in file pod/poderrs.t
-*** ERROR: unresolved internal link 'OoPs' at line 88 in file pod/poderrs.t
-*** ERROR: unresolved internal link 'abc def' at line 92 in file pod/poderrs.t
-*** ERROR: unresolved internal link 'passwd(5)' at line 99 in file pod/poderrs.t
+*** ERROR: Unknown command 'unknown1' at line 25 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'Q' at line 29 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'A' at line 30 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'Y' at line 31 in file pod/poderrs.t
+*** ERROR: Unknown interior-sequence 'V' at line 31 in file pod/poderrs.t
+*** WARNING: unterminated B<...> at line 35 in file pod/poderrs.t
+*** WARNING: unterminated I<...> at line 34 in file pod/poderrs.t
+*** WARNING: unterminated C<...> at line 37 in file pod/poderrs.t
+*** WARNING: line containing nothing but whitespace in paragraph at line 45 in file pod/poderrs.t
+*** ERROR: =item without previous =over at line 52 in file pod/poderrs.t
+*** ERROR: =back without previous =over at line 56 in file pod/poderrs.t
+*** ERROR: =over on line 60 without closing =back (at head2) at line 64 in file pod/poderrs.t
+*** ERROR: =end without =begin at line 66 in file pod/poderrs.t
+*** ERROR: Nested =begin's (first at line 70:html) at line 72 in file pod/poderrs.t
+*** ERROR: =end without =begin at line 76 in file pod/poderrs.t
+*** ERROR: nested commands C<...C<...>...> at line 80 in file pod/poderrs.t
+*** ERROR: garbled entity E<alea iacta est> at line 84 in file pod/poderrs.t
+*** ERROR: garbled entity E<C<auml>> at line 85 in file pod/poderrs.t
+*** ERROR: garbled entity E<abcI<bla>> at line 86 in file pod/poderrs.t
+*** WARNING: collapsing newlines to blanks at line 96 in file pod/poderrs.t
+*** ERROR: malformed link L<> : empty link at line 98 in file pod/poderrs.t
+*** WARNING: ignoring leading whitespace in link at line 104 in file pod/poderrs.t
+*** WARNING: ignoring trailing whitespace in link at line 104 in file pod/poderrs.t
+*** ERROR: Spurious character(s) after =back at line 110 in file pod/poderrs.t
+*** WARNING: No items in =over (at line 118) / =back list at line 120 in file pod/poderrs.t
+*** WARNING: 2 unescaped <> in paragraph at line 122 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'begin or begin' at line 90 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'end with begin' at line 91 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'OoPs' at line 92 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'abc def' at line 96 in file pod/poderrs.t
+*** ERROR: unresolved internal link 'passwd(5)' at line 103 in file pod/poderrs.t
*** WARNING: multiple occurence of link target 'oops' at line - in file pod/poderrs.t
pod/poderrs.t has 22 pod syntax errors.
diff --git a/toke.c b/toke.c
index 5347ecd0de..e18a4c8df8 100644
--- a/toke.c
+++ b/toke.c
@@ -812,6 +812,31 @@ S_force_ident(pTHX_ register char *s, int kind)
}
}
+NV
+Perl_str_to_version(pTHX_ SV *sv)
+{
+ NV retval = 0.0;
+ NV nshift = 1.0;
+ STRLEN len;
+ char *start = SvPVx(sv,len);
+ bool utf = SvUTF8(sv);
+ char *end = start + len;
+ while (start < end) {
+ I32 skip;
+ UV n;
+ if (utf)
+ n = utf8_to_uv((U8*)start, &skip);
+ else {
+ n = *(U8*)start;
+ skip = 1;
+ }
+ retval += ((NV)n)/nshift;
+ start += skip;
+ nshift *= 1000;
+ }
+ return retval;
+}
+
/*
* S_force_version
* Forces the next token to be a version number.
@@ -833,12 +858,12 @@ S_force_version(pTHX_ char *s)
if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
SV *ver;
s = scan_num(s);
- /* real VERSION number -- GBARR */
version = yylval.opval;
ver = cSVOPx(version)->op_sv;
if (SvPOK(ver) && !SvNIOK(ver)) {
- SvUPGRADE(ver, SVt_PVIV);
- SvIOKp_on(ver); /* hint that it is a version */
+ SvUPGRADE(ver, SVt_PVNV);
+ SvNVX(ver) = str_to_version(ver);
+ SvNOK_on(ver); /* hint that it is a version */
}
}
}
diff --git a/universal.c b/universal.c
index 6ccff2f003..0e5a89b2c0 100644
--- a/universal.c
+++ b/universal.c
@@ -197,11 +197,10 @@ XS(XS_UNIVERSAL_VERSION)
GV *gv;
SV *sv;
char *undef;
- NV req;
- if(SvROK(ST(0))) {
+ if (SvROK(ST(0))) {
sv = (SV*)SvRV(ST(0));
- if(!SvOBJECT(sv))
+ if (!SvOBJECT(sv))
Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
pkg = SvSTASH(sv);
}
@@ -222,12 +221,56 @@ XS(XS_UNIVERSAL_VERSION)
undef = "(undef)";
}
- if (items > 1 && (undef || (req = SvNV(ST(1)), req > SvNV(sv)))) {
- STRLEN n_a;
- Perl_croak(aTHX_ "%s version %s required--this is only version %s",
- HvNAME(pkg), SvPV(ST(1),n_a), undef ? undef : SvPV(sv,n_a));
+ if (items > 1) {
+ STRLEN len;
+ SV *req = ST(1);
+
+ if (undef)
+ Perl_croak(aTHX_ "%s does not define $%s::VERSION--version check failed",
+ HvNAME(pkg), HvNAME(pkg));
+
+ if (!SvNIOK(sv) && SvPOK(sv)) {
+ char *str = SvPVx(sv,len);
+ while (len) {
+ --len;
+ /* XXX could DWIM "1.2.3" here */
+ if (!isDIGIT(str[len]) && str[len] != '.' && str[len] != '_')
+ break;
+ }
+ if (len) {
+ if (SvNIOKp(req) && SvPOK(req)) {
+ /* they said C<use Foo v1.2.3> and $Foo::VERSION
+ * doesn't look like a float: do string compare */
+ if (sv_cmp(req,sv) == 1) {
+ Perl_croak(aTHX_ "%s version v%vd required--"
+ "this is only version v%vd",
+ HvNAME(pkg), req, sv);
+ }
+ goto finish;
+ }
+ /* they said C<use Foo 1.002_003> and $Foo::VERSION
+ * doesn't look like a float: force numeric compare */
+ SvUPGRADE(sv, SVt_PVNV);
+ SvNVX(sv) = str_to_version(sv);
+ SvPOK_off(sv);
+ SvNOK_on(sv);
+ }
+ }
+ /* if we get here, we're looking for a numeric comparison,
+ * so force the required version into a float, even if they
+ * said C<use Foo v1.2.3> */
+ if (SvNIOKp(req) && SvPOK(req)) {
+ NV n = SvNV(req);
+ req = sv_newmortal();
+ sv_setnv(req, n);
+ }
+
+ if (SvNV(req) > SvNV(sv))
+ Perl_croak(aTHX_ "%s version %s required--this is only version %s",
+ HvNAME(pkg), SvPV(req,len), SvPV(sv,len));
}
+finish:
ST(0) = sv;
XSRETURN(1);
diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template
index c07c6d98f6..9e426e925e 100644
--- a/vms/descrip_mms.template
+++ b/vms/descrip_mms.template
@@ -375,7 +375,7 @@ pod8 = [.lib.pod]perltoot.pod [.lib.pod]perltootc.pod [.lib.pod]perltrap.pod [.l
pod9 = [.lib.pod]perlfaq.pod [.lib.pod]perlfaq1.pod [.lib.pod]perlfaq2.pod [.lib.pod]perlfaq3.pod [.lib.pod]perlfaq4.pod [.lib.pod]perlfaq5.pod
pod10 = [.lib.pod]perlfaq6.pod [.lib.pod]perlfaq7.pod [.lib.pod]perlfaq8.pod [.lib.pod]perlfaq9.pod
-perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) [.lib.pod]perlvms.pod [.lib.pod]README_vms.pod
+perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) $(pod9) $(pod10) [.lib.pod]perlvms.pod
@ $(NOOP)
archcorefiles : $(ac) $(acth) $(ARCHAUTO)time.stamp
@@ -850,13 +850,10 @@ preplibrary : $(MINIPERL_EXE) $(LIBPREREQ) $(SOCKPM)
@ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
@ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
-[.lib.pod]README_vms.pod : README.vms
- @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
- @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
-
-[.lib.pod]perlwin32.pod : README.win32
- @ If F$Search("[.lib]pod.dir").eqs."" Then Create/Directory [.lib.pod]
- @ Copy/Log $(MMS$SOURCE) $(MMS$TARGET)
+install.html : []perl_setup.com installhtml. install $(perlpods)
+ @ @perl_setup
+ @ If F$Search("[.lib]html.dir").eqs."" Then Create/Directory [.lib.html]
+ $(MINIPERL) installhtml. "--podroot=/perl_root --recurse --htmldir=lib/html --htmlroot=lib/html --splithead=pod/perlipc --splititem=pod/perlfunc --libpods=perlfunc:perlguts:perlvar:perlrun:perlop --verbose"
printconfig :
@ @[.vms]make_command $(MMS) $(MMSQUALIFIERS) $(MMSTARGETS)
diff --git a/vms/sockadapt.h b/vms/sockadapt.h
index 0ff309ab9a..97a49f8917 100644
--- a/vms/sockadapt.h
+++ b/vms/sockadapt.h
@@ -35,7 +35,7 @@
void setservent(int);
void endservent(void);
#endif
-# if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000)
+# if defined(__DECC) && defined(__DECC_VER) && (__DECC_VER >= 50200000) && !defined(Sock_size_t)
# define Sock_size_t unsigned int
# endif
diff --git a/vms/subconfigure.com b/vms/subconfigure.com
index dae2bdaf07..dfa3482c88 100644
--- a/vms/subconfigure.com
+++ b/vms/subconfigure.com
@@ -141,6 +141,7 @@ $ perl_uselargefiles = "undef"
$ perl_uselongdouble = "undef"
$ perl_usemorebits = "undef"
$ ENDIF
+$ use_64bitall = use_64bitint ! until configure.com question is reworded?
$ IF use_64bitall .eqs. "Y"
$ THEN
$ perl_use64bitall = "define"
@@ -3349,7 +3350,12 @@ $ perl_d_gethostprotos="define"
$ perl_d_getnetprotos="define"
$ perl_d_getprotoprotos="define"
$ perl_d_getservprotos="define"
-$ perl_sock_size_type="int *"
+$ IF ("''Using_Dec_C'".EQS."Yes")
+$ THEN
+$ perl_socksizetype="unsigned int"
+$ ELSE
+$ perl_socksizetype="int *"
+$ ENDIF
$ ELSE
$ perl_d_vms_do_sockets="undef"
$ perl_d_htonl="undef"
@@ -3371,7 +3377,7 @@ $ perl_d_gethostprotos="undef"
$ perl_d_getnetprotos="undef"
$ perl_d_getprotoprotos="undef"
$ perl_d_getservprotos="undef"
-$ perl_sock_size_type="undef"
+$ perl_socksizetype="undef"
$ ENDIF
$! Threads
$ if ("''use_threads'".eqs."T")
@@ -3919,7 +3925,7 @@ $ WC "netdb_host_type='" + perl_netdb_host_type + "'"
$ WC "netdb_hlen_type='" + perl_netdb_hlen_type + "'"
$ WC "netdb_name_type='" + perl_netdb_name_type + "'"
$ WC "netdb_net_type='" + perl_netdb_net_type + "'"
-$ WC "sock_size_type='" + perl_sock_size_type + "'"
+$ WC "socksizetype='" + perl_socksizetype + "'"
$ WC "baserev='" + perl_baserev + "'"
$ WC "doublesize='" + perl_doublesize + "'"
$ WC "ptrsize='" + perl_ptrsize + "'"
diff --git a/vms/vms.c b/vms/vms.c
index aee410d18d..fac9243cc5 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -3971,6 +3971,27 @@ static long int utc_offset_secs;
# define RTL_USES_UTC 1
#endif
+/*
+ * DEC C previous to 6.0 corrupts the behavior of the /prefix
+ * qualifier with the extern prefix pragma. This provisional
+ * hack circumvents this prefix pragma problem in previous
+ * precompilers.
+ */
+#if defined(__VMS_VER) && __VMS_VER >= 70000000
+# if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 60000000)
+# pragma __extern_prefix save
+# pragma __extern_prefix "" /* set to empty to prevent prefixing */
+# define gmtime decc$__utctz_gmtime
+# define localtime decc$__utctz_localtime
+# define time decc$__utc_time
+# pragma __extern_prefix restore
+
+ struct tm *gmtime(), *localtime();
+
+# endif
+#endif
+
+
static time_t toutc_dst(time_t loc) {
struct tm *rsltmp;
@@ -3979,7 +4000,7 @@ static time_t toutc_dst(time_t loc) {
if (rsltmp->tm_isdst) loc -= 3600;
return loc;
}
-#define _toutc(secs) ((secs) == -1 ? -1 : \
+#define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
((gmtime_emulation_type || my_time(NULL)), \
(gmtime_emulation_type == 1 ? toutc_dst(secs) : \
((secs) - utc_offset_secs))))
@@ -3992,7 +4013,7 @@ static time_t toloc_dst(time_t utc) {
if (rsltmp->tm_isdst) utc += 3600;
return utc;
}
-#define _toloc(secs) ((secs) == -1 ? -1 : \
+#define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
((gmtime_emulation_type || my_time(NULL)), \
(gmtime_emulation_type == 1 ? toloc_dst(secs) : \
((secs) + utc_offset_secs))))
diff --git a/vms/vmsish.h b/vms/vmsish.h
index e9b47a0a9d..8d4a8caf6b 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -198,6 +198,16 @@
*/
#define ALTERNATE_SHEBANG "$"
+/* Lower case entry points for these are missing in some earlier RTLs
+ * so we borrow the defines and declares from errno.h and upcase them.
+ */
+#if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 50500000)
+# define errno (*CMA$TIS_ERRNO_GET_ADDR())
+# define vaxc$errno (*CMA$TIS_VMSERRNO_GET_ADDR())
+ int *CMA$TIS_ERRNO_GET_ADDR (void); /* UNIX style error code */
+ int *CMA$TIS_VMSERRNO_GET_ADDR (void); /* VMS error (errno == EVMSERR) */
+#endif
+
/* Macros to set errno using the VAX thread-safe calls, if present */
#if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA)
# define set_errno(v) (cma$tis_errno_set_value(v))
@@ -537,6 +547,25 @@ struct mystat
};
typedef unsigned mydev_t;
typedef unsigned myino_t;
+
+/*
+ * DEC C previous to 6.0 corrupts the behavior of the /prefix
+ * qualifier with the extern prefix pragma. This provisional
+ * hack circumvents this prefix pragma problem in previous
+ * precompilers.
+ */
+#if defined(__VMS_VER) && __VMS_VER >= 70000000
+# if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 60000000)
+# pragma __extern_prefix save
+# pragma __extern_prefix "" /* set to empty to prevent prefixing */
+# define geteuid decc$__unix_geteuid
+# define getuid decc$__unix_getuid
+# define stat(__p1,__p2) decc$__utc_stat(__p1,__p2)
+# define fstat(__p1,__p2) decc$__utc_fstat(__p1,__p2)
+# pragma __extern_prefix restore
+# endif
+#endif
+
#ifndef DONT_MASK_RTL_CALLS /* defined for vms.c so we can see RTL calls */
# ifdef stat
# undef stat
@@ -556,6 +585,7 @@ typedef unsigned myino_t;
#define S_IDGRP (S_IWGRP | S_IXGRP)
#define S_IDOTH (S_IWOTH | S_IXOTH)
+
/* Prototypes for functions unique to vms.c. Don't include replacements
* for routines in the mainline source files excluded by #ifndef VMS;
* their prototypes are already in proto.h.
diff --git a/win32/config.vc b/win32/config.vc
index b98925bf66..ed981567fb 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -709,6 +709,7 @@ use5005threads='undef'
use64bitall='undef'
use64bitint='undef'
usedl='define'
+useithreads='undef'
uselargefiles='undef'
uselongdouble='undef'
usemorebits='undef'
@@ -744,8 +745,8 @@ xlibpth='/usr/lib/386 /lib/386'
zcat=''
zip='zip'
PERL_REVISION='~PERL_REVISION~'
-PERL_VERSION='~PERL_VERSION~'
PERL_SUBVERSION='~PERL_SUBVERSION~'
+PERL_VERSION='~PERL_VERSION~'
PERL_API_REVISION='~PERL_API_REVISION~'
PERL_API_SUBVERSION='~PERL_API_SUBVERSION~'
PERL_API_VERSION='~PERL_API_VERSION~'