I was giving a set of patches that were used for the last build, and Craig has also given me a patch that addressed some more issues.
I have since found that the GNV BASH does not apparently modify the DECC feature logicals, so any issues with them and Perl are externally introduced.
The essential issue is that if the following logical names are defined, Perl needs to behave slightly differently than it does now.
* Case needs to be preserved. Currently Perl always lowercases filenames if any mixed case is found.
I had one unconditional patch to do this well enough for a custom version of Perl to work. Craig Berry has provided a run-time conditional patch for some other points. I am doing a build with the two features merged.
Craig points out that if Perl becomes unconditionally case preserving, it breaks the build of it self. So this should be noted as a build condition.
As I understand it, neither Craig or I know if that catches all the instances where Perl is forcing things to lower case.
* All input filespecs need to be interpreted as UNIX format This implies that "." needs to be interpreted as the current directory.
So far I have not found anything to suggest that any UNIX file names that could be mistaken for VMS filenames will be present.
The patch seems to be two things. First to tread "." as a UNIX filespecificaiton, and using the DECC$FEATURE to Perl disable the CRTL from from interpreting the feature setting that says to interpret all filenames as UNIX. The second is probably something that Perl needs anyway to prevent it from being externally victimized.
It also appears a patch was also made to change the definition of BIT_BUCKET from _NLA0: to be "/dev/null". It appears that this patch may not be needed, as the use in PERL is limited to a function that for modern versions of the CRTL treat them the same. As long as PERL does not follow any settings that force filenames to be treated as UNIX format.
* Output file specifications need to be displayed in UNIX format. This is something that I do not have a conditional patch for. The Perl module CWD.PM needs to return the current path in UNIX format.
* Apparently Perl must lie to the script so that the script thinks that it is running under UNIX. This is done in spec.pm I do not have a conditional patch for this one either.
* The patch wants to use the CRTL unlink() function instead of kill_all. I do not know why. It also wants the "unlink_all_versions" defined. I have modified locally the configure.com procedure to allow specifying unlink_all_versions on a special build to do this.
I would think it is better to have this as a run-time option so separate binaries were not needed.
In doing this, I have discovered two things.
1. Gdiff on VMS can not handle it if it does not have write access to the files it is doing a diff on. It exists with an improperly signaled condition.
2. The contents of the config.sh file are mostly ignored.
With the attached patches, the test phase of the perl build fails the following tests.
lib/ExtUtils/t/basic.................FAILED at test 28 lib/ExtUtils/t/zz_cleanup_dummy......FAILED at test 1 lib/File/Temp/t/tempfile.............FAILED at test 14 Failed 3 test scripts out of 775, 99.61% okay.
My guess is that it is a result of the unlink/unlink_all_versions issue.
With the above tests, I have not patched the *.pm modules.
The configure.com script was invoked with:
$ @DIST_ROOT:[000000]configure.com -"Dunlink_all_versions" "-de"
If it is not obvious, I know almost nothing of perl or troubleshooting it, so any assistance to get a standard release of perl to be used for GTK+ would be useful.
As far as I know, what I have now could be usable to build GTK+, but I would prefer to be able to pass all the standard tests with the Perl binaries produced.
Thanks, -John [EMAIL PROTECTED] Personal Opinion Only
--- dist_root:[000000]configure.com Sun Apr 11 20:45:43 2004
+++ dist_root:[000000]configure.com_old Sun Apr 11 21:58:27 2004
@@ -44,7 +44,6 @@
$ user_c_flags = ""
$ use_ieee_math = "y"
$ be_case_sensitive = "n"
-$ unlink_all_versions = "n"
$ use_vmsdebug_perl = "n"
$ use64bitall = "n"
$ use64bitint = "n"
@@ -881,7 +880,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|unlink_all_versions|"
+$ config_symbols4 ="|usethreads|usevmsdebug|usefaststdio|usemallocwrap|"
$!
$ open/read CONFIG 'config_sh'
$ rd_conf_loop:
@@ -2443,27 +2442,6 @@
$ 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"
@@ -2934,12 +2912,6 @@
$ 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
@@ -6182,7 +6154,6 @@
$ 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 ulink_all_versions"
$ IF d_herrno .EQS. "undef" THEN WC "#define NEED_AN_H_ERRNO"
$ WC "#define HAS_ENVGETENV"
$ WC "#define PERL_EXTERNAL_GLOB"
@@ -6194,10 +6165,6 @@
$! 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..."
--- dist_root:[vms]vmsish.h Sun Apr 11 20:32:50 2004 +++ dist_root:[vms]vmsish.h_old Sun Apr 11 21:55:17 2004 @@ -2,7 +2,6 @@ * * 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 */ @@ -215,9 +214,7 @@ #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 -#endif /* * Intercept calls to fork, so we know whether subsequent calls to @@ -333,11 +330,7 @@ #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
--- dist_root:[vms]vms.c Sun Apr 11 20:19:14 2004
+++ dist_root:[vms]vms.c_old Sun Apr 11 21:54:18 2004
@@ -3,8 +3,6 @@
* 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
@@ -44,13 +42,6 @@
#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
@@ -94,24 +85,12 @@
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)
@@ -158,13 +137,6 @@
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
@@ -3012,17 +2984,7 @@
if (ts) out = New(1319,outbuf,NAM$C_MAXRSS+1,char);
else outbuf = __rmsexpand_retbuf;
}
-
- 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 ((isunix = (strchr(filespec,'/') != NULL))) {
if (do_tovmsspec(filespec,vmsfspec,0) == NULL) return NULL;
filespec = vmsfspec;
}
@@ -3118,7 +3080,7 @@
!(mynam.nam$l_fnb & NAM$M_EXP_NAME))
speclen = mynam.nam$l_name - out;
out[speclen] = '\0';
- if (haslower && !decc_efs_case_preserve) __mystrtolower(out);
+ if (haslower) __mystrtolower(out);
/* Have we been working with an expanded, but not resultant, spec? */
/* Also, convert back to Unix syntax if necessary. */
@@ -3496,7 +3458,7 @@
/* $PARSE may have upcased filespec, so convert output to lower
* case if input contained any lowercase characters. */
- if (haslower && !decc_efs_case_preserve) __mystrtolower(retspec);
+ if (haslower) __mystrtolower(retspec);
return retspec;
}
} /* end of do_fileify_dirspec() */
@@ -4422,10 +4384,8 @@
* the argv items and lowercase all of these names.
*/
for (c = string; *c; ++c)
- if (!decc_efs_case_preserve) {
if (isupper(*c))
*c = tolower(*c);
- }
if (isunix) trim_unixpath(string,item,1);
add_item(head, tail, string, count);
++expcount;
@@ -5077,16 +5037,10 @@
}
dd->count++;
/* Force the buffer to end with a NUL, and downcase name to match C convention. */
- 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';
- }
+ 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';
/* Skip any directory component and just copy the name. */
if ((p = strchr(buff, ']'))) (void)strcpy(dd->entry.d_name, p + 1);
@@ -7575,193 +7529,4 @@
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", "ENABLE");
- }
- }
-#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 */
