This gets [EMAIL PROTECTED] building again on VMS, though with quite a few
as-yet-uninvestigated test failures. Here's what the patch addresses:
In doio.c, the arguments to tovmsspec and tovmspath are not const.
In perly.c, SvPVX_const returns "const char *" not "const char **" as
the target of a couple of assignments expects. (broken in #24523)
xsubpp, when processing ext/DynaLoader/dl_vms.xs, now uses
ExtUtils::ParseXS, which loads File::Spec, which loads VMS::Filespec,
which thus needs to be copied to lib/VMS earlier in the build.
__attribute__format__ tried to insinuate itself into the list of global
functions, but I shooed it back out again.
The arguments to the homegrown utime() are now const like everyone else's.
--- doio.c;-0 Fri May 20 04:53:31 2005
+++ doio.c Fri May 27 19:00:33 2005
@@ -2357,8 +2357,8 @@
if ((tmpfp = PerlIO_tmpfile()) != NULL) {
Stat_t st;
if (!PerlLIO_stat(SvPVX_const(tmpglob),&st) && S_ISDIR(st.st_mode))
- ok = ((wilddsc.dsc$a_pointer =
tovmspath(SvPVX_const(tmpglob),vmsspec)) != NULL);
- else ok = ((wilddsc.dsc$a_pointer =
tovmsspec(SvPVX_const(tmpglob),vmsspec)) != NULL);
+ ok = ((wilddsc.dsc$a_pointer =
tovmspath(SvPVX(tmpglob),vmsspec)) != NULL);
+ else ok = ((wilddsc.dsc$a_pointer =
tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
if (ok) wilddsc.dsc$w_length = (unsigned short int)
strlen(wilddsc.dsc$a_pointer);
for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++)
if (*cp == '?') *cp = '%'; /* VMS style single-char wildcard */
--- perly.c;-0 Fri May 20 22:25:40 2005
+++ perly.c Fri May 27 19:00:34 2005
@@ -322,7 +322,7 @@
#ifdef DEBUGGING
yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *));
SAVEFREESV(yyns_sv);
- yyns = SvPVX_const(yyns_sv);
+ yyns = (const char **) SvPVX(yyns_sv);
yynsp = yyns;
#endif
@@ -366,7 +366,7 @@
yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
#ifdef DEBUGGING
SvGROW(yyns_sv, yystacksize * sizeof(char *));
- yyns = SvPVX_const(yyns_sv);
+ yyns = (const char **) SvPVX(yyns_sv);
if (! yyns)
goto yyoverflowlab;
yynsp = yyns + yysize - 1;
--- vms/descrip_mms.template;-0 Thu Apr 21 11:05:32 2005
+++ vms/descrip_mms.template Sat May 28 12:02:02 2005
@@ -497,7 +497,7 @@
@ If F$Search("$(MMS$TARGET)").nes."" Then Delete/NoLog/NoConfirm
$(MMS$TARGET);*
@ Copy/NoConfirm _NLA0: $(MMS$TARGET)
-[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(ARCHDIR)Config.pm
[.lib.ExtUtils]XSSymSet.pm $(MINIPERL_EXE)
+[.ext.dynaloader]dl_vms.c : [.ext.dynaloader]dl_vms.xs $(ARCHDIR)Config.pm
[.lib.ExtUtils]XSSymSet.pm $(MINIPERL_EXE) [.lib.VMS]Filespec.pm
$(XSUBPP) $(MMS$SOURCE) >$(MMS$TARGET)
[.ext.dynaloader]dl_vms$(O) : [.ext.dynaloader]dl_vms.c
@@ -1575,7 +1575,7 @@
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
scope$(O) : scope.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
-sv$(O) : sv.c
+sv$(O) : sv.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
taint$(O) : taint.c $(h)
$(CC) $(CORECFLAGS) $(MMS$SOURCE)
--- vms/gen_shrfls.pl;-0 Sat Dec 20 14:27:26 2003
+++ vms/gen_shrfls.pl Sat May 28 16:10:27 2005
@@ -152,7 +152,7 @@
$line =~ s/\b(IV|Off_t|Size_t|SSize_t|void)\b//i;
if ( $line =~ /(\w+)\s*\(/ ) {
print "\troutine name is \\$1\\\n" if $debug > 1;
- if ($1 eq 'main' || $1 eq 'perl_init_ext') {
+ if ($1 eq 'main' || $1 eq 'perl_init_ext' || $1 eq
'__attribute__format__') {
print "\tskipped\n" if $debug > 1;
}
else { $fcns{$1}++ }
--- vms/vms.c;-0 Fri Mar 25 09:08:40 2005
+++ vms/vms.c Sat May 28 15:03:47 2005
@@ -6465,8 +6465,8 @@
*/
static const long int utime_baseadjust[2] = { 0x4beb4000, 0x7c9567 };
-/*{{{int my_utime(char *path, struct utimbuf *utimes)*/
-int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
+/*{{{int my_utime(const char *path, const struct utimbuf *utimes)*/
+int Perl_my_utime(pTHX_ const char *file, const struct utimbuf *utimes)
{
register int i;
long int bintime[2], len = 2, lowbit, unixtime,
@@ -6499,7 +6499,7 @@
set_vaxc_errno(LIB$_INVARG);
return -1;
}
- if (do_tovmsspec(file,vmsspec,0) == NULL) return -1;
+ if (do_tovmsspec((char *)file,vmsspec,0) == NULL) return -1;
if (utimes != NULL) {
/* Convert Unix time (seconds since 01-JAN-1970 00:00:00.00)
@@ -6721,7 +6721,7 @@
* subset of the applicable information.
*/
bool
-Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp)
+Perl_cando(pTHX_ Mode_t bit, Uid_t effective, const Stat_t *statbufp)
{
char fname_phdev[NAM$C_MAXRSS+1];
if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache);
--- vms/vmsish.h;-0 Fri Mar 25 09:08:40 2005
+++ vms/vmsish.h Sat May 28 11:54:34 2005
@@ -828,7 +828,7 @@
int Perl_my_kill (int, int);
void Perl_csighandler_init (void);
#endif
-int Perl_my_utime (pTHX_ char *, struct utimbuf *);
+int Perl_my_utime (pTHX_ const char *, const struct utimbuf *);
void Perl_vms_image_init (int *, char ***);
struct dirent * Perl_readdir (pTHX_ DIR *);
int Perl_readdir_r(pTHX_ DIR *, struct dirent *, struct dirent **);
