Change 31404 by [EMAIL PROTECTED] on 2007/06/17 14:48:11
Patches to compile perl on Cray XT4 Catamount/Qk, by Jarkko
Affected files ...
... //depot/perl/Configure#661 edit
... //depot/perl/MANIFEST#1586 edit
... //depot/perl/Makefile.SH#384 edit
... //depot/perl/doio.c#359 edit
... //depot/perl/ext/util/make_ext#18 edit
... //depot/perl/hints/catamount.sh#1 add
... //depot/perl/hints/linux.sh#65 edit
... //depot/perl/lib/ExtUtils/MM_Unix.pm#222 edit
... //depot/perl/perl.c#814 edit
... //depot/perl/perl.h#784 edit
... //depot/perl/pp_sys.c#541 edit
... //depot/perl/sv.c#1413 edit
... //depot/perl/util.c#630 edit
Differences ...
==== //depot/perl/Configure#661 (xtext) ====
Index: perl/Configure
--- perl/Configure#660~31395~ 2007-06-15 22:56:15.000000000 -0700
+++ perl/Configure 2007-06-17 07:48:11.000000000 -0700
@@ -20707,7 +20707,7 @@
INLINE_INTRINSICS INTRINSICS INT64 interdata is68k ksr1
LANGUAGE_C LARGE_FILE_API LARGEFILE64_SOURCE
LARGEFILE_SOURCE LFS64_LARGEFILE LFS_LARGEFILE
-Linux LITTLE_ENDIAN LONG64 LONG_DOUBLE LONG_LONG
+LIBCATAMOUNT Linux LITTLE_ENDIAN LONG64 LONG_DOUBLE LONG_LONG
LONGDOUBLE LONGLONG LP64 luna luna88k Lynx
M68000 m68k m88100 m88k M88KBCS_TARGET M_COFF
M_I186 M_I286 M_I386 M_I8086 M_I86 M_I86SM M_SYS3
@@ -20726,7 +20726,7 @@
pc532 pdp11 PGC PIC plexus PORTAR posix
POSIX1B_SOURCE POSIX2_SOURCE POSIX4_SOURCE
POSIX_C_SOURCE POSIX_SOURCE POWER
-PROTOTYPES PWB pyr QNX R3000 REENTRANT RES Rhapsody RISC6000
+PROTOTYPES PWB pyr QNX QK_USER R3000 REENTRANT RES Rhapsody RISC6000
riscix riscos RT S390 SA110 scs SCO sequent sgi SGI_SOURCE SH3 sinix
SIZE_INT SIZE_LONG SIZE_PTR SOCKET_SOURCE SOCKETS_SOURCE
sony sony_news sonyrisc sparc sparclite spectrum
==== //depot/perl/MANIFEST#1586 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1585~31401~ 2007-06-17 05:51:30.000000000 -0700
+++ perl/MANIFEST 2007-06-17 07:48:11.000000000 -0700
@@ -1289,6 +1289,7 @@
hints/beos.sh Hints for named architecture
hints/broken-db.msg Warning message for systems with broken DB
library
hints/bsdos.sh Hints for named architecture
+hints/catamount.sh Hints for named architecture
hints/convexos.sh Hints for named architecture
hints/cxux.sh Hints for named architecture
hints/cygwin.sh Hints for named architecture
==== //depot/perl/Makefile.SH#384 (text) ====
Index: perl/Makefile.SH
--- perl/Makefile.SH#383~31388~ 2007-06-15 04:17:50.000000000 -0700
+++ perl/Makefile.SH 2007-06-17 07:48:11.000000000 -0700
@@ -479,7 +479,7 @@
globals\$(OBJ_EXT): uudmap.h
uudmap.h: generate_uudmap\$(EXE_EXT)
- ./generate_uudmap\$(EXE_EXT) >uudmap.h
+ \$(RUN) ./generate_uudmap\$(EXE_EXT) >uudmap.h
generate_uudmap\$(EXE_EXT): generate_uudmap\$(OBJ_EXT)
\$(CC) -o generate_uudmap \$(LDFLAGS) generate_uudmap\$(OBJ_EXT)
\$(libs)
==== //depot/perl/doio.c#359 (text) ====
Index: perl/doio.c
--- perl/doio.c#358~31112~ 2007-05-01 08:32:15.000000000 -0700
+++ perl/doio.c 2007-06-17 07:48:11.000000000 -0700
@@ -1380,7 +1380,7 @@
int fd, int do_report)
{
dVAR;
-#if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__)
+#if defined(MACOS_TRADITIONAL) || defined(__SYMBIAN32__) ||
defined(__LIBCATAMOUNT__)
Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system");
#else
if (sp > mark) {
==== //depot/perl/ext/util/make_ext#18 (text) ====
Index: perl/ext/util/make_ext
--- perl/ext/util/make_ext#17~31396~ 2007-06-15 23:10:19.000000000 -0700
+++ perl/ext/util/make_ext 2007-06-17 07:48:11.000000000 -0700
@@ -82,6 +82,13 @@
fi
+case "$osname" in
+catamount) # Snowball's chance to build extensions.
+ echo "This is $osname, not building $mname, sorry."
+ exit 0
+ ;;
+esac
+
echo " Making $mname ($target)"
cd ext/$pname
==== //depot/perl/hints/catamount.sh#1 (text) ====
Index: perl/hints/catamount.sh
--- /dev/null 2007-03-19 09:41:43.516454971 -0700
+++ perl/hints/catamount.sh 2007-06-17 07:48:11.000000000 -0700
@@ -0,0 +1,351 @@
+#
+# Hints for the Cray XT4 Catamount/Qk system:
+# cross-compilation host is a SuSE x86_64-linux,
+# execution at the target with the 'yod' utility,
+# linux.sh will run this hints file when necessary.
+#
+# cc.sh: compiles the code with the cross-compiler, patches main/exit/_exit
+# (and traps signals) to be wrappers that echo the exit code.
+#
+# run.sh: runs the executable with yod and collects the exit status,
+# and exits with that status.
+#
+# You probably should do the compilation in non-Lustre filesystem
+# because Lustre does not support all the POSIX system calls, which may
+# cause weird errors during the Perl build:
+# 1182003549.604836:3-24:(super.c:1516:llu_iop_fcntl()): unsupported fcntl cmd
2
+#
+# As of 2007-Jun (pre-5.9.5) miniperl and libperl.a can be successfully built;
+# building any extensions would be hard since Perl cannot run anything
+# external (which breaks MakeMaker, and confuses ext/util/make_ext).
+#
+# To build libperl.a (which also gets miniperl built):
+#
+# sh Configure -des -Dusedevel
+# make libperl.a
+#
+# The -Dusedevel is required for Perl 5.9, it is not required for Perl 5.10
+# sources, once they come out. You will need to have the run.sh execution
+# wrapper around (it gets created in the Perl build directory) if you want to
+# run the miniperl in the XT4. It collects the exit status (note that yod
+# is run with "-sz 1", so only one instance is run), and possible crash status.
+# For example:
+#
+# sh run.sh ./miniperl -le 'print 42'
+#
+
+case "$prefix" in
+'') prefix=/opt/perl-catamount ;;
+esac
+cat >&4 <<__EOF1__
+***
+*** You seem to be compiling in Linux for the Catamount/Qk environment.
+*** I'm therefore not going to install perl as /usr/bin/perl.
+*** Perl will be installed under $prefix.
+***
+__EOF1__
+
+archname='x86_64-catamount'
+archobjs='cata.o'
+d_mmap='undef'
+d_setlocale='undef' # There is setlocale() but no locales.
+d_vprintf='define'
+hintfile='catamount'
+i_arpainet='undef'
+i_db='undef'
+i_netdb='undef'
+i_niin='undef'
+incpth=' '
+installusrbinperl='undef'
+libswanted="m crypt c"
+libpth=' '
+locincpth=''
+onlyextensions='Fcntl' # Not that we can build this, really.
+osname='catamount'
+procselfexe='undef'
+usedl='undef'
+useithreads='undef'
+uselargefiles='define'
+usenm='undef'
+usethreads='undef'
+use64bitall='define'
+
+BUILD=$PWD
+
+case "`yod -Version 2>&1`" in
+Red*) ;; # E.g. "Red Storm Protocol Release 2.1.0"
+*) echo >&4 "Could not find 'yod', aborting."
+ exit 1 ;;
+esac
+run=$BUILD/run.sh
+cat > $run <<'__EOF2__'
+#!/bin/sh
+#
+# $run
+#
+yod -sz 1 "$@" 2> .yod$$e > .yod$$o
+status=`awk '/^cata: exe .* pid [0-9][0-9]* (main|exit|_exit) [0-9][0-9]*$/
{print $NF}' .yod$$o|tail -1`
+grep -v "sz is 1" .yod$$e
+grep -v "^cata: exe .* pid [0-9][0-9]* " .yod$$o
+grep "^cata: exe .* signal " .yod$$o
+rm -f .yod$$o .yod$$e
+exit $status
+__EOF2__
+chmod 755 $run
+case "`cc -V 2>&1`" in
+*catamount*) ;; # E.g. "/opt/xt-pe/1.5.41/bin/snos64/cc: INFO: catamount
target is being used"
+*) echo "Could not find 'cc' for catamount, aborting."
+ exit 1 ;;
+esac
+
+cc=$BUILD/cc.sh
+cat > $cc <<__EOF3a__
+#!/bin/sh
+#
+# $0
+#
+# This is essentially a frontend driver for the Catamount cc.
+# We arrange for (1) the main(), exit(), _exit() being wrapped (cpp-defined)
+# catamain(), cataexit(), and _cataexit() (2) the actual main() etc. are in
+# cata.c, and cata.o is linked in when needed (3) signals being caught
+# All this mostly for being able to catch the exit status (or crash cause).
+#
+argv=''
+srco=''
+srct=''
+exe=''
+defs='-Dmain=catamain -Dexit=cataexit -D_exit=_cataexit'
+argv=''
+BUILD=/wrk/jhi/[EMAIL PROTECTED]
+__EOF3a__
+cat >> $cc <<'__EOF3b__'
+case "$1" in
+--cata_o) ;;
+*) if test ! -f cata.o
+ then
+ if test ! -f cata.c
+ then
+ if test -f ../cata.c # If compiling in UU during Configure.
+ then
+ cp ../cata.c cata.c
+ cp ../cata.h cata.h
+ fi
+ fi
+ $0 --cata_o -c cata.c || exit 1
+ fi
+ ;;
+esac
+while test $# -ne 0
+do
+ i=$1
+ shift
+ case "$i" in
+ --cata_o) ;;
+ *.c)
+ argv="$argv $defs"
+ defs=""
+ if test ! -f $i
+ then
+ echo "$0: $i: No such file or directory"
+ exit 1
+ fi
+ j=$i$$.c
+ rm -f $j
+ if grep -q -s '#include "cata.h"' $i
+ then
+ :
+ else
+ cat >>$j<<__EOF4__
+#include "cata.h"
+# 1 "$i"
+__EOF4__
+ fi
+ cat $i >>$j
+ if grep -q -s 'int main()' $i
+ then
+ argv="$argv -Dmain0"
+ else
+ if grep -q -s 'int main([^,]*,[^,]*)' $i
+ then
+ argv="$argv -Dmain2"
+ else
+ if grep -q -s 'int main([^,]*,[^,]*,[^,]*)' $i
+ then
+ argv="$argv -Dmain3"
+ fi
+ fi
+ fi
+ argv="$argv $j"
+ srct="$j"
+ srco="$i"
+ ;;
+ *.o)
+ if test ! -f "$i"
+ then
+ c=$(echo $i|sed 's/\.o$/.c/')
+ $0 -c $c || exit 1
+ fi
+ argv="$argv $i"
+ ;;
+ -o)
+ exe="$1"
+ argv="$argv -o $exe -Dargv0=$exe"
+ shift
+ ;;
+ *)
+ argv="$argv $i"
+ ;;
+ esac
+done
+case "$exe" in
+'') ;;
+*) case "$argv" in
+ *cata.o*) ;;
+ *) argv="$argv cata.o" ;;
+ esac
+ ;;
+esac
+cc -I$BUILD $argv 2> .cc$$e > .cc$$o
+status=$?
+egrep -v 'catamount target|'$$'\.c:$' .cc$$e 1>&2
+case "`grep "is not implemented" .cc$$e`" in
+*"will always fail"*) status=1 ;;
+esac
+cat .cc$$o
+rm -f .cc$$o
+case "$status" in
+0) rm -f .cc$$e $srct
+ ;;
+esac
+objt=`echo $srct|sed -e 's/\.c$/.o/'`
+objo=`echo $srco|sed -e 's/\.c$/.o/'`
+if test -n "$objt" -a -f "$objt"
+then
+ mv -f $objt $objo
+fi
+exit $status
+__EOF3b__
+chmod 755 $cc
+
+cat >cata.h<<__EOF6__
+#ifndef CATA_H
+#define CATA_H
+void cataexit(int status);
+void _cataexit(int status);
+void catasigsetup();
+void catasighandle(int signum);
+#ifdef main0
+int catamain();
+#else
+#ifdef main2
+int main(int argc, char **argv);
+#else
+int main(int argc, char **argv, char **env);
+#endif
+#endif
+#endif
+__EOF6__
+
+cat >cata.c<<__EOF7__
+#include <stdio.h>
+#include <signal.h>
+#undef printf
+#undef main
+#undef exit
+#undef _exit
+#include "cata.h"
+#ifndef STRINGIFY
+#define STRINGIFY(a) #a
+#endif
+#ifdef argv0
+#define ARGV0 STRINGIFY(argv0)
+#else
+static char* argv0;
+#define ARGV0 argv0
+#endif
+void cataexit(int status) {
+ printf("cata: exe %s pid %d exit %d\n", ARGV0, getpid(), status);
+ exit(status);
+}
+void _cataexit(int status) {
+ printf("cata: exe %s pid %d _exit %d\n", ARGV0, getpid(), status);
+ _exit(status);
+}
+void catasighandle(int signum) {
+ int core = 0;
+ printf("cata: exe %s pid %d signal %d\n", ARGV0, getpid(), signum);
+ switch (signum) {
+ case SIGQUIT:
+ case SIGILL:
+ case SIGTRAP:
+ case SIGABRT:
+ case SIGBUS:
+ case SIGSEGV:
+ case SIGXCPU:
+ case SIGXFSZ:
+ core = 0200;
+ break;
+ default:
+ break;
+ }
+ cataexit(core << 8 | signum);
+}
+void catasigsetup() {
+ signal(SIGHUP, catasighandle);
+ signal(SIGINT, catasighandle);
+ signal(SIGQUIT, catasighandle);
+ signal(SIGILL, catasighandle);
+ signal(SIGTRAP, catasighandle);
+ signal(SIGABRT, catasighandle);
+ signal(SIGIOT, catasighandle);
+ /* KILL */
+ signal(SIGBUS, catasighandle);
+ signal(SIGFPE, catasighandle);
+ signal(SIGUSR1, catasighandle);
+ signal(SIGUSR2, catasighandle);
+ signal(SIGSEGV, catasighandle);
+ signal(SIGPIPE, catasighandle);
+ signal(SIGALRM, catasighandle);
+ signal(SIGTERM, catasighandle);
+ signal(SIGSTKFLT, catasighandle);
+ signal(SIGCHLD, catasighandle);
+ signal(SIGCONT, catasighandle);
+ /* STOP */
+ signal(SIGTSTP, catasighandle);
+ signal(SIGTTIN, catasighandle);
+ signal(SIGTTOU, catasighandle);
+ signal(SIGURG, catasighandle);
+ signal(SIGXCPU, catasighandle);
+ signal(SIGXFSZ, catasighandle);
+ signal(SIGVTALRM, catasighandle);
+ signal(SIGPROF, catasighandle);
+ signal(SIGWINCH, catasighandle);
+ signal(SIGIO, catasighandle);
+ signal(SIGPWR, catasighandle);
+ signal(SIGSYS, catasighandle);
+}
+int main(int argc, char *argv[], char *envv[]) {
+ int status;
+#ifndef argv0
+ argv0 = argv[0];
+#endif
+ catasigsetup();
+ status =
+#ifdef main0
+ catamain();
+#else
+#ifdef main2
+ catamain(argc, argv);
+#else
+ catamain(argc, argv, envv);
+#endif
+#endif
+ printf("cata: exe %s pid %d main %d\n", ARGV0, getpid(), status);
+ return status;
+}
+__EOF7__
+
+echo "Faking DynaLoader"
+touch DynaLoader.o # Oh, the agony.
+
+# That's it.
==== //depot/perl/hints/linux.sh#65 (text) ====
Index: perl/hints/linux.sh
--- perl/hints/linux.sh#64~30758~ 2007-03-26 03:09:21.000000000 -0700
+++ perl/hints/linux.sh 2007-06-17 07:48:11.000000000 -0700
@@ -32,7 +32,15 @@
# libgdbmg1-dev (development version of GNU libc 2-linked GDBM library)
# So make sure that for any libraries you wish to link Perl with under
# Debian or Red Hat you have the -dev packages installed.
-#
+
+# SuSE Linux can be used as cross-compilation host for Cray XT4 Catamount/Qk.
+if test -d /opt/xt-pe
+then
+ case "`cc -V 2>&1`" in
+ *catamount*) . hints/catamount.sh; return ;;
+ esac
+fi
+
# Some operating systems (e.g., Solaris 2.6) will link to a versioned shared
# library implicitly. For example, on Solaris, `ld foo.o -lgdbm' will find an
# appropriate version of libgdbm, if one is available; Linux, however, doesn't
==== //depot/perl/lib/ExtUtils/MM_Unix.pm#222 (text) ====
Index: perl/lib/ExtUtils/MM_Unix.pm
--- perl/lib/ExtUtils/MM_Unix.pm#221~31245~ 2007-05-20 16:10:15.000000000
-0700
+++ perl/lib/ExtUtils/MM_Unix.pm 2007-06-17 07:48:11.000000000 -0700
@@ -18,7 +18,7 @@
use ExtUtils::MakeMaker qw($Verbose neatvalue);
-$VERSION = '1.52_03';
+$VERSION = '1.52_04';
require ExtUtils::MM_Any;
@ISA = qw(ExtUtils::MM_Any);
@@ -1028,6 +1028,10 @@
print "Executing $abs\n" if ($trace >= 2);
my $version_check = qq{$abs -le "require $ver; print qq{VER_OK}"};
+
+ if (defined $Config{run}) {
+ $version_check = "$Config{run} $version_check";
+ }
# To avoid using the unportable 2>&1 to suppress STDERR,
# we close it before running the command.
# However, thanks to a thread library bug in many BSDs
==== //depot/perl/perl.c#814 (text) ====
Index: perl/perl.c
--- perl/perl.c#813~31333~ 2007-06-05 03:10:33.000000000 -0700
+++ perl/perl.c 2007-06-17 07:48:11.000000000 -0700
@@ -3709,7 +3709,47 @@
*rsfpp = PerlIO_stdin();
}
else {
+#ifdef FAKE_BIT_BUCKET
+ /* This hack allows one not to have /dev/null (or BIT_BUCKET as it
+ * is called) and still have the "-e" work. (Believe it or not,
+ * a /dev/null is required for the "-e" to work because source
+ * filter magic is used to implement it. ) This is *not* a general
+ * replacement for a /dev/null. What we do here is create a temp
+ * file (an empty file), open up that as the script, and then
+ * immediately close and unlink it. Close enough for jazz. */
+#define FAKE_BIT_BUCKET_PREFIX "/tmp/perlnull-"
+#define FAKE_BIT_BUCKET_SUFFIX "XXXXXXXX"
+#define FAKE_BIT_BUCKET_TEMPLATE FAKE_BIT_BUCKET_PREFIX FAKE_BIT_BUCKET_SUFFIX
+ char tmpname[sizeof(FAKE_BIT_BUCKET_TEMPLATE)] = {
+ FAKE_BIT_BUCKET_TEMPLATE
+ };
+ const char * const err = "Failed to create a fake bit bucket";
+ if (strEQ(scriptname, BIT_BUCKET)) {
+#ifdef HAS_MKSTEMP /* Hopefully mkstemp() is safe here. */
+ int tmpfd = mkstemp(tmpname);
+ if (tmpfd > -1) {
+ scriptname = tmpname;
+ close(tmpfd);
+ } else
+ Perl_croak(aTHX_ err);
+#else
+# ifdef HAS_MKTEMP
+ scriptname = mktemp(tmpname);
+ if (!scriptname)
+ Perl_croak(aTHX_ err);
+# endif
+#endif
+ }
+#endif
*rsfpp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
+#ifdef FAKE_BIT_BUCKET
+ if (memEQ(scriptname, FAKE_BIT_BUCKET_PREFIX,
+ sizeof(FAKE_BIT_BUCKET_PREFIX) - 1)
+ && strlen(scriptname) == sizeof(tmpname) - 1) {
+ unlink(scriptname);
+ }
+ scriptname = BIT_BUCKET;
+#endif
# if defined(HAS_FCNTL) && defined(F_SETFD)
if (*rsfpp)
/* ensure close-on-exec */
==== //depot/perl/perl.h#784 (text) ====
Index: perl/perl.h
--- perl/perl.h#783~31341~ 2007-06-06 07:42:01.000000000 -0700
+++ perl/perl.h 2007-06-17 07:48:11.000000000 -0700
@@ -675,6 +675,11 @@
EXTERN_C int usleep(unsigned int);
#endif
+/* Funky places that do not have socket stuff. */
+#if defined(__LIBCATAMOUNT__)
+# define MYSWAP
+#endif
+
#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
# define MYSWAP
#endif
@@ -3270,6 +3275,12 @@
# include "iperlsys.h"
#endif
+#ifdef __LIBCATAMOUNT__
+#undef HAS_PASSWD /* unixish.h but not unixish enough. */
+#undef HAS_GROUP
+#define FAKE_BIT_BUCKET
+#endif
+
/* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
* Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
* defined by Configure, despite their names being similar to the
==== //depot/perl/pp_sys.c#541 (text) ====
Index: perl/pp_sys.c
--- perl/pp_sys.c#540~31348~ 2007-06-07 05:12:39.000000000 -0700
+++ perl/pp_sys.c 2007-06-17 07:48:11.000000000 -0700
@@ -4008,7 +4008,7 @@
PP(pp_wait)
{
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) &&
!defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) &&
!defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
dVAR; dSP; dTARGET;
Pid_t childpid;
int argflags;
@@ -4036,7 +4036,7 @@
PP(pp_waitpid)
{
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) &&
!defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) &&
!defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
dVAR; dSP; dTARGET;
const int optype = POPi;
const Pid_t pid = TOPi;
@@ -4067,6 +4067,11 @@
PP(pp_system)
{
dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+#if defined(__LIBCATAMOUNT__)
+ PL_statusvalue = -1;
+ SP = ORIGMARK;
+ XPUSHi(-1);
+#else
I32 value;
int result;
@@ -4190,7 +4195,8 @@
do_execfree();
SP = ORIGMARK;
XPUSHi(result ? value : STATUS_CURRENT);
-#endif /* !FORK or VMS */
+#endif /* !FORK or VMS or OS/2 */
+#endif
RETURN;
}
==== //depot/perl/sv.c#1413 (text) ====
Index: perl/sv.c
--- perl/sv.c#1412~31388~ 2007-06-15 04:17:50.000000000 -0700
+++ perl/sv.c 2007-06-17 07:48:11.000000000 -0700
@@ -467,7 +467,8 @@
SvOBJECT(GvSV(sv))) ||
(GvAV(sv) && SvOBJECT(GvAV(sv))) ||
(GvHV(sv) && SvOBJECT(GvHV(sv))) ||
- (GvIO(sv) && GvIOp(sv) && SvOBJECT(GvIO(sv))) || /* In certain
rare cases GvIOP(sv) can be NULL, which would make SvOBJECT(GvIO(sv))
dereference NULL. */
+ /* In certain rare cases GvIOp(sv) can be NULL, which would make
SvOBJECT(GvIO(sv)) dereference NULL. */
+ (GvIO(sv) ? (SvFLAGS(GvIOp(sv)) & SVs_OBJECT) : 0) ||
(GvCV(sv) && SvOBJECT(GvCV(sv))) )
{
DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob
object:\n "), sv_dump(sv)));
==== //depot/perl/util.c#630 (text) ====
Index: perl/util.c
--- perl/util.c#629~31388~ 2007-06-15 04:17:50.000000000 -0700
+++ perl/util.c 2007-06-17 07:48:11.000000000 -0700
@@ -2216,7 +2216,7 @@
PerlIO *
Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
{
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) &&
!defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) &&
!defined(MACOS_TRADITIONAL) && !defined(NETWARE)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) &&
!defined(OS2) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) &&
!defined(MACOS_TRADITIONAL) && !defined(NETWARE) && !defined(__LIBCATAMOUNT__)
dVAR;
int p[2];
register I32 This, that;
@@ -2352,7 +2352,7 @@
}
/* VMS' my_popen() is in VMS.c, same with OS/2. */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) &&
!defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) &&
!defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) &&
!defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) &&
!defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
PerlIO *
Perl_my_popen(pTHX_ const char *cmd, const char *mode)
{
@@ -2533,6 +2533,14 @@
*/
return PerlIO_importFILE(djgpp_popen(cmd, mode), 0);
}
+#else
+#if defined(__LIBCATAMOUNT__)
+PerlIO *
+Perl_my_popen(pTHX_ const char *cmd, const char *mode)
+{
+ return NULL;
+}
+#endif
#endif
#endif
@@ -2795,7 +2803,7 @@
#endif /* !PERL_MICRO */
/* VMS' my_pclose() is in VMS.c; same with OS/2 */
-#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) &&
!defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) &&
!defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) &&
!defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) &&
!defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
@@ -2850,9 +2858,17 @@
}
return(pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status));
}
+#else
+#if defined(__LIBCATAMOUNT__)
+I32
+Perl_my_pclose(pTHX_ PerlIO *ptr)
+{
+ return -1;
+}
+#endif
#endif /* !DOSISH */
-#if (!defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(NETWARE))
&& !defined(MACOS_TRADITIONAL)
+#if (!defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(NETWARE))
&& !defined(MACOS_TRADITIONAL) && !defined(__LIBCATAMOUNT__)
I32
Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
{
End of Patch.
