Craig A. Berry wrote:
On Feb 5, 2009, at 6:50 PM, John Malmberg wrote:
Craig A. Berry wrote:
On Feb 4, 2009, at 8:43 AM, John Malmberg wrote:
+ ret = Perl_flex_lstat(NULL, file_spec, &st);
You're explicitly passing a null thread context? That won't work.
The function prototype is
int Perl_flex_lstat (pTHX_ const char *, Stat_t *);
and pTHX_ will not expand to anything in the case of a Perl built
without thread support. So in a non-threaded Perl you'll be passing
three arguments to a function that expects two. What problem are
you trying to solve by ignoring whatever actual thread context there
may be and saying that it's always null?
The next patch would have covered that
I think a patch that would cause the default configuration to have
compile failures needs to be considered not quite finished yet.
I forgot that the thread context did not exist on non-threaded builds
when I put the NULLs in.
But I am also confused as I see a syntax error in the patch that should
have prevented it from building/running at all for me, yet it built and
ran the test switch.
as would remove the thread context from the wrappers and static
routines that do not need it.
If you're talking about routines prefixed with "Perl_" that's really
considered a public interface and shouldn't be changed on a whim.
Didn't you create some internal routines specifically for the cases
where we don't or can't use a thread context?
Most of the wrapper routines for the CRTL do not need a thread context
anymore. I can put that back.
I also found at least one case where the thread and non-threaded
definitions was inconsistent, which indicated that nothing else could
have been using it.
I do not know why the patch would not apply though.
I made the patch against a different reference copy than blead. I think
it was because you had not yet committed the previous patch. Somewhere
something got out of synch.
I will revise and resubmit with the changes to vmsish.h to remove the
thread context. It will probably take a few days.
Attached is the patch.
I think this gets all the changes in for the Unix compatible / Extended
character set needed into the VMS specific code. When I get a few more
cycles, I will report what is still different from blead and what I am
running. I think I need to update a few patches to the dual mode
modules, but otherwise most of the patches have been submitted.
-John
wb8...@gmail.com
Personal Opinion Only
--- /rsync_root/perl/vms/vmsish.h Sun Feb 1 15:19:12 2009
+++ vms/vmsish.h Thu Feb 5 21:52:17 2009
@@ -133,6 +133,18 @@
#define vms_image_init Perl_vms_image_init
#define my_tmpfile Perl_my_tmpfile
#define vmstrnenv Perl_vmstrnenv
+#ifdef HAS_SYMLINK
+# define my_symlink(a, b) Perl_my_symlink(a, b)
+#endif
+#define kill_file Perl_kill_file
+#define my_fgetname(a, b) Perl_my_fgetname(a, b)
+#define do_rmdir(a) Perl_do_rmdir(a)
+#define rename Perl_rename
+#define my_mkdir Perl_my_mkdir
+#define my_chdir Perl_my_chdir
+#define my_chmod Perl_my_chmod
+#define rmscopy Perl_rmscopy
+#define trim_unixpath Perl_trim_unixpath
#if !defined(PERL_IMPLICIT_CONTEXT)
#define my_getenv_len Perl_my_getenv_len
#define vmssetenv Perl_vmssetenv
@@ -155,7 +167,6 @@
#define tovmspath_ts Perl_tovmspath_ts
#define tovmspath_utf8 Perl_tovmspath_utf8
#define tovmspath_utf8_ts Perl_tovmspath_utf8_ts
-#define do_rmdir Perl_do_rmdir
#define fileify_dirspec Perl_fileify_dirspec
#define fileify_dirspec_ts Perl_fileify_dirspec_ts
#define fileify_dirspec_utf8 Perl_fileify_dirspec_utf8
@@ -164,19 +175,12 @@
#define pathify_dirspec_ts Perl_pathify_dirspec_ts
#define pathify_dirspec_utf8 Perl_pathify_dirspec_utf8
#define pathify_dirspec_utf8_ts Perl_pathify_dirspec_utf8_ts
-#define trim_unixpath Perl_trim_unixpath
#define opendir Perl_opendir
-#define rename Perl_rename
-#define rmscopy Perl_rmscopy
-#define my_mkdir Perl_my_mkdir
#define vms_do_aexec Perl_vms_do_aexec
#define vms_do_exec Perl_vms_do_exec
#define my_waitpid Perl_my_waitpid
#define my_crypt Perl_my_crypt
-#define kill_file Perl_kill_file
#define my_utime Perl_my_utime
-#define my_chdir Perl_my_chdir
-#define my_chmod Perl_my_chmod
#define do_aspawn Perl_do_aspawn
#define seekdir Perl_seekdir
#define my_gmtime Perl_my_gmtime
@@ -216,7 +220,6 @@
#define tovmspath_ts(a,b) Perl_tovmspath_utf8_ts(aTHX_ a,b,NULL)
#define tovmspath_utf8(a,b,c) Perl_tovmspath_utf8(aTHX_ a,b,c)
#define tovmspath_utf8_ts(a,b,c) Perl_tovmspath_utf8_ts(aTHX_ a,b,c)
-#define do_rmdir(a) Perl_do_rmdir(aTHX_ a)
#define fileify_dirspec(a,b) Perl_fileify_dirspec(aTHX_ a,b)
#define fileify_dirspec_ts(a,b) Perl_fileify_dirspec_ts(aTHX_ a,b)
#define fileify_dirspec_utf8(a,b,c) Perl_fileify_dirspec(aTHX_ a,b,utf8)
@@ -229,19 +232,12 @@
#define rmsexpand_ts(a,b,c,d) Perl_rmsexpand_utf8_ts(aTHX_ a,b,c,d,NULL,NULL)
#define rmsexpand_utf8(a,b,c,d,e,f) Perl_rmsexpand_utf8(aTHX_ a,b,c,d,e,f)
#define rmsexpand_utf8_ts(a,b,c,d,e,f) Perl_rmsexpand_utf8_ts(aTHX_
a,b,c,d,e,f)
-#define trim_unixpath(a,b,c) Perl_trim_unixpath(aTHX_ a,b,c)
#define opendir(a) Perl_opendir(aTHX_ a)
-#define rename(a,b) Perl_rename(aTHX_ a,b)
-#define rmscopy(a,b,c) Perl_rmscopy(aTHX_ a,b,c)
-#define my_mkdir(a,b) Perl_my_mkdir(aTHX_ a,b)
#define vms_do_aexec(a,b,c) Perl_vms_do_aexec(aTHX_ a,b,c)
#define vms_do_exec(a) Perl_vms_do_exec(aTHX_ a)
#define my_waitpid(a,b,c) Perl_my_waitpid(aTHX_ a,b,c)
#define my_crypt(a,b) Perl_my_crypt(aTHX_ a,b)
-#define kill_file(a) Perl_kill_file(aTHX_ a)
#define my_utime(a,b) Perl_my_utime(aTHX_ a,b)
-#define my_chdir(a) Perl_my_chdir(aTHX_ a)
-#define my_chmod(a,b) Perl_my_chmod(aTHX_ a,b)
#define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c)
#define seekdir(a,b) Perl_seekdir(aTHX_ a,b)
#define my_gmtime(a) Perl_my_gmtime(aTHX_ a)
@@ -275,12 +271,7 @@
#define my_getpwent() Perl_my_getpwent(aTHX)
#define my_endpwent() Perl_my_endpwent(aTHX)
#define my_getlogin Perl_my_getlogin
-#ifdef HAS_SYMLINK
-# define my_symlink(a, b) Perl_my_symlink(aTHX_ a, b)
-#endif
#define init_os_extras Perl_init_os_extras
-#define vms_realpath(a, b, c) Perl_vms_realpath(aTHX_ a,b,c)
-#define vms_realname(a, b, c) Perl_vms_realname(aTHX_ a,b,c)
#define vms_case_tolerant(a) Perl_vms_case_tolerant(a)
/* Delete if at all possible, changing protections if necessary. */
@@ -520,6 +511,7 @@
# define fwrite my_fwrite /* for PerlSIO_fwrite */
# define fdopen my_fdopen
# define fclose my_fclose
+# define fgetname(a, b) my_fgetname(a, b)
#ifdef HAS_SYMLINK
# define symlink my_symlink
#endif
@@ -643,7 +635,7 @@
#define crypt(a,b) Perl_my_crypt(aTHX_ a,b)
/* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */
-#define Mkdir(dir,mode) Perl_my_mkdir(aTHX_ (dir),(mode))
+#define Mkdir(dir,mode) Perl_my_mkdir((dir),(mode))
#define Chdir(dir) my_chdir((dir))
#ifndef DONT_MASK_RTL_CALLS
#define chmod(file_spec, mode) my_chmod((file_spec), (mode))
@@ -847,7 +839,15 @@
/* prototype section start marker; `typedef' passes through cpp */
typedef char __VMS_PROTOTYPES__;
int Perl_vmstrnenv (const char *, char *, unsigned long int, struct
dsc$descriptor_s **, unsigned long int);
-char * Perl_vms_realpath (pTHX_ const char *, char *, int *);
+char * Perl_vms_realpath (const char *, char *, int *);
+int Perl_do_rmdir (const char *);
+int Perl_rename(const char *, const char *);
+int Perl_my_mkdir (const char *, Mode_t);
+int Perl_kill_file (const char *);
+int Perl_my_chdir (const char *);
+int Perl_my_chmod(const char *, mode_t);
+int Perl_rmscopy (const char *, const char *, int);
+int Perl_trim_unixpath (char *, const char*, int);
#if !defined(PERL_IMPLICIT_CONTEXT)
int Perl_vms_case_tolerant(void);
char * Perl_my_getenv (const char *, bool);
@@ -868,7 +868,6 @@
char * Perl_tovmspath_ts (const char *, char *);
char * Perl_tovmspath_utf8 (const char *, char *, int *);
char * Perl_tovmspath_utf8_ts (const char *, char *, int *);
-int Perl_do_rmdir (const char *);
char * Perl_fileify_dirspec (const char *, char *);
char * Perl_fileify_dirspec_ts (const char *, char *);
char * Perl_fileify_dirspec_utf8 (const char *, char *, int *);
@@ -881,11 +880,7 @@
char * Perl_rmsexpand_ts (const char *, char *, const char *, unsigned);
char * Perl_rmsexpand_utf8 (const char *, char *, const char *, unsigned, int
*, int *);
char * Perl_rmsexpand_utf8_ts (const char *, char *, const char *, unsigned,
int *, int *);
-int Perl_trim_unixpath (char *, const char*, int);
DIR * Perl_opendir (const char *);
-int Perl_rename(const char *, const char *);
-int Perl_rmscopy (const char *, const char *, int);
-int Perl_my_mkdir (const char *, Mode_t);
bool Perl_vms_do_aexec (SV *, SV **, SV **);
#else
char * Perl_my_getenv (pTHX_ const char *, bool);
@@ -906,7 +901,6 @@
char * Perl_tovmspath_ts (pTHX_ const char *, char *);
char * Perl_tovmspath_utf8 (pTHX_ const char *, char *, int *);
char * Perl_tovmspath_utf8_ts (pTHX_ const char *, char *, int *);
-int Perl_do_rmdir (pTHX_ const char *);
char * Perl_fileify_dirspec (pTHX_ const char *, char *);
char * Perl_fileify_dirspec_ts (pTHX_ const char *, char *);
char * Perl_fileify_dirspec_utf8 (pTHX_ const char *, char *, int *);
@@ -919,11 +913,7 @@
char * Perl_rmsexpand_ts (pTHX_ const char *, char *, const char *, unsigned);
char * Perl_rmsexpand_utf8 (pTHX_ const char *, char *, const char *,
unsigned, int *, int *);
char * Perl_rmsexpand_utf8_ts (pTHX_ const char *, char *, const char *,
unsigned, int *, int *);
-int Perl_trim_unixpath (pTHX_ char *, const char*, int);
DIR * Perl_opendir (pTHX_ const char *);
-int Perl_rename (pTHX_ const char *, const char *);
-int Perl_rmscopy (pTHX_ const char *, const char *, int);
-int Perl_my_mkdir (pTHX_ const char *, Mode_t);
bool Perl_vms_do_aexec (pTHX_ SV *, SV **, SV **);
#endif
int Perl_vms_case_tolerant(void);
@@ -933,9 +923,6 @@
char * Perl_my_crypt (pTHX_ const char *, const char *);
Pid_t Perl_my_waitpid (pTHX_ Pid_t, int *, int);
char * my_gconvert (double, int, int, char *);
-int Perl_kill_file (pTHX_ const char *);
-int Perl_my_chdir (pTHX_ const char *);
-int Perl_my_chmod(pTHX_ const char *, mode_t);
FILE * Perl_my_tmpfile (void);
#ifndef HOMEGROWN_POSIX_SIGNALS
int Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct
sigaction*);
@@ -973,8 +960,9 @@
FILE * my_fdopen (int, const char *);
int my_fclose (FILE *);
int my_fwrite (const void *, size_t, size_t, FILE *);
+char * Perl_my_fgetname (FILE *fp, char *buf);
#ifdef HAS_SYMLINK
-int Perl_my_symlink(pTHX_ const char *path1, const char *path2);
+int Perl_my_symlink(const char *path1, const char *path2);
#endif
int Perl_my_flush (pTHX_ FILE *);
struct passwd * Perl_my_getpwnam (pTHX_ const char *name);
--- /rsync_root/perl/vms/vms.c Tue Feb 3 19:43:08 2009
+++ vms/vms.c Thu Feb 5 22:00:15 2009
@@ -283,12 +283,9 @@
#define do_tovmsspec(a,b,c,d) mp_do_tovmsspec(aTHX_ a,b,c,0,d)
#define do_tovmspath(a,b,c,d) mp_do_tovmspath(aTHX_ a,b,c,d)
#define do_rmsexpand(a,b,c,d,e,f,g) mp_do_rmsexpand(aTHX_ a,b,c,d,e,f,g)
-#define do_vms_realpath(a,b,c) mp_do_vms_realpath(aTHX_ a,b,c)
-#define do_vms_realname(a,b,c) mp_do_vms_realname(aTHX_ a,b,c)
#define do_tounixspec(a,b,c,d) mp_do_tounixspec(aTHX_ a,b,c,d)
#define do_tounixpath(a,b,c,d) mp_do_tounixpath(aTHX_ a,b,c,d)
#define do_vms_case_tolerant(a) mp_do_vms_case_tolerant(a)
-#define expand_wild_cards(a,b,c,d) mp_expand_wild_cards(aTHX_ a,b,c,d)
#define getredirection(a,b) mp_getredirection(aTHX_ a,b)
static char *mp_do_tovmspath(pTHX_ const char *path, char *buf, int ts, int *);
@@ -1818,6 +1815,9 @@
/* vmssetuserlnm
* sets a user-mode logical in the process logical name table
* used for redirection of sys$error
+ *
+ * Fix-me: The pTHX is not needed for this routine, however doio.c
+ * is calling it with one instead of using a macro.
*/
void
Perl_vmssetuserlnm(pTHX_ const char *name, const char *eqv)
@@ -1938,7 +1938,7 @@
*/
/*{{{int mp_do_kill_file(const char *name, int dirflag)*/
static int
-mp_do_kill_file(pTHX_ const char *name, int dirflag)
+mp_do_kill_file(const char *name, int dirflag)
{
char *vmsname;
char *rslt;
@@ -2064,10 +2064,18 @@
} /* end of kill_file() */
/*}}}*/
+static int
+Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag);
+
+#ifdef PERL_IMPLICIT_CONTEXT
+#define flex_lstat_noperl(a, b) Perl_flex_stat_int(NULL, a, b,
1)
+#else
+#define flex_lstat_noperl(a, b) Perl_flex_stat_int(a, b, 1)
+#endif
/*{{{int do_rmdir(char *name)*/
int
-Perl_do_rmdir(pTHX_ const char *name)
+Perl_do_rmdir(const char *name)
{
char * dirfile;
int retval;
@@ -2076,7 +2084,7 @@
/* lstat returns a VMS fileified specification of the name */
/* that is looked up, and also lets verifies that this is a directory */
- retval = Perl_flex_lstat(NULL, name, &st);
+ retval = flex_lstat_noperl(name, &st);
if (retval != 0) {
char * ret_spec;
@@ -2090,7 +2098,7 @@
return -1;
/* force it to a file spec for the kill file to work. */
- ret_spec = do_fileify_dirspec(name, st.st_devnam, 0, NULL);
+ ret_spec = int_fileify_dirspec(name, st.st_devnam, NULL);
if (ret_spec == NULL) {
errno = EIO;
return -1;
@@ -2112,7 +2120,7 @@
return -1;
}
- retval = mp_do_kill_file(aTHX_ dirfile, 1);
+ retval = mp_do_kill_file(dirfile, 1);
}
return retval;
@@ -2130,7 +2138,7 @@
*/
/*{{{int kill_file(char *name)*/
int
-Perl_kill_file(pTHX_ const char *name)
+Perl_kill_file(const char *name)
{
char * vmsfile;
Stat_t st;
@@ -2138,7 +2146,7 @@
/* Convert the filename to VMS format and see if it is a directory */
/* flex_lstat returns a vmsified file specification */
- rmsts = Perl_flex_lstat(NULL, name, &st);
+ rmsts = flex_lstat_noperl(name, &st);
if (rmsts != 0) {
/* Due to a historical feature, flex_stat/lstat can not see some */
@@ -2165,11 +2173,11 @@
* This may need special handling to work with the ACL hacks.
*/
if (S_ISDIR(st.st_mode)) {
- rmsts = mp_do_kill_file(aTHX_ vmsfile, 1);
+ rmsts = mp_do_kill_file(vmsfile, 1);
return rmsts;
}
- rmsts = mp_do_kill_file(aTHX_ vmsfile, 0);
+ rmsts = mp_do_kill_file(vmsfile, 0);
/* Need to delete all versions ? */
if ((rmsts == 0) && (vms_unlink_all_versions == 1)) {
@@ -2179,7 +2187,7 @@
/* and we know that the file is in VMS format or that */
/* because of a historical bug, flex_stat can not see the file */
while (lstat(vmsfile, (stat_t *)&st) == 0) {
- rmsts = mp_do_kill_file(aTHX_ vmsfile, 0);
+ rmsts = mp_do_kill_file(vmsfile, 0);
if (rmsts != 0)
break;
i++;
@@ -2201,7 +2209,7 @@
/*{{{int my_mkdir(char *,Mode_t)*/
int
-Perl_my_mkdir(pTHX_ const char *dir, Mode_t mode)
+Perl_my_mkdir(const char *dir, Mode_t mode)
{
STRLEN dirlen = strlen(dir);
@@ -2213,10 +2221,16 @@
* so we'll allow it for a gain in portability.
*/
if (dir[dirlen-1] == '/') {
- char *newdir = savepvn(dir,dirlen-1);
- int ret = mkdir(newdir,mode);
- Safefree(newdir);
- return ret;
+ char *newdir;
+ int ret;
+ newdir = PerlMem_malloc(dirlen);
+ if (newdir ==NULL)
+ _ckvmssts_noperl(SS$_INSFMEM);
+ strncpy(newdir, dir, dirlen - 1);
+ newdir[dirlen-1] = '\0';
+ ret = mkdir(newdir, mode);
+ PerlMem_free(newdir);
+ return ret;
}
else return mkdir(dir,mode);
} /* end of my_mkdir */
@@ -2224,7 +2238,7 @@
/*{{{int my_chdir(char *)*/
int
-Perl_my_chdir(pTHX_ const char *dir)
+Perl_my_chdir(const char *dir)
{
STRLEN dirlen = strlen(dir);
@@ -2250,10 +2264,16 @@
* - Preview- '/' will be valid soon on VMS
*/
if ((dirlen > 1) && (dir1[dirlen-1] == '/')) {
- char *newdir = savepvn(dir1,dirlen-1);
- int ret = chdir(newdir);
- Safefree(newdir);
- return ret;
+ char *newdir;
+ int ret;
+ newdir = PerlMem_malloc(dirlen);
+ if (newdir ==NULL)
+ _ckvmssts_noperl(SS$_INSFMEM);
+ strncpy(newdir, dir1, dirlen-1);
+ newdir[dirlen-1] = '\0';
+ ret = chdir(newdir);
+ PerlMem_free(newdir);
+ return ret;
}
else return chdir(dir1);
} /* end of my_chdir */
@@ -2262,8 +2282,11 @@
/*{{{int my_chmod(char *, mode_t)*/
int
-Perl_my_chmod(pTHX_ const char *file_spec, mode_t mode)
+Perl_my_chmod(const char *file_spec, mode_t mode)
{
+ Stat_t st;
+ int ret = -1;
+ char * changefile;
STRLEN speclen = strlen(file_spec);
/* zero length string sometimes gives ACCVIO */
@@ -2276,41 +2299,26 @@
* Tests are showing that chmod() on VMS 8.3 is only accepting directories
* in VMS file.dir notation.
*/
- if ((speclen > 1) && (file_spec[speclen-1] == '/')) {
- char *vms_src, *vms_dir, *rslt;
- int ret = -1;
- errno = EIO;
-
- /* First convert this to a VMS format specification */
- vms_src = PerlMem_malloc(VMS_MAXRSS);
- if (vms_src == NULL)
- _ckvmssts_noperl(SS$_INSFMEM);
+ changefile = (char *) file_spec; /* cast ok */
+ ret = flex_lstat_noperl(file_spec, &st);
+ if (ret != 0) {
- rslt = do_tovmsspec(file_spec, vms_src, 0, NULL);
- if (rslt == NULL) {
- /* If we fail, then not a file specification */
- PerlMem_free(vms_src);
- errno = EIO;
- return -1;
- }
+ /* Due to a historical feature, flex_stat/lstat can not see some */
+ /* Unix format file names that the rest of the CRTL can see when */
+ /* ODS-2 file specifications are in use. */
+ /* Fixing that feature will cause some perl tests to fail */
+ /* [.lib.ExtUtils.t]Manifest.t is one of them */
+ st.st_mode = 0;
- /* Now make it a directory spec so chmod is happy */
- vms_dir = PerlMem_malloc(VMS_MAXRSS + 1);
- if (vms_dir == NULL)
- _ckvmssts_noperl(SS$_INSFMEM);
- rslt = do_fileify_dirspec(vms_src, vms_dir, 0, NULL);
- PerlMem_free(vms_src);
-
- /* Now do it */
- if (rslt != NULL) {
- ret = chmod(vms_dir, mode);
- } else {
- errno = EIO;
- }
- PerlMem_free(vms_dir);
- return ret;
+ } else {
+ /* It may be possible to get here with nothing in st_devname */
+ /* chmod still may work though */
+ if (st.st_devnam[0] != 0) {
+ changefile = st.st_devnam;
+ }
}
- else return chmod(file_spec, mode);
+ ret = chmod(changefile, mode);
+ return ret;
} /* end of my_chmod */
/*}}}*/
@@ -4290,6 +4298,12 @@
if (*in_mode == 'r') {
PerlIO * xterm_fd;
+#if defined(PERL_IMPLICIT_CONTEXT)
+ /* Can not fork an xterm with a NULL context */
+ /* This probably could never happen */
+ xterm_fd = NULL;
+ if (aTHX != NULL)
+#endif
xterm_fd = create_forked_xterm(aTHX_ cmd, in_mode);
if (xterm_fd != NULL)
return xterm_fd;
@@ -4332,9 +4346,15 @@
} else { /* uh, oh...we're in tempfile hell */
tpipe = vmspipe_tempfile(aTHX);
if (!tpipe) { /* a fish popular in Boston */
- if (ckWARN(WARN_PIPE)) {
+#if defined(PERL_IMPLICIT_CONTEXT)
+ if (aTHX == NULL) {
+ fprintf(stderr,
+ "%%Perl-W-VMS_Init, unable to find VMSPIPE.COM for i/o
piping");
+ } else
+#endif
+ if (ckWARN(WARN_PIPE)) {
Perl_warner(aTHX_ packWARN(WARN_PIPE),"unable to find
VMSPIPE.COM for i/o piping");
- }
+ }
return NULL;
}
fgetname(tpipe,tfilebuf+1,1);
@@ -4364,6 +4384,12 @@
}
set_vaxc_errno(sts);
if (*in_mode != 'n' && ckWARN(WARN_PIPE)) {
+#if defined(PERL_IMPLICIT_CONTEXT)
+ if (aTHX == NULL) {
+ fprintf(stderr, "%%Perl-W-VMS_Init, Can't pipe \"%*s\": %s",
+ strlen(cmd), cmd, Strerror(errno));
+ } else
+#endif
Perl_warner(aTHX_ packWARN(WARN_PIPE),"Can't pipe \"%*s\": %s",
strlen(cmd), cmd, Strerror(errno));
}
*psts = sts;
@@ -5065,12 +5091,6 @@
rms_set_fna(myfab, mynam, (char *)vmsname, strlen(vmsname)); /* cast ok */
rms_bind_fab_nam(myfab, mynam);
- /* Are we removing all versions? */
- if (vms_unlink_all_versions == 1) {
- const char * defspec = ";*";
- rms_set_dna(myfab, mynam, (char *)defspec, strlen(defspec)); /* cast ok */
- }
-
#ifdef NAML$M_OPEN_SPECIAL
rms_set_nam_nop(mynam, NAML$M_OPEN_SPECIAL);
#endif
@@ -5082,7 +5102,7 @@
static int
-vms_rename_with_acl(pTHX_ const struct dsc$descriptor_s * vms_src_dsc,
+vms_rename_with_acl(const struct dsc$descriptor_s * vms_src_dsc,
const struct dsc$descriptor_s * vms_dst_dsc,
unsigned long flags)
{
@@ -5251,7 +5271,7 @@
* enough to pass all but the most strict X/Open compliance test.
*/
int
-Perl_rename(pTHX_ const char *src, const char * dst)
+Perl_rename(const char *src, const char * dst)
{
int retval;
int pre_delete = 0;
@@ -5261,7 +5281,7 @@
Stat_t dst_st;
/* Validate the source file */
- src_sts = Perl_flex_lstat(NULL, src, &src_st);
+ src_sts = flex_lstat_noperl(src, &src_st);
if (src_sts != 0) {
/* No source file or other problem */
@@ -5273,7 +5293,7 @@
return -1;
}
- dst_sts = Perl_flex_lstat(NULL, dst, &dst_st);
+ dst_sts = flex_lstat_noperl(dst, &dst_st);
if (dst_sts == 0) {
if (dst_st.st_dev != src_st.st_dev) {
@@ -5317,7 +5337,7 @@
if (!S_ISDIR(dst_st.st_mode) || S_ISDIR(src_st.st_mode)) {
int d_sts;
- d_sts = mp_do_kill_file(NULL, dst_st.st_devnam,
+ d_sts = mp_do_kill_file(dst_st.st_devnam,
S_ISDIR(dst_st.st_mode));
/* Need to delete all versions ? */
@@ -5325,7 +5345,7 @@
int i = 0;
while (lstat(dst_st.st_devnam, &dst_st.crtl_stat) == 0) {
- d_sts = mp_do_kill_file(NULL, dst_st.st_devnam, 0);
+ d_sts = mp_do_kill_file(dst_st.st_devnam, 0);
if (d_sts != 0)
break;
i++;
@@ -5385,7 +5405,7 @@
/* If the dest is a directory, we must remove it
if (dst_sts == 0) {
int d_sts;
- d_sts = mp_do_kill_file(NULL dst_st.st_devnam, 1);
+ d_sts = mp_do_kill_file(dst_st.st_devnam, 1);
if (d_sts != 0) {
PerlMem_free(vms_dst);
errno = EIO;
@@ -5408,7 +5428,7 @@
if (vms_dir_file == NULL)
_ckvmssts_noperl(SS$_INSFMEM);
- ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL);
+ ret_str = int_fileify_dirspec(vms_dst, vms_dir_file, NULL);
if (ret_str == NULL) {
PerlMem_free(vms_dst);
PerlMem_free(vms_dir_file);
@@ -5485,7 +5505,7 @@
* permit renames that UNIX will allow. Just like the hack
* in for kill_file.
*/
- sts = vms_rename_with_acl(aTHX_ &old_file_dsc, &new_file_dsc, flags);
+ sts = vms_rename_with_acl(&old_file_dsc, &new_file_dsc, flags);
}
PerlMem_free(vms_dst);
@@ -5503,10 +5523,10 @@
int i = 0;
dSAVEDERRNO;
SAVE_ERRNO;
- src_sts = mp_do_kill_file(NULL, src_st.st_devnam,
+ src_sts = mp_do_kill_file(src_st.st_devnam,
S_ISDIR(src_st.st_mode));
while (lstat(src_st.st_devnam, &src_st.crtl_stat) == 0) {
- src_sts = mp_do_kill_file(NULL, src_st.st_devnam,
+ src_sts = mp_do_kill_file(src_st.st_devnam,
S_ISDIR(src_st.st_mode));
if (src_sts != 0)
break;
@@ -9210,7 +9230,7 @@
char *value,
int *count);
-static void mp_expand_wild_cards(pTHX_ char *item,
+static void mp_expand_wild_cards(char *item,
struct list_item **head,
struct list_item **tail,
int *count);
@@ -9363,7 +9383,7 @@
argc = j;
continue;
}
- expand_wild_cards(ap, &list_head, &list_tail, &item_count);
+ mp_expand_wild_cards(ap, &list_head, &list_tail, &item_count);
}
/*
* Allocate and fill in the new argument vector, Some Unix's terminate
@@ -9398,7 +9418,7 @@
/* Input from a pipe, reopen it in binary mode to disable */
/* carriage control processing. */
- fgetname(stdin, mbxname);
+ fgetname(stdin, mbxname, 1);
mbxnam.dsc$a_pointer = mbxname;
mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer);
lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0);
@@ -9478,7 +9498,7 @@
++(*count);
}
-static void mp_expand_wild_cards(pTHX_ char *item,
+static void mp_expand_wild_cards(char *item,
struct list_item **head,
struct list_item **tail,
int *count)
@@ -9966,7 +9986,7 @@
*/
/*{{{int trim_unixpath(char *fspec, char *wildspec, int opts)*/
int
-Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts)
+Perl_trim_unixpath(char *fspec, const char *wildspec, int opts)
{
char *unixified, *unixwild,
*template, *base, *end, *cp1, *cp2;
@@ -11329,6 +11349,34 @@
}
/*}}}*/
+/* fgetname() is not returning the correct file specifications when
+ * decc_filename_unix_report mode is active. So we have to have it
+ * aways return filenames in VMS mode and convert it ourselves.
+ */
+
+/*{{{ char * my_fgetname(FILE *fp, buf)*/
+char *
+Perl_my_fgetname(FILE *fp, char * buf) {
+ char * retname;
+ char * vms_name;
+
+ retname = fgetname(fp, buf, 1);
+
+ /* If we are in VMS mode, then we are done */
+ if (!decc_filename_unix_report || (retname == NULL)) {
+ return retname;
+ }
+
+ /* Convert this to Unix format */
+ vms_name = PerlMem_malloc(VMS_MAXRSS + 1);
+ strcpy(vms_name, retname);
+ retname = int_tounixspec(vms_name, buf, NULL);
+ PerlMem_free(vms_name);
+
+ return retname;
+}
+/*}}}*/
+
/*
* Here are replacements for the following Unix routines in the VMS
environment:
* getpwuid Get information for a particular UIC or UID
@@ -12502,9 +12550,6 @@
return (*name++ == ':') && (*name != ':');
}
-static int
-Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag);
-
static I32
Perl_cando_by_name_int
(pTHX_ I32 bit, bool effective, const char *fname, int opts)
@@ -12566,7 +12611,7 @@
if (vmsname[retlen-1] == ']'
|| vmsname[retlen-1] == '>'
|| vmsname[retlen-1] == ':'
- || (!Perl_flex_stat_int(NULL, vmsname, &st, 1) &&
+ || (!flex_lstat_noperl(vmsname, &st) &&
S_ISDIR(st.st_mode))) {
if (!int_fileify_dirspec(vmsname, fileified, NULL)) {
@@ -13008,7 +13053,7 @@
*/ /* FIXME */
/*{{{int rmscopy(char *src, char *dst, int preserve_dates)*/
int
-Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int
preserve_dates)
+Perl_rmscopy(const char *spec_in, const char *spec_out, int preserve_dates)
{
char *vmsin, * vmsout, *esa, *esal, *esa_out, *esal_out,
*rsa, *rsal, *rsa_out, *rsal_out, *ubf;
@@ -13954,8 +13999,7 @@
static char *
-mp_do_vms_realpath(pTHX_ const char *filespec, char * rslt_spec,
- int *utf8_fl);
+do_vms_realpath(const char *filespec, char * rslt_spec, int *utf8_fl);
void
unixrealpath_fromperl(pTHX_ CV *cv)
@@ -13982,8 +14026,7 @@
}
static char *
-mp_do_vms_realname(pTHX_ const char *filespec, char * rslt_spec,
- int *utf8_fl);
+do_vms_realname(const char *filespec, char * rslt_spec, int *utf8_fl);
void
vmsrealpath_fromperl(pTHX_ CV *cv)
@@ -14017,8 +14060,8 @@
* Also in ODS-2 mode, existing tests assume that the link target
* will be converted to UNIX format.
*/
-/*{{{ int my_symlink(pTHX_ const char *contents, const char *link_name)*/
-int Perl_my_symlink(pTHX_ const char *contents, const char *link_name) {
+/*{{{ int my_symlink(const char *contents, const char *link_name)*/
+int Perl_my_symlink(const char *contents, const char *link_name) {
if (!link_name || !*link_name) {
SETERRNO(ENOENT, SS$_NOSUCHFILE);
return -1;
@@ -14036,7 +14079,7 @@
/* As symbolic links can hold things other than files, we will only do */
/* the conversion in in ODS-2 mode */
- Newx(utarget, VMS_MAXRSS + 1, char);
+ utarget = PerlMem_malloc(VMS_MAXRSS + 1);
if (int_tounixspec(contents, utarget, NULL) == NULL) {
/* This should not fail, as an untranslatable filename */
@@ -14044,7 +14087,7 @@
utarget = (char *)contents;
}
sts = symlink(utarget, link_name);
- Safefree(utarget);
+ PerlMem_free(utarget);
return sts;
}
@@ -14277,8 +14320,7 @@
static char *
-mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf,
- int *utf8_fl)
+do_vms_realpath(const char *filespec, char *outbuf, int *utf8_fl)
{
char * rslt = NULL;
@@ -14446,8 +14488,7 @@
}
static char *
-mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf,
- int *utf8_fl)
+do_vms_realname(const char *filespec, char *outbuf, int *utf8_fl)
{
char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec;
int sts, v_len, r_len, d_len, n_len, e_len, vs_len;
@@ -14504,10 +14545,10 @@
/*}}}*/
/* External entry points */
-char *Perl_vms_realpath(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
+char *Perl_vms_realpath(const char *filespec, char *outbuf, int *utf8_fl)
{ return do_vms_realpath(filespec, outbuf, utf8_fl); }
-char *Perl_vms_realname(pTHX_ const char *filespec, char *outbuf, int *utf8_fl)
+char *Perl_vms_realname(const char *filespec, char *outbuf, int *utf8_fl)
{ return do_vms_realname(filespec, outbuf, utf8_fl); }
/* case_tolerant */
