It still will probably need a modified spec.pm.
With these changes, and then built with:
$ @'build_disk'['root']configure.com -"Dunlink_all_versions" "-de"
The resulting perl on 7.3-2 will pass all tests without any DECC feature logicals set.
As I stated, I do not think I am up to modifying the perl scripts to make them follow the intent of the DECC feature logicals.
The next test will be building GTK+
-John [EMAIL PROTECTED] Personal Opinion Only
--- configure.com_old Sun Apr 11 21:58:27 2004
+++ configure.com Sat Apr 24 22:31:30 2004
@@ -44,6 +44,7 @@
$ user_c_flags = ""
$ use_ieee_math = "y"
$ be_case_sensitive = "n"
+$ unlink_all_versions = "n"
$ use_vmsdebug_perl = "n"
$ use64bitall = "n"
$ use64bitint = "n"
@@ -880,7 +881,7 @@
$ config_symbols1
="|installprivlib|installscript|installsitearch|installsitelib|most|oldarchlib|oldarchlibexp|osname|pager|perl_symbol|perl_verb|"
$ config_symbols2
="|prefix|privlib|privlibexp|scriptdir|sitearch|sitearchexp|sitebin|sitelib|sitelib_stem|sitelibexp|try_cxx|use64bitall|use64bitint|"
$ config_symbols3
="|usecasesensitive|usedefaulttypes|usedevel|useieee|useithreads|usemultiplicity|usemymalloc|usedebugging_perl|useperlio|usesecurelog|"
-$ config_symbols4 ="|usethreads|usevmsdebug|usefaststdio|usemallocwrap|"
+$ config_symbols4
="|usethreads|usevmsdebug|usefaststdio|usemallocwrap|unlink_all_versions|"
$!
$ open/read CONFIG 'config_sh'
$ rd_conf_loop:
@@ -2442,6 +2443,27 @@
$ use_ieee_math = "n"
$ ENDIF
$ useieee = "undef"
+$! Unlink all versions?
+$ echo ""
+$ echo "By default apparently Perl will only unlink (delete) the latest"
+$ echo "version of a file. This option builds PERL to delete all versions"
+$ echo "of a file"
+$ echo ""
+$ echo "If you have no idea what this means, and do not have"
+$ echo "any program requiring anything, choose the default."
+$ bool_dflt = unlink_all_versions
+$ if f$type(unlink_all_versions) .nes. ""
+$ then
+$ if unlink_all_versions .or. unlink_all_versions .eqs. "define"
+$ then
+$ bool_dflt="y"
+$ else
+$ bool_dflt="n"
+$ endif
+$ endif
+$ rp = "Build with unlink_all_versions? [''bool_dflt'] "
+$ GOSUB myread
+$ unlink_all_versions = ans
$ usecasesensitive = "undef"
$ if (use_ieee_math) then useieee = "define"
$ if (be_case_sensitive) then usecasesensitive = "define"
@@ -2912,6 +2934,12 @@
$ ELSE
$ d_vms_be_case_sensitive = "undef"
$ ENDIF
+$ IF unlink_all_versions
+$ THEN
+$ d_unlink_all_versions = "define"
+$ ELSE
+$ d_unlink_all_versions = "undef"
+$ ENDIF
$! Some constant defaults.
$ hwname = f$getsyi("HW_NAME")
$ myname = myhostname
@@ -6154,6 +6182,7 @@
$ IF use64bitall .OR. use64bitall .EQS. "define" THEN -
WC "#define USE_64_BIT_ALL"
$ IF be_case_sensitive THEN WC "#define VMS_WE_ARE_CASE_SENSITIVE"
+$ IF d_unlink_all_versions then wc "#define UNLINK_ALL_VERSIONS"
$ IF d_herrno .EQS. "undef" THEN WC "#define NEED_AN_H_ERRNO"
$ WC "#define HAS_ENVGETENV"
$ WC "#define PERL_EXTERNAL_GLOB"
@@ -6165,6 +6194,10 @@
$! WC "#define PERL_IGNORE_FPUSIG SIGFPE"
$ ENDIF
$ IF kill_by_sigprc .EQS. "define" then WC "#define KILL_BY_SIGPRC"
+$ if unlink_all_versions
+$ then
+$ WC "#define unlink_all_versions"
+$ endif
$ CLOSE CONFIG
$!
$ echo4 "Doing variable substitutions on .SH files..."
--- vms/vmsish.h_old Sun Apr 11 21:55:17 2004 +++ vms/vmsish.h Sat Apr 24 23:14:49 2004 @@ -2,6 +2,7 @@ * * VMS-specific C header file for perl5. * + * Hacks by J. Malmberg for testing. * Last revised: 16-Sep-1998 by Charles Bailey [EMAIL PROTECTED] * Version: 5.5.2 */ @@ -214,7 +215,14 @@ #define init_os_extras Perl_init_os_extras /* Delete if at all possible, changing protections if necessary. */ +#ifndef UNLINK_ALL_VERSIONS #define unlink kill_file +#else +#if __CRTL_VER < 70000000 +/* No unlink this early */ +#define unlink kill_file +#endif +#endif /* * Intercept calls to fork, so we know whether subsequent calls to @@ -330,7 +338,11 @@ #define PERL_SOCK_SYSWRITE_IS_SEND #endif +#if __CRTL_VER < 70000000 #define BIT_BUCKET "_NLA0:" +#else +#define BIT_BUCKET "/dev/null" +#endif #define PERL_SYS_INIT(c,v) MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); MALLOC_INIT #define PERL_SYS_TERM() OP_REFCNT_TERM; MALLOC_TERM #define dXSUB_SYS
--- vms/vms.c_old Sun Apr 11 21:54:18 2004
+++ vms/vms.c Sun May 9 23:31:18 2004
@@ -3,6 +3,8 @@
* VMS-specific routines for perl5
* Version: 5.7.0
*
+ * April 2004 Add LIB$INITIALIZE section so DECC feature logicals will
+ * not change behavior unintentionally.
* August 2000 tweaks to vms_image_init, my_flush, my_fwrite, cando_by_name,
* and Perl_cando by Craig Berry
* 29-Aug-2000 Charles Lane's piping improvements rolled in
@@ -42,6 +44,13 @@
#include <uaidef.h>
#include <uicdef.h>
+#if __CRTL_VER < 70301000 && __CRTL_VER >= 70300000
+int decc$feature_get_index(const char *name);
+char* decc$feature_get_name(int index);
+int decc$feature_get_value(int index, int mode);
+int decc$feature_set_value(int index, int mode, int value);
+#endif
+
/* Older versions of ssdef.h don't have these */
#ifndef SS$_INVFILFOROP
# define SS$_INVFILFOROP 3930
@@ -85,12 +94,24 @@
dEXT int h_errno;
#endif
+#ifdef __DECC
+#pragma message disable pragma
+#pragma member_alignment save
+#pragma nomember_alignment longword
+#pragma message save
+#pragma message disable misalgndmem
+#endif
struct itmlst_3 {
unsigned short int buflen;
unsigned short int itmcode;
void *bufadr;
unsigned short int *retlen;
};
+#ifdef __DECC
+#pragma message restore
+#pragma member_alignment restore
+#endif
+
#define do_fileify_dirspec(a,b,c) mp_do_fileify_dirspec(aTHX_ a,b,c)
#define do_pathify_dirspec(a,b,c) mp_do_pathify_dirspec(aTHX_ a,b,c)
@@ -137,6 +158,13 @@
static int tz_updated = 1;
#endif
+/* DECC Features that may need to affect how Perl interprets
+ * displays filename information
+ */
+static int decc_filename_unix_report = 0;
+static int decc_efs_case_preserve = 0;
+static int decc_filename_unix_only = 0;
+
/* my_maxidx
* Routine to retrieve the maximum equivalence index for an input
* logical name. Some calls to this routine have no knowledge if
@@ -388,7 +416,10 @@
for (cp1 = (char *) lnm, cp2 = eqv; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
if (cp1 - lnm == 7 && !strncmp(eqv,"DEFAULT",7)) {
- getcwd(eqv,LNM$C_NAMLENGTH);
+ if (decc_filename_unix_only || decc_filename_unix_report)
+ getcwd(eqv,LNM$C_NAMLENGTH, 1);
+ else
+ getcwd(eqv,LNM$C_NAMLENGTH);
return eqv;
}
else {
@@ -2984,7 +3015,17 @@
if (ts) out = New(1319,outbuf,NAM$C_MAXRSS+1,char);
else outbuf = __rmsexpand_retbuf;
}
- if ((isunix = (strchr(filespec,'/') != NULL))) {
+
+ isunix = strchr(filespec,'/') != NULL;
+ /* If the user wants UNIX files, "." needs to be treated as in UNIX */
+ if (!isunix) {
+ if (decc_filename_unix_report || decc_filename_unix_only) {
+ if (strcmp(filespec,".") == 0)
+ isunix = 1;
+ }
+ }
+
+ if (isunix) {
if (do_tovmsspec(filespec,vmsfspec,0) == NULL) return NULL;
filespec = vmsfspec;
}
@@ -3080,7 +3121,7 @@
!(mynam.nam$l_fnb & NAM$M_EXP_NAME))
speclen = mynam.nam$l_name - out;
out[speclen] = '\0';
- if (haslower) __mystrtolower(out);
+ if (haslower && !decc_efs_case_preserve) __mystrtolower(out);
/* Have we been working with an expanded, but not resultant, spec? */
/* Also, convert back to Unix syntax if necessary. */
@@ -3458,7 +3499,7 @@
/* $PARSE may have upcased filespec, so convert output to lower
* case if input contained any lowercase characters. */
- if (haslower) __mystrtolower(retspec);
+ if (haslower && !decc_efs_case_preserve) __mystrtolower(retspec);
return retspec;
}
} /* end of do_fileify_dirspec() */
@@ -4383,9 +4424,12 @@
* Be consistent with what the C RTL has already done to the rest of
* the argv items and lowercase all of these names.
*/
- for (c = string; *c; ++c)
- if (isupper(*c))
- *c = tolower(*c);
+ if (!decc_efs_case_preserve)
+ {
+ for (c = string; *c; ++c)
+ if (isupper(*c))
+ *c = tolower(*c);
+ }
if (isunix) trim_unixpath(string,item,1);
add_item(head, tail, string, count);
++expcount;
@@ -5037,10 +5081,16 @@
}
dd->count++;
/* Force the buffer to end with a NUL, and downcase name to match C convention. */
- buff[sizeof buff - 1] = '\0';
- for (p = buff; *p; p++) *p = _tolower(*p);
- while (--p >= buff) if (!isspace(*p)) break; /* Do we really need this? */
- *p = '\0';
+ if (!decc_efs_case_preserve) {
+ buff[sizeof buff - 1] = '\0';
+ for (p = buff; *p; p++) *p = _tolower(*p);
+ while (--p >= buff) if (!isspace(*p)) break; /* Do we really need this? */
+ *p = '\0';
+ }
+ else {
+ /* we don't want to force to lowercase, just null terminate */
+ buff[res.dsc$w_length] = '\0';
+ }
/* Skip any directory component and just copy the name. */
if ((p = strchr(buff, ']'))) (void)strcpy(dd->entry.d_name, p + 1);
@@ -7529,4 +7579,193 @@
return;
}
+ /* Start of DECC RTL Feature handling */
+
+static int sys_trnlnm
+ (const char * logname,
+ char * value,
+ int value_len)
+{
+ const $DESCRIPTOR(table_dsc, "LNM$FILE_DEV");
+ const unsigned long attr = LNM$M_CASE_BLIND;
+ struct dsc$descriptor_s name_dsc;
+ int status;
+ unsigned short result;
+ struct itmlst_3 itlst[2] = {{value_len, LNM$_STRING, value, &result},
+ {0, 0, 0, 0}};
+
+ name_dsc.dsc$w_length = value_len;
+ name_dsc.dsc$a_pointer = value;
+ name_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+ name_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+ status = sys$trnlnm(&attr, &table_dsc, &name_dsc, 0, itlst);
+
+ if ($VMS_STATUS_SUCCESS(status)) {
+
+ /* Null terminate and return the string */
+ /*--------------------------------------*/
+ value[result] = 0;
+ }
+
+ return status;
+}
+
+static int sys_crelnm
+ (const char * logname,
+ const char * value)
+{
+ int ret_val;
+ const char * proc_table = "LNM$PROCESS_TABLE";
+ struct dsc$descriptor_s proc_table_dsc;
+ struct dsc$descriptor_s logname_dsc;
+ struct itmlst_3 item_list[2];
+
+ proc_table_dsc.dsc$a_pointer = (char *) proc_table;
+ proc_table_dsc.dsc$w_length = strlen(proc_table);
+ proc_table_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+ proc_table_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+ logname_dsc.dsc$a_pointer = (char *) logname;
+ logname_dsc.dsc$w_length = strlen(logname);
+ logname_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
+ logname_dsc.dsc$b_class = DSC$K_CLASS_S;
+
+ item_list[0].buflen = strlen(value);
+ item_list[0].itmcode = LNM$_STRING;
+ item_list[0].bufadr = (char *)value;
+ item_list[0].retlen = NULL;
+
+ item_list[1].buflen = 0;
+ item_list[1].itmcode = 0;
+
+ ret_val = sys$crelnm
+ (NULL,
+ (const struct dsc$descriptor_s *)&proc_table_dsc,
+ (const struct dsc$descriptor_s *)&logname_dsc,
+ NULL,
+ (const struct item_list_3 *) item_list);
+
+ return ret_val;
+}
+
+#ifndef __VAX
+#if __CRTL_VER >= 70300000
+
+static int set_feature_default(const char *name, int value)
+{
+ int status;
+ int index;
+
+ index = decc$feature_get_index(name);
+
+ status = decc$feature_set_value(index, 1, value);
+ if (index == -1 || (status == -1)) {
+ return -1;
+ }
+
+ status = decc$feature_get_value(index, 1);
+ if (status != value) {
+ return -1;
+ }
+
+ return 0;
+}
+#endif
+#endif
+
+/* C RTL Feature settings */
+
+static int set_features
+ (int (* init_coroutine)(int *, int *, void *), /* Needs casts if used */
+ int (* cli_routine)(void), /* Not documented */
+ void *image_info) /* Not documented */
+{
+ int status;
+ int s;
+ char* str;
+ char val_str[10];
+
+#ifndef __VAX
+#if __CRTL_VER >= 70300000
+ s = decc$feature_get_index("DECC$EFS_CASE_PRESERVE");
+ decc_efs_case_preserve = decc$feature_get_value(s, 1);
+
+ s = decc$feature_get_index("DECC$FILENAME_UNIX_REPORT");
+ decc_filename_unix_report = decc$feature_get_value(s, 1);
+ set_feature_default("DECC$FILENAME_UNIX_REPORT", FALSE);
+
+ s = decc$feature_get_index("DECC$FILENAME_UNIX_ONLY");
+ decc_filename_unix_only = decc$feature_get_value(s, 1);
+ set_feature_default("DECC$FILENAME_UNIX_ONLY", FALSE);
+#else
+ status = sys_trnlnm("DECC$EFS_CASE_PRESERVE", val_str, sizeof(val_str));
+ if (status) {
+ _toupper(str[0])
+ if ((str[0] == 'E') || (str[0] == 1) || (str[0] == 'T')) {
+ decc_efs_case_preserve = 1;
+ }
+ }
+ status = sys_trnlnm("DECC$FILENAME_UNIX_REPORT", val_str, sizeof(val_str));
+ if (status) {
+ _toupper(str[0])
+ if ((str[0] == 'E') || (str[0] == 1) || (str[0] == 'T')) {
+ decc_filename_unix_report = 1;
+ status = sys_crelnm("DECC$FILENAME_UNIX_REPORT", "DISABLE");
+ }
+ }
+ status = sys_trnlnm("DECC$FILENAME_UNIX_ONLY", val_str, sizeof(val_str));
+ if (status) {
+ _toupper(str[0])
+ if ((str[0] == 'E') || (str[0] == 1) || (str[0] == 'T')) {
+ decc_filename_unix_only = 1;
+ status = sys_crelnm("DECC$FILENAME_UNIX_ONLY", "DISABLE");
+ }
+ }
+#endif
+#endif
+
+
+ /* CRTL can be initialized past this point, but not before. */
+/* DECC$CRTL_INIT(); */
+
+ return SS$_NORMAL;
+}
+
+#ifdef __DECC
+/* DECC dependent attributes */
+#if __DECC_VER < 60560002
+#define relative
+#define not_executable
+#else
+#define relative ,rel
+#define not_executable ,noexe
+#endif
+#pragma nostandard
+#pragma extern_model save
+#pragma extern_model strict_refdef "LIB$INITIALIZ" nowrt
+#endif
+ const __align (LONGWORD) int spare[8] = {0};
+/* .psect LIB$INITIALIZE, NOPIC, USR, CON, REL, GBL, NOSHR, NOEXE, RD, */
+/* NOWRT, LONG */
+#ifdef __DECC
+#pragma extern_model strict_refdef "LIB$INITIALIZE" con, gbl,noshr, \
+ nowrt,noshr relative not_executable
+#endif
+const long vms_cc_features = (const long)set_features;
+
+/*
+** Force a reference to LIB$INITIALIZE to ensure it
+** exists in the image.
+*/
+int lib$initialize(void);
+#ifdef __DECC
+#pragma extern_model strict_refdef
+#endif
+ int lib_init_ref = (int) lib$initialize;
+
+#ifdef __DECC
+#pragma extern_model restore
+#pragma standard
+#endif
/* End of vms.c */
