add note about map in scalar context
[p5sagit/p5-mst-13.2.git] / vms / vms.c
index e80a5ac..8870a0f 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -119,12 +119,13 @@ my_trnlnm(char *lnm, char *eqv, unsigned long int idx)
  * caller; this pointer will be invalidated at next Perl statement
  * transition.
  */
-/*{{{ char *my_getenv(char *lnm)*/
+/*{{{ char *my_getenv(const char *lnm)*/
 char *
-my_getenv(char *lnm)
+my_getenv(const char *lnm)
 {
     static char __my_getenv_eqv[LNM$C_NAMLENGTH+1];
-    char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv;
+    char uplnm[LNM$C_NAMLENGTH+1], *cp2, *eqv;
+    const char *cp1;
     unsigned long int idx = 0;
     int trnsuccess;
     SV *tmpsv;
@@ -712,7 +713,7 @@ I32 my_pclose(FILE *fp)
       unsigned long int chan, iosb[2], retsts, retsts2;
       struct dsc$descriptor devdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, devnam};
 
-      if (fgetname(info->fp,devnam)) {
+      if (fgetname(info->fp,devnam,1)) {
         /* It oughta be a mailbox, so fgetname should give just the device
          * name, but just in case . . . */
         if ((cp = strrchr(devnam,':')) != NULL) *(cp+1) = '\0';
@@ -768,7 +769,7 @@ my_waitpid(Pid_t pid, int *statusp, int flags)
         _ckvmssts(lib$getjpi(&ownercode,&pid,0,&ownerpid,0,0));
         _ckvmssts(lib$getjpi(&ownercode,0,0,&mypid,0,0));
         if (ownerpid != mypid)
-          warn("pid %d not a child",pid);
+          warn("pid %x not a child",pid);
       }
 
       _ckvmssts(sys$bintim(&intdsc,interval));
@@ -981,7 +982,7 @@ char *rmsexpand_ts(char *spec, char *buf, char *def, unsigned opt)
 **   tounixspec() - convert any file spec into a Unix-style file spec.
 **   tovmsspec() - convert any file spec into a VMS-style spec.
 **
-** Copyright 1996 by Charles Bailey  <bailey@genetics.upenn.edu>
+** Copyright 1996 by Charles Bailey  <bailey@newman.upenn.edu>
 ** Permission is given to distribute this code as part of the Perl
 ** standard distribution under the terms of the GNU General Public
 ** License or the Perl Artistic License.  Copies of each may be
@@ -1815,7 +1816,7 @@ char *tounixpath_ts(char *path, char *buf) { return do_tounixpath(path,buf,1); }
  *  gain.                                                                    *
  *                                                                           *
  *  27-Aug-1994 Modified for inclusion in perl5                              *
- *              by Charles Bailey  bailey@genetics.upenn.edu                 *
+ *              by Charles Bailey  bailey@newman.upenn.edu                   *
  *****************************************************************************
  */
 
@@ -2564,7 +2565,7 @@ trim_unixpath(char *fspec, char *wildspec, int opts)
  *  VMS readdir() routines.
  *  Written by Rich $alz, <rsalz@bbn.com> in August, 1990.
  *
- *  21-Jul-1994  Charles Bailey  bailey@genetics.upenn.edu
+ *  21-Jul-1994  Charles Bailey  bailey@newman.upenn.edu
  *  Minor modifications to original routines.
  */
 
@@ -2848,6 +2849,7 @@ setup_argstr(SV *really, SV **mark, SV **sp)
   register size_t cmdlen = 0;
   size_t rlen;
   register SV **idx;
+  STRLEN n_a;
 
   idx = mark;
   if (really) {
@@ -2874,7 +2876,7 @@ setup_argstr(SV *really, SV **mark, SV **sp)
   while (++mark <= sp) {
     if (*mark) {
       strcat(PL_Cmd," ");
-      strcat(PL_Cmd,SvPVx(*mark,PL_na));
+      strcat(PL_Cmd,SvPVx(*mark,n_a));
     }
   }
   return PL_Cmd;
@@ -3527,7 +3529,7 @@ static time_t toloc_dst(time_t utc) {
  * UTC support, since they also handle C<use vmsish qw(times);>
  *
  * Contributed by Chuck Lane  <lane@duphy4.physics.drexel.edu>
- * Modified by Charles Bailey <bailey@genetics.upenn.edu>
+ * Modified by Charles Bailey <bailey@newman.upenn.edu>
  */
 
 /*{{{time_t my_time(time_t *timep)*/
@@ -4160,7 +4162,7 @@ my_binmode(FILE *fp, char iotype)
     int ret = 0, saverrno = errno, savevmserrno = vaxc$errno;
     fpos_t pos;
 
-    if (!fgetname(fp,filespec)) return NULL;
+    if (!fgetname(fp,filespec,1)) return NULL;
     for (s = filespec; *s; s++) {
       if (*s == ':') colon = s;
       else if (*s == ']' || *s == '>') dirend = s;
@@ -4223,7 +4225,7 @@ my_getlogin()
  *
  *  Returns 1 on success; returns 0 and sets errno and vaxc$errno on failure.
  *
- *  Copyright 1996 by Charles Bailey <bailey@genetics.upenn.edu>.
+ *  Copyright 1996 by Charles Bailey <bailey@newman.upenn.edu>.
  *  Incorporates, with permission, some code from EZCOPY by Tim Adye
  *  <T.J.Adye@rl.ac.uk>.  Permission is given to distribute this code
  * as part of the Perl standard distribution under the terms of the
@@ -4407,12 +4409,13 @@ rmsexpand_fromperl(CV *cv)
 {
   dXSARGS;
   char *fspec, *defspec = NULL, *rslt;
+  STRLEN n_a;
 
   if (!items || items > 2)
     croak("Usage: VMS::Filespec::rmsexpand(spec[,defspec])");
-  fspec = SvPV(ST(0),PL_na);
+  fspec = SvPV(ST(0),n_a);
   if (!fspec || !*fspec) XSRETURN_UNDEF;
-  if (items == 2) defspec = SvPV(ST(1),PL_na);
+  if (items == 2) defspec = SvPV(ST(1),n_a);
 
   rslt = do_rmsexpand(fspec,NULL,1,defspec,0);
   ST(0) = sv_newmortal();
@@ -4425,9 +4428,10 @@ vmsify_fromperl(CV *cv)
 {
   dXSARGS;
   char *vmsified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::vmsify(spec)");
-  vmsified = do_tovmsspec(SvPV(ST(0),PL_na),NULL,1);
+  vmsified = do_tovmsspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (vmsified != NULL) sv_usepvn(ST(0),vmsified,strlen(vmsified));
   XSRETURN(1);
@@ -4438,9 +4442,10 @@ unixify_fromperl(CV *cv)
 {
   dXSARGS;
   char *unixified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::unixify(spec)");
-  unixified = do_tounixspec(SvPV(ST(0),PL_na),NULL,1);
+  unixified = do_tounixspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (unixified != NULL) sv_usepvn(ST(0),unixified,strlen(unixified));
   XSRETURN(1);
@@ -4451,9 +4456,10 @@ fileify_fromperl(CV *cv)
 {
   dXSARGS;
   char *fileified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::fileify(spec)");
-  fileified = do_fileify_dirspec(SvPV(ST(0),PL_na),NULL,1);
+  fileified = do_fileify_dirspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (fileified != NULL) sv_usepvn(ST(0),fileified,strlen(fileified));
   XSRETURN(1);
@@ -4464,9 +4470,10 @@ pathify_fromperl(CV *cv)
 {
   dXSARGS;
   char *pathified;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::pathify(spec)");
-  pathified = do_pathify_dirspec(SvPV(ST(0),PL_na),NULL,1);
+  pathified = do_pathify_dirspec(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (pathified != NULL) sv_usepvn(ST(0),pathified,strlen(pathified));
   XSRETURN(1);
@@ -4477,9 +4484,10 @@ vmspath_fromperl(CV *cv)
 {
   dXSARGS;
   char *vmspath;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::vmspath(spec)");
-  vmspath = do_tovmspath(SvPV(ST(0),PL_na),NULL,1);
+  vmspath = do_tovmspath(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (vmspath != NULL) sv_usepvn(ST(0),vmspath,strlen(vmspath));
   XSRETURN(1);
@@ -4490,9 +4498,10 @@ unixpath_fromperl(CV *cv)
 {
   dXSARGS;
   char *unixpath;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::unixpath(spec)");
-  unixpath = do_tounixpath(SvPV(ST(0),PL_na),NULL,1);
+  unixpath = do_tounixpath(SvPV(ST(0),n_a),NULL,1);
   ST(0) = sv_newmortal();
   if (unixpath != NULL) sv_usepvn(ST(0),unixpath,strlen(unixpath));
   XSRETURN(1);
@@ -4505,12 +4514,13 @@ candelete_fromperl(CV *cv)
   char fspec[NAM$C_MAXRSS+1], *fsp;
   SV *mysv;
   IO *io;
+  STRLEN n_a;
 
   if (items != 1) croak("Usage: VMS::Filespec::candelete(spec)");
 
   mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
   if (SvTYPE(mysv) == SVt_PVGV) {
-    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec)) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),fspec,1)) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
@@ -4518,7 +4528,7 @@ candelete_fromperl(CV *cv)
     fsp = fspec;
   }
   else {
-    if (mysv != ST(0) || !(fsp = SvPV(mysv,PL_na)) || !*fsp) {
+    if (mysv != ST(0) || !(fsp = SvPV(mysv,n_a)) || !*fsp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
@@ -4540,13 +4550,14 @@ rmscopy_fromperl(CV *cv)
   unsigned long int sts;
   SV *mysv;
   IO *io;
+  STRLEN n_a;
 
   if (items < 2 || items > 3)
     croak("Usage: File::Copy::rmscopy(from,to[,date_flag])");
 
   mysv = SvROK(ST(0)) ? SvRV(ST(0)) : ST(0);
   if (SvTYPE(mysv) == SVt_PVGV) {
-    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec)) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),inspec,1)) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
@@ -4554,7 +4565,7 @@ rmscopy_fromperl(CV *cv)
     inp = inspec;
   }
   else {
-    if (mysv != ST(0) || !(inp = SvPV(mysv,PL_na)) || !*inp) {
+    if (mysv != ST(0) || !(inp = SvPV(mysv,n_a)) || !*inp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
@@ -4562,7 +4573,7 @@ rmscopy_fromperl(CV *cv)
   }
   mysv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
   if (SvTYPE(mysv) == SVt_PVGV) {
-    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec)) {
+    if (!(io = GvIOp(mysv)) || !fgetname(IoIFP(io),outspec,1)) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);
@@ -4570,7 +4581,7 @@ rmscopy_fromperl(CV *cv)
     outp = outspec;
   }
   else {
-    if (mysv != ST(1) || !(outp = SvPV(mysv,PL_na)) || !*outp) {
+    if (mysv != ST(1) || !(outp = SvPV(mysv,n_a)) || !*outp) {
       set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
       ST(0) = &PL_sv_no;
       XSRETURN(1);