From ee8c7f5465f003860e2347a2946abacac39bd9b9 Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Tue, 23 May 2000 23:35:13 +0000 Subject: Resync with mainline prior to post-5.6.0 updates p4raw-id: //depot/vmsperl@6111 --- vms/ext/Stdio/Stdio.pm | 2 +- vms/ext/vmsish.pm | 11 +++++--- vms/perlvms.pod | 12 ++++----- vms/subconfigure.com | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++ vms/vms.c | 24 +++++++++++++++++ vms/vmsish.h | 6 +++-- 6 files changed, 113 insertions(+), 12 deletions(-) (limited to 'vms') diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm index d485e0e159..b51f2c9f15 100644 --- a/vms/ext/Stdio/Stdio.pm +++ b/vms/ext/Stdio/Stdio.pm @@ -637,6 +637,6 @@ it encounters an error. =head1 REVISION This document was last revised on 13-Oct-1998, for Perl 5.004, 5.005, and -5.006. +5.6.0. =cut diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm index a0e6e3cc21..5d738d0a82 100644 --- a/vms/ext/vmsish.pm +++ b/vms/ext/vmsish.pm @@ -20,7 +20,7 @@ vmsish - Perl pragma to control VMS-specific language features If no import list is supplied, all possible VMS-specific features are assumed. Currently, there are four VMS-specific features available: -'status' (a.k.a '$?'), 'exit', 'time' and 'messages' (a.k.a 'message'). +'status' (a.k.a '$?'), 'exit', 'time' and 'hushed'. =over 6 @@ -44,8 +44,13 @@ default of Universal Time (a.k.a Greenwich Mean Time, or GMT). =item C -This supresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR -if Perl terminates with an error status. +This suppresses printing of VMS status messages to SYS$OUTPUT and SYS$ERROR +if Perl terminates with an error status. This primarily effects error +exits from things like Perl compiler errors or "standard Perl" runtime errors, +where text error messages are also generated by Perl. + +The error exits from inside the core are generally more serious, and are +not supressed. =back diff --git a/vms/perlvms.pod b/vms/perlvms.pod index 3883233c28..e6d13f3081 100644 --- a/vms/perlvms.pod +++ b/vms/perlvms.pod @@ -569,7 +569,7 @@ invoked using C or a text file which should be passed to DCL as a command procedure. If LIST consists of the empty string, C spawns an -interactive DCL subprocess, in the same fashion as typiing +interactive DCL subprocess, in the same fashion as typing B at the DCL prompt. Perl waits for the subprocess to complete before continuing @@ -597,7 +597,7 @@ not appear separately in the "child time" field, depending on whether L keeps track of subprocesses separately. Note especially that the VAXCRTL (at least) keeps track only of subprocesses spawned using L and L; it will not -accumulate the times of suprocesses spawned via pipes, L, +accumulate the times of subprocesses spawned via pipes, L, or backticks. =item unlink LIST @@ -661,7 +661,7 @@ The FLAGS argument is ignored in all cases. The following VMS-specific information applies to the indicated "special" Perl variables, in addition to the general information -in L. Where there is a conflict, this infrmation +in L. Where there is a conflict, this information takes precedence. =over 4 @@ -858,9 +858,9 @@ it's equivalent to calling fflush() and fsync() from C. =head2 SDBM_File -SDBM_File works peroperly on VMS. It has, however, one minor -difference. The database directory file created has a L<.sdbm_dir> -extension rather than a L<.dir> extension. L<.dir> files are VMS filesystem +SDBM_File works properly on VMS. It has, however, one minor +difference. The database directory file created has a F<.sdbm_dir> +extension rather than a F<.dir> extension. F<.dir> files are VMS filesystem directory files, and using them for other purposes could cause unacceptable problems. diff --git a/vms/subconfigure.com b/vms/subconfigure.com index b16eb53c02..4aea63bb62 100644 --- a/vms/subconfigure.com +++ b/vms/subconfigure.com @@ -69,14 +69,18 @@ $ myname = myhostname $ IF myname .EQS. "" THEN myname = F$TRNLNM("SYS$NODE") $! $! ##ADD NEW CONSTANTS HERE## +$ perl_d_isnan= = "define" +$ perl_sizesize = "4" $ perl_shmattype = "" $ perl_mmaptype = "" $ perl_gidformat = "lu" $ perl_gidsize = "4" +$ perl_gidsign = "1" $ perl_groupstype = "Gid_t" $ perl_stdio_stream_array = "" $ perl_uidformat = "lu" $ perl_uidsize = "4" +$ perl_uidsign = "1" $ perl_d_getcwd = "undef" $ perl_d_nv_preserves_uv = "define" $ perl_d_fs_data_s = "undef" @@ -397,6 +401,8 @@ $ perl_lseektype="int" $ perl_i_values="undef" $ perl_malloctype="void *" $ perl_freetype="void" +$ perl_d_perl_otherlibdirs="undef" +$ perl_otherlibdirs="" $ IF mymalloc $ THEN $ perl_d_mymalloc="define" @@ -483,6 +489,9 @@ $ perl_d_quad = "define" $ perl_quadtype = "long long" $ perl_uquadtype = "unsigned long long" $ perl_quadkind = "QUAD_IS_LONG_LONG" +$ perl_d_frexpl = "define" +$ perl_d_isnanl = "define" +$ perl_d_modfl = "define" $ ELSE $ perl_d_PRIfldbl = "undef" $ perl_d_PRIgldbl = "undef" @@ -500,6 +509,9 @@ $ perl_d_quad = "undef" $ perl_quadtype = "long" $ perl_uquadtype = "unsigned long" $ perl_quadkind = "QUAD_IS_LONG" +$ perl_d_frexpl = "undef" +$ perl_d_isnanl = "undef" +$ perl_d_modfl = "undef" $ ENDIF $! $! Now some that we build up @@ -3205,6 +3217,49 @@ $ $ perl_ptrsize=line $ WRITE_RESULT "ptrsize is ''perl_ptrsize'" $! +$! Check for size_t size +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include +$ WS "#endif +$ WS "#include +$ WS "int main() +$ WS "{" +$ WS "int foo; +$ WS "foo = sizeof(size_t); +$ WS "printf(""%d\n"", foo); +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ ON ERROR THEN CONTINUE +$ ON WARNING THEN CONTINUE +$ 'Checkcc' temp.c +$ If Needs_Opt +$ THEN +$ link temp.obj,temp.opt/opt +$ else +$ link temp.obj +$ endif +$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ DEFINE SYS$ERROR TEMPOUT +$ DEFINE SYS$OUTPUT TEMPOUT +$ mcr []temp +$ CLOSE TEMPOUT +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ OPEN/READ TEMPOUT [-.uu]tempout.lis +$ READ TEMPOUT line +$ CLOSE TEMPOUT +$ DELETE/NOLOG [-.uu]tempout.lis; +$ +$ perl_sizesize=line +$ WRITE_RESULT "sizesize is ''perl_sizesize'" +$! $! Check rand48 and its ilk $! $ OS @@ -3767,6 +3822,8 @@ $ WC "d_mkdir='" + perl_d_mkdir + "'" $ WC "d_msg='" + perl_d_msg + "'" $ WC "d_open3='" + perl_d_open3 + "'" $ WC "d_poll='" + perl_d_poll + "'" +$ WC "d_perl_otherlibdirs='" + perl_d_perl_otherlibdirs + "'" +$ WC "otherlibdirs='" + perl_otherlibdirs + "'" $ WC "d_readdir='" + perl_d_readdir + "'" $ WC "d_seekdir='" + perl_d_seekdir + "'" $ WC "d_telldir='" + perl_d_telldir + "'" @@ -3963,13 +4020,21 @@ $ WC "libs='" + perl_libs + "'" $ WC "libc='" + perl_libc + "'" $ WC "xs_apiversion='" + version + "'" $ WC "pm_apiversion='" + version + "'" +$ WC "version='" + version + "'" +$ WC "revision='" + revision + "'" +$ WC "patchlevel='" + patchlevel + "'" +$ WC "subversion='" + subversion + "'" +$ WC "PERL_VERSION='" + patchlevel + "'" +$ WC "PERL_SUBVERSION='" + subversion + "'" $ WC "pager='" + perl_pager + "'" $ WC "uidtype='" + perl_uidtype + "'" $ WC "uidformat='" + perl_uidformat + "'" $ WC "uidsize='" + perl_uidsize + "'" +$ WC "uidsign='" + perl_uidsign + "'" $ WC "gidtype='" + perl_gidtype + "'" $ WC "gidformat='" + perl_gidformat + "'" $ WC "gidsize='" + perl_gidsize + "'" +$ WC "gidsign='" + perl_gidsign + "'" $ WC "usethreads='" + perl_usethreads + "'" $ WC "d_pthread_yield='" + perl_d_pthread_yield + "'" $ WC "d_pthreads_created_joinable='" + perl_d_pthreads_created_joinable + "'" @@ -4195,6 +4260,11 @@ $ WC "uvuformat='" + perl_uvuformat + "'" $ WC "uvoformat='" + perl_uvoformat + "'" $ WC "uvxformat='" + perl_uvxformat + "'" $ WC "d_vms_case_sensitive_symbols='" + d_vms_be_case_sensitive + "'" +$ WC "sizesize='" + perl_sizesize + "'" +$ WC "d_frexpl='" + perl_d_frexpl + "'" +$ WC "d_isnan='" + perl_d_isnan + "'" +$ WC "d_isnanl='" + perl_d_isnanl + "'" +$ WC "d_modfl='" + perl_d_modfl + "'" $! $! ##WRITE NEW CONSTANTS HERE## $! diff --git a/vms/vms.c b/vms/vms.c index c18ca49879..c50d828e7c 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -911,6 +911,30 @@ my_mkdir(char *dir, Mode_t mode) } /* end of my_mkdir */ /*}}}*/ +/*{{{int my_chdir(char *)*/ +int +my_chdir(char *dir) +{ + STRLEN dirlen = strlen(dir); + dTHX; + + /* zero length string sometimes gives ACCVIO */ + if (dirlen == 0) return -1; + + /* some versions of CRTL chdir() doesn't tolerate trailing /, since + * that implies + * null file name/type. However, it's commonplace under Unix, + * so we'll allow it for a gain in portability. + */ + if (dir[dirlen-1] == '/') { + char *newdir = savepvn(dir,dirlen-1); + int ret = chdir(newdir); + Safefree(newdir); + return ret; + } + else return chdir(dir); +} /* end of my_chdir */ +/*}}}*/ static void create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc) diff --git a/vms/vmsish.h b/vms/vmsish.h index e460241ba1..16d119dd06 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -109,6 +109,7 @@ #define do_rmdir Perl_do_rmdir #define kill_file Perl_kill_file #define my_mkdir Perl_my_mkdir +#define my_chdir Perl_my_chdir #define my_utime Perl_my_utime #define rmsexpand Perl_rmsexpand #define rmsexpand_ts Perl_rmsexpand_ts @@ -232,7 +233,6 @@ #define TEST_VMSISH(h) (PL_curcop->op_private & ((h) >> HINT_V_VMSISH)) #define VMSISH_HUSHED TEST_VMSISH(HINT_M_VMSISH_HUSHED) #define VMSISH_STATUS TEST_VMSISH(HINT_M_VMSISH_STATUS) -#define VMSISH_EXIT TEST_VMSISH(HINT_M_VMSISH_EXIT) #define VMSISH_TIME TEST_VMSISH(HINT_M_VMSISH_TIME) /* Flags for vmstrnenv() */ @@ -449,8 +449,9 @@ struct utimbuf { /* Ditto for sys$hash_passwrod() . . . */ #define crypt my_crypt -/* Tweak arg to mkdir first, so we can tolerate trailing /. */ +/* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */ #define Mkdir(dir,mode) my_mkdir((dir),(mode)) +#define Chdir(dir) my_chdir((dir)) /* Use our own stat() clones, which handle Unix-style directory names */ #define Stat(name,bufptr) flex_stat(name,bufptr) @@ -640,6 +641,7 @@ char * my_gconvert (double, int, int, char *); int do_rmdir (char *); int kill_file (char *); int my_mkdir (char *, Mode_t); +int my_chdir (char *); int my_utime (char *, struct utimbuf *); char * rmsexpand (char *, char *, char *, unsigned); char * rmsexpand_ts (char *, char *, char *, unsigned); -- cgit v1.2.1 From 8713643e844ed8f4c79356f71e306822511dbfeb Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Wed, 24 May 2000 02:19:55 +0000 Subject: Check for existence of file before trying to delete p4raw-id: //depot/vmsperl@6112 --- vms/test.com | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'vms') diff --git a/vms/test.com b/vms/test.com index 5bb999d5a4..1039525e9e 100644 --- a/vms/test.com +++ b/vms/test.com @@ -41,7 +41,7 @@ $ if p2.nes."" then dbg = "dbg" $ if p2.nes."" then ndbg = "ndbg" $! $! Pick up a copy of perl to use for the tests -$ Delete/Log/NoConfirm Perl.;* +$ If F$Search("Perl.").nes."" Then Delete/Log/NoConfirm Perl.;* $ Copy/Log/NoConfirm [-]'ndbg'Perl'exe' []Perl. $ $! Make the environment look a little friendlier to tests which assume Unix -- cgit v1.2.1 From 51d72eab6b91de4131dc68036f54a9d76d1639fe Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Wed, 24 May 2000 02:24:40 +0000 Subject: Ugly workaround for version-specific RTL error p4raw-id: //depot/vmsperl@6113 --- vms/vms.c | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'vms') diff --git a/vms/vms.c b/vms/vms.c index c50d828e7c..f3448bb11e 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -4695,6 +4695,12 @@ cando_by_name(I32 bit, Uid_t effective, char *fname) if (retsts == SS$_ACCONFLICT) { return TRUE; } + +#if defined(__ALPHA) && defined(__VMS_VER) && __VMS_VER == 70100022 && defined(__DECC_VER) && __DECC_VER == 6009001 + /* XXX Hideous kluge to accomodate error in specific version of RTL; + we hope it'll be buried soon */ + if (retsts == 114762) return TRUE; +#endif _ckvmssts(retsts); return FALSE; /* Should never get here */ -- cgit v1.2.1 From 744a34f9085790ea7e2e782a67280c43116f938e Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Thu, 25 May 2000 02:25:34 +0000 Subject: Urk -- undo previous removal of vmsish 'exit' change p4raw-id: //depot/vmsperl@6114 --- vms/ext/vmsish.pm | 19 ++++++++++++++----- vms/vmsish.h | 5 ++--- 2 files changed, 16 insertions(+), 8 deletions(-) (limited to 'vms') diff --git a/vms/ext/vmsish.pm b/vms/ext/vmsish.pm index 5d738d0a82..c51863a4f3 100644 --- a/vms/ext/vmsish.pm +++ b/vms/ext/vmsish.pm @@ -67,9 +67,8 @@ sub bits { my $bits = 0; my $sememe; foreach $sememe (@_) { - $bits |= 0x10000000, next if $sememe eq 'hushed'; - $bits |= 0x20000000, next if $sememe eq 'status' || $sememe eq '$?'; - $bits |= 0x40000000, next if $sememe eq 'exit'; + $bits |= 0x20000000, next if $sememe eq 'hushed'; + $bits |= 0x40000000, next if $sememe eq 'status' || $sememe eq '$?'; $bits |= 0x80000000, next if $sememe eq 'time'; } $bits; @@ -77,12 +76,22 @@ sub bits { sub import { shift; - $^H |= bits(@_ ? @_ : qw(status exit time hushed)); + $^H |= bits(@_ ? @_ : qw(status time hushed)); + my $sememe; + + foreach $sememe (@_ ? @_ : qw(exit)) { + $^H{'vmsish_exit'} = 1 if $sememe eq 'exit'; + } } sub unimport { shift; - $^H &= ~ bits(@_ ? @_ : qw(status exit time hushed)); + $^H &= ~ bits(@_ ? @_ : qw(status time hushed)); + my $sememe; + + foreach $sememe (@_ ? @_ : qw(exit)) { + $^H{'vmsish_exit'} = 0 if $sememe eq 'exit'; + } } 1; diff --git a/vms/vmsish.h b/vms/vmsish.h index 16d119dd06..c21f8f329e 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -224,9 +224,8 @@ #define COMPLEX_STATUS 1 /* We track both "POSIX" and VMS values */ #define HINT_V_VMSISH 24 -#define HINT_M_VMSISH_HUSHED 0x10000000 /* turn off message on error exit*/ -#define HINT_M_VMSISH_STATUS 0x20000000 /* system, $? return VMS status */ -#define HINT_M_VMSISH_EXIT 0x40000000 /* exit(1) ==> SS$_NORMAL */ +#define HINT_M_VMSISH_HUSHED 0x20000000 /* stifle error msgs on exit */ +#define HINT_M_VMSISH_STATUS 0x40000000 /* system, $? return VMS status */ #define HINT_M_VMSISH_TIME 0x80000000 /* times are local, not UTC */ #define NATIVE_HINTS (PL_hints >> HINT_V_VMSISH) /* used in op.c */ -- cgit v1.2.1 From a2a900195eaa6a86b7c76db810e225ef84e2936f Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Thu, 25 May 2000 03:10:36 +0000 Subject: Add bounds checking for several strings (Charles Lane) p4raw-id: //depot/vmsperl@6115 --- vms/vms.c | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'vms') diff --git a/vms/vms.c b/vms/vms.c index f3448bb11e..ca8b02a1f2 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -897,6 +897,9 @@ my_mkdir(char *dir, Mode_t mode) STRLEN dirlen = strlen(dir); dTHX; + /* zero length string sometimes gives ACCVIO */ + if (dirlen == 0) return -1; + /* CRTL mkdir() doesn't tolerate trailing /, since that implies * null file name/type. However, it's commonplace under Unix, * so we'll allow it for a gain in portability. @@ -1484,7 +1487,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL; } dirlen = strlen(dir); - while (dir[dirlen-1] == '/') --dirlen; + while (dirlen && dir[dirlen-1] == '/') --dirlen; if (!dirlen) { /* We had Unixish '/' -- substitute top of current tree */ strcpy(trndir,"/sys$disk/000000"); dir = trndir; @@ -1510,7 +1513,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) * ... do_fileify_dirspec("myroot",buf,1) ... * does something useful. */ - if (!strcmp(dir+dirlen-2,".]")) { + if (dirlen >= 2 && !strcmp(dir+dirlen-2,".]")) { dir[--dirlen] = '\0'; dir[dirlen-1] = ']'; } @@ -1540,7 +1543,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) (dir[2] == '\0' || (dir[2] == '/' && dir[3] == '\0'))) return do_fileify_dirspec("[-]",buf,ts); } - if (dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */ + if (dirlen && dir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */ dirlen -= 1; /* to last element */ lastdir = strrchr(dir,'/'); } @@ -1567,7 +1570,7 @@ static char *do_fileify_dirspec(char *dir,char *buf,int ts) } while ((cp1 = strstr(cp1,"/.")) != NULL); lastdir = strrchr(dir,'/'); } - else if (!strcmp(&dir[dirlen-7],"/000000")) { + else if (dirlen >= 7 && !strcmp(&dir[dirlen-7],"/000000")) { /* Ditto for specs that end in an MFD -- let the VMS code * figure out whether it's a real device or a rooted logical. */ dir[dirlen] = '/'; dir[dirlen+1] = '\0'; -- cgit v1.2.1 From 86774884b769c9587a2f02e1c3eaba3a2cc497ec Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Thu, 25 May 2000 03:58:09 +0000 Subject: Treat sockets as special in sys(read|write) (Charles Lane et al.) p4raw-id: //depot/vmsperl@6117 --- vms/vmsish.h | 2 ++ 1 file changed, 2 insertions(+) (limited to 'vms') diff --git a/vms/vmsish.h b/vms/vmsish.h index c21f8f329e..a181e7c3d9 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -254,6 +254,8 @@ #ifdef VMS_DO_SOCKETS #include "sockadapt.h" +#define PERL_SOCK_SYSREAD_IS_RECV +#define PERL_SOCK_SYSWRITE_IS_SEND #endif #define BIT_BUCKET "_NLA0:" -- cgit v1.2.1 From f282b18d2bccfa65fa756124e825b7ce71f9b64f Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Thu, 25 May 2000 04:17:57 +0000 Subject: Regularize distinction between RMS$_DNF and RMS$_DIR (Craig Berry) Flatten case labels in switch statements uniformly (Charles Bailey) p4raw-id: //depot/vmsperl@6118 --- vms/vms.c | 77 ++++++++++++++++++++++++++++----------------------------------- 1 file changed, 34 insertions(+), 43 deletions(-) (limited to 'vms') diff --git a/vms/vms.c b/vms/vms.c index ca8b02a1f2..cc1184b6cf 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -732,8 +732,7 @@ my_crypt(const char *textpasswd, const char *usrname) usrdsc.dsc$a_pointer = usrname; if (!((sts = sys$getuai(0, 0, &usrdsc, uailst, 0, 0, 0)) & 1)) { switch (sts) { - case SS$_NOGRPPRV: - case SS$_NOSYSPRV: + case SS$_NOGRPPRV: case SS$_NOSYSPRV: set_errno(EACCES); break; case RMS$_RNF: @@ -832,15 +831,13 @@ kill_file(char *name) newace.myace$l_ident = oldace.myace$l_ident; if (!((aclsts = sys$change_acl(0,&type,&fildsc,lcklst,0,0,0)) & 1)) { switch (aclsts) { - case RMS$_FNF: - case RMS$_DNF: - case RMS$_DIR: - case SS$_NOSUCHOBJECT: + case RMS$_FNF: case RMS$_DNF: case SS$_NOSUCHOBJECT: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; - case RMS$_SYN: - case SS$_INVFILFOROP: + case RMS$_SYN: case SS$_INVFILFOROP: set_errno(EINVAL); break; case RMS$_PRV: set_errno(EACCES); break; @@ -1343,8 +1340,7 @@ do_rmsexpand(char *filespec, char *outbuf, int ts, char *defspec, unsigned opts) retsts = sys$parse(&myfab,0,0); if (!(retsts & 1)) { mynam.nam$b_nop |= NAM$M_SYNCHK; - if (retsts == RMS$_DNF || retsts == RMS$_DIR || - retsts == RMS$_DEV || retsts == RMS$_DEV) { + if (retsts == RMS$_DNF || retsts == RMS$_DIR || retsts == RMS$_DEV) { retsts = sys$parse(&myfab,0,0); if (retsts & 1) goto expanded; } @@ -2690,14 +2686,13 @@ unsigned long int zero = 0, sts; set_vaxc_errno(sts); switch (sts) { - case RMS$_FNF: - case RMS$_DNF: - case RMS$_DIR: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; - case RMS$_FNM: - case RMS$_SYN: + case RMS$_FNM: case RMS$_SYN: set_errno(EINVAL); break; case RMS$_PRV: set_errno(EACCES); break; @@ -3267,7 +3262,8 @@ readdir(DIR *dd) case RMS$_DEV: set_errno(ENODEV); break; case RMS$_DIR: - case RMS$_FNF: + set_errno(ENOTDIR); break; + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; default: set_errno(EVMSERR); @@ -3607,10 +3603,12 @@ vms_do_exec(char *cmd) retsts = lib$do_command(&VMScmd); switch (retsts) { - case RMS$_FNF: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; - case RMS$_DNF: case RMS$_DIR: case RMS$_DEV: + case RMS$_DIR: set_errno(ENOTDIR); break; + case RMS$_DEV: + set_errno(ENODEV); break; case RMS$_PRV: set_errno(EACCES); break; case RMS$_SYN: @@ -3667,10 +3665,12 @@ do_spawn(char *cmd) if (!(sts & 1)) { switch (sts) { - case RMS$_FNF: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; - case RMS$_DNF: case RMS$_DIR: case RMS$_DEV: + case RMS$_DIR: set_errno(ENOTDIR); break; + case RMS$_DEV: + set_errno(ENODEV); break; case RMS$_PRV: set_errno(EACCES); break; case RMS$_SYN: @@ -4648,26 +4648,14 @@ cando_by_name(I32 bit, Uid_t effective, char *fname) } switch (bit) { - case S_IXUSR: - case S_IXGRP: - case S_IXOTH: - access = ARM$M_EXECUTE; - break; - case S_IRUSR: - case S_IRGRP: - case S_IROTH: - access = ARM$M_READ; - break; - case S_IWUSR: - case S_IWGRP: - case S_IWOTH: - access = ARM$M_WRITE; - break; - case S_IDUSR: - case S_IDGRP: - case S_IDOTH: - access = ARM$M_DELETE; - break; + case S_IXUSR: case S_IXGRP: case S_IXOTH: + access = ARM$M_EXECUTE; break; + case S_IRUSR: case S_IRGRP: case S_IROTH: + access = ARM$M_READ; break; + case S_IWUSR: case S_IWGRP: case S_IWOTH: + access = ARM$M_WRITE; break; + case S_IDUSR: case S_IDGRP: case S_IDOTH: + access = ARM$M_DELETE; break; default: return FALSE; } @@ -4894,9 +4882,10 @@ rmscopy(char *spec_in, char *spec_out, int preserve_dates) if (!((sts = sys$open(&fab_in)) & 1)) { set_vaxc_errno(sts); switch (sts) { - case RMS$_FNF: - case RMS$_DIR: + case RMS$_FNF: case RMS$_DNF: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; case RMS$_SYN: @@ -4938,8 +4927,10 @@ rmscopy(char *spec_in, char *spec_out, int preserve_dates) if (!((sts = sys$create(&fab_out)) & 1)) { set_vaxc_errno(sts); switch (sts) { - case RMS$_DIR: + case RMS$_DNF: set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; case RMS$_DEV: set_errno(ENODEV); break; case RMS$_SYN: -- cgit v1.2.1 From 399b815183ac77267abe8956bec359166640370a Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Thu, 25 May 2000 04:21:25 +0000 Subject: Quiet error messages in vmsish.t (Charles Lane) p4raw-id: //depot/vmsperl@6119 --- vms/ext/vmsish.t | 1 + 1 file changed, 1 insertion(+) (limited to 'vms') diff --git a/vms/ext/vmsish.t b/vms/ext/vmsish.t index 2a5b580bda..d63da57235 100644 --- a/vms/ext/vmsish.t +++ b/vms/ext/vmsish.t @@ -136,6 +136,7 @@ sub do_a_perl { local *P; open(P,'>vmsish_test.com') || die('not ok ?? : unable to open "vmsish_test.com" for writing'); print P "\$ set message/facil/sever/ident/text\n"; + print P "\$ define/nolog/user sys\$error _nla0:\n"; print P "\$ $Invoke_Perl @_\n"; close P; my $x = `\@vmsish_test.com`; -- cgit v1.2.1 From 23724483b0ae0f947e5099eec2b292e01c1fb958 Mon Sep 17 00:00:00 2001 From: Gurusamy Sarathy Date: Sun, 28 May 2000 07:18:41 +0000 Subject: VMS test harness tweak (from Jesper Naur ) p4raw-id: //depot/perl@6129 --- vms/test.com | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'vms') diff --git a/vms/test.com b/vms/test.com index a040427d5c..4f345cec0e 100644 --- a/vms/test.com +++ b/vms/test.com @@ -93,7 +93,7 @@ $ $! And do it $ Show Process/Accounting $ testdir = "Directory/NoHead/NoTrail/Column=1" -$ Define/User 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe' +$ Define 'dbg'Perlshr Sys$Disk:[-]'dbg'PerlShr'exe' $ MCR Sys$Disk:[]Perl. "-I[-.lib]" - "''p3'" "''p4'" "''p5'" "''p6'" $ Deck/Dollar=$$END-OF-TEST$$ # $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $ @@ -240,6 +240,7 @@ print sprintf("u=%g s=%g cu=%g cs=%g files=%d tests=%d\n", $user,$sys,$cuser,$csys,$files,$totmax); $$END-OF-TEST$$ $ wrapup: +$ deassign 'dbg'Perlshr $ Show Process/Accounting $ If F$Search("Echo.Exe").nes."" Then Delete/Log/NoConfirm Echo.Exe;* $ Set Default &olddef -- cgit v1.2.1