This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
authorNick Ing-Simmons <nik@tiuk.ti.com>
Sat, 3 Nov 2001 11:42:15 +0000 (11:42 +0000)
committerNick Ing-Simmons <nik@tiuk.ti.com>
Sat, 3 Nov 2001 11:42:15 +0000 (11:42 +0000)
p4raw-id: //depot/perlio@12831

13 files changed:
doio.c
ext/DynaLoader/dl_mac.xs
ext/Errno/Errno_pm.PL
ext/Sys/Syslog/Makefile.PL
ext/Sys/Syslog/syslog.t
hints/beos.sh
hints/darwin.sh
perl.c
perl.h
perlio.c
regexec.c
sv.c
t/test.pl

diff --git a/doio.c b/doio.c
index 462c884..47a5af6 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -495,6 +495,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
            (void)PerlIO_close(fp);
            goto say_false;
        }
+#ifndef PERL_MICRO
        if (S_ISSOCK(PL_statbuf.st_mode))
            IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */
 #ifdef HAS_SOCKET
@@ -515,6 +516,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
                IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */
                                /* but some return 0 for streams too, sigh */
        }
+#endif /* !PERL_MICRO */
 #endif
     }
     if (saveifp) {             /* must use old fp? */
index dd1ddfa..6c624e7 100644 (file)
@@ -34,9 +34,8 @@ typedef struct {
 
 #define dl_connections (dl_cxtx.x_connections)
 
-static void terminate(void)
+static void terminate(pTHX_ void *ptr)
 {
-    dTHX;
     dMY_CXT;
     int size = GetHandleSize((Handle) dl_connections) / sizeof(ConnectionID);
     HLock((Handle) dl_connections);
@@ -79,7 +78,7 @@ dl_load_file(filename, flags=0)
        dMY_CXT;
        if (!dl_connections) {
            dl_connections = (ConnectionID **)NewHandle(0);
-           atexit(terminate);
+           call_atexit(terminate, (void*)0);
        }
         PtrAndHand((Ptr) &connID, (Handle) dl_connections, sizeof(ConnectionID));
        RETVAL = connID;
index 58b440b..541106c 100644 (file)
@@ -30,7 +30,7 @@ sub process_file {
     } elsif ($Config{gccversion} ne ''
              # OpenSTEP has gcc 2.7.2.1 which recognizes but
             # doesn't implement the -dM flag.
-            && $^O ne 'openstep' && $^O ne 'next'
+            && $^O ne 'openstep' && $^O ne 'next' && $^O ne 'darwin'
             ) { 
        # With the -dM option, gcc outputs every #define it finds
        unless(open(FH,"$Config{cc} -E -dM $Config{cppflags} $file |")) {
index d9f4e65..1de0148 100644 (file)
@@ -8,6 +8,14 @@ WriteMakefile(
     XSPROTOARG          => '-noprototypes',
     realclean => {FILES=> 'constants.c constants.xs'},
 );
+
+# We hope syslogd understands /dev/log.
+#
+# Solaris has a -c /dev/log, but the syslog.t #1 and #2 don't
+# seem to be happy if that's _PATH_LOG.
+#
+my $_PATH_LOG = -S "/dev/log" ? "/dev/log" : "";
+
 WriteConstants(
     NAME => 'Sys::Syslog',
     NAMES => [qw(LOG_ALERT LOG_AUTH LOG_AUTHPRIV LOG_CONS LOG_CRIT LOG_CRON
@@ -17,6 +25,6 @@ WriteConstants(
                  LOG_MAIL LOG_NDELAY LOG_NEWS LOG_NFACILITIES LOG_NOTICE
                  LOG_NOWAIT LOG_ODELAY LOG_PERROR LOG_PID LOG_PRIMASK LOG_SYSLOG
                  LOG_USER LOG_UUCP LOG_WARNING),
-              {name=>"_PATH_LOG", type=>"PV", default=>["PV", '""']},
+              {name=>"_PATH_LOG", type=>"PV", default=>["PV",qq("$_PATH_LOG")]},
              ],
 );
index 77aff13..108d7e8 100755 (executable)
@@ -25,7 +25,7 @@ BEGIN {
 BEGIN {
   eval {require Sys::Syslog} or do {
     if ($@ =~ /Your vendor has not/) {
-      print "1..0 # Skipped: missing macros\n";
+      print "1..0 # Skip: missing macros\n";
       exit 0;
     }
   }
@@ -43,32 +43,32 @@ print "1..6\n";
 
 if (Sys::Syslog::_PATH_LOG()) {
     if (-e Sys::Syslog::_PATH_LOG()) {
-        print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1\n";
-        print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 2\n" : "not ok 2\n";
-        print defined(eval { syslog('info', $test_string ) }) ? "ok 3\n" : "not ok 3\n";
+        print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1 # $!\n";
+        print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 2\n" : "not ok 2 # $!\n";
+        print defined(eval { syslog('info', $test_string ) }) ? "ok 3\n" : "not ok 3 # $!\n";
     }
     else {
         for (1..3) {
             print
-                "ok $_ # skipping, file ",
+                "ok $_ # Skip: file ",
                 Sys::Syslog::_PATH_LOG(),
                 " does not exist\n";
         }
     }
 }
 else {
-    for (1..3) { print "ok $_ # skipping, _PATH_LOG unavailable\n" }
+    for (1..3) { print "ok $_ # Skip: _PATH_LOG unavailable\n" }
 }
 
 if( $Test_Syslog_INET ) {
     print defined(eval { setlogsock('inet') }) ? "ok 4\n" 
                                                : "not ok 4\n";
     print defined(eval { openlog('perl', 'ndelay', 'local0') }) ? "ok 5\n" 
-                                                                : "not ok 5\n";
+                                                                : "not ok 5 # $!\n";
     print defined(eval { syslog('info', $test_string ) }) ? "ok 6\n" 
-                                                   : "not ok 6\n";
+                                                   : "not ok 6 # $!\n";
 }
 else {
-    print "ok $_ # skipped(assuming syslog doesn't accept inet connections)\n" 
+    print "ok $_ # Skip: assuming syslog doesn't accept inet connections\n" 
       foreach (4..6);
 }
index 34a5eb8..e1d3b2d 100644 (file)
@@ -54,3 +54,7 @@ export PATH="$PATH:$PWD/beos"
 case "$ldlibpthname" in
 '') ldlibpthname=LIBRARY_PATH ;;
 esac
+
+case "$csh" in
+'') csh='bash' ;;
+esac
index 61940f3..d5e27a5 100644 (file)
@@ -78,8 +78,9 @@ ccflags="${ccflags} -pipe -fno-common"
 #
 ccflags="${ccflags} -DINT32_MIN_BROKEN -DINT64_MIN_BROKEN"
 
-# cpp-precomp is problematic.
-cppflags='-traditional-cpp';
+# cppflags='-traditional-cpp';
+# avoid Apple's cpp precompiler, better for extensions
+cppflags="${cppflags} -no-cpp-precomp"
 
 # Shared library extension is .dylib.
 # Bundle extension is .bundle.
diff --git a/perl.c b/perl.c
index 73212c0..ee55c91 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -21,7 +21,7 @@
 #include <unistd.h>
 #endif
 
-#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE)
+#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE) && !defined(PERL_MICRO)
 char *getenv (char *); /* Usually in <stdlib.h> */
 #endif
 
diff --git a/perl.h b/perl.h
index 12a9342..1fbffac 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -413,11 +413,11 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   include <unistd.h>
 #endif
 
-#if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO)
+#if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) && !defined(PERL_MICRO)
 int syscall(int, ...);
 #endif
 
-#if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO)
+#if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) && !defined(PERL_MICRO)
 int usleep(unsigned int);
 #endif
 
@@ -803,7 +803,7 @@ int sockatmark(int);
  * in the face of half-implementations.)
  */
 
-#ifdef I_SYSMODE
+#if defined(I_SYSMODE) && !defined(PERL_MICRO)
 #include <sys/mode.h>
 #endif
 
@@ -1285,7 +1285,7 @@ typedef NVTYPE NV;
 #    define Perl_fp_class_zero(x)      (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO)
 #endif
 
-#if !defined(Perl_fp_class) && defined(HAS_FP_CLASS)
+#if !defined(Perl_fp_class) && defined(HAS_FP_CLASS) && !defined(PERL_MICRO)
 #    include <math.h>
 #    if !defined(FP_SNAN) && defined(I_FP_CLASS)
 #        include <fp_class.h>
@@ -4012,4 +4012,24 @@ extern void moncontrol(int);
 #include "wince.h"
 #endif
 
+/* ISO 6429 NEL - C1 control NExt Line */
+/* See http://www.unicode.org/unicode/reports/tr13/ */
+#ifdef EBCDIC  /* In EBCDIC NEL is just an alias for LF */
+#   if '^' == 95       /* CP 1047: MVS OpenEdition - OS/390 - z/OS */
+#       define NEXT_LINE_CHAR  0x15
+#   else               /* CDRA */
+#       define NEXT_LINE_CHAR  0x25
+#   endif
+#else
+#   define NEXT_LINE_CHAR      0x85
+#endif
+
+/* The UTF-8 bytes of the Unicode LS and PS, U+2028 and U+2029 */
+#define UNICODE_LINE_SEPA_0    0xE2
+#define UNICODE_LINE_SEPA_1    0x80
+#define UNICODE_LINE_SEPA_2    0xA8
+#define UNICODE_PARA_SEPA_0    0xE2
+#define UNICODE_PARA_SEPA_1    0x80
+#define UNICODE_PARA_SEPA_2    0xA9
+
 #endif /* Include guard */
index c960a03..f102600 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -175,6 +175,7 @@ PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 PerlIO *
 PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
 {
+#ifndef PERL_MICRO
     if (f) {
        int fd = PerlLIO_dup(PerlIO_fileno(f));
        if (fd >= 0) {
@@ -189,6 +190,7 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
     else {
        SETERRNO(EBADF, SS$_IVCHAN);
     }
+#endif
     return NULL;
 }
 
index a7a9a67..67e9015 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2254,7 +2254,7 @@ S_regmatch(pTHX_ regnode *prog)
                    if (l >= PL_regeol)
                        sayNO;
                    toLOWER_utf8((U8*)l, tmpbuf, &ulen);
-                   if (memNE(s, tmpbuf, ulen))
+                   if (memNE(s, (char*)tmpbuf, ulen))
                        sayNO;
                    s += UTF8SKIP(s);
                    l += ulen;
@@ -2528,7 +2528,7 @@ S_regmatch(pTHX_ regnode *prog)
                            sayNO;
                        toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
                        toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
-                       if (ulen1 != ulen2 || memNE(tmpbuf1, tmpbuf2, ulen1))
+                       if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
                            sayNO;
                        s += ulen1;
                        l += ulen2;
diff --git a/sv.c b/sv.c
index 2da1291..74c3450 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3004,8 +3004,15 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                default:        s = "UNKNOWN";                  break;
                }
                tsv = NEWSV(0,0);
-               if (SvOBJECT(sv))
-                   Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
+               if (SvOBJECT(sv)) {
+                    HV *svs = SvSTASH(sv);
+                   Perl_sv_setpvf(
+                        aTHX_ tsv, "%s=%s",
+                        /* [20011101.072] This bandaid for C<package;>
+                           should eventually be removed. AMS 20011103 */
+                        (svs ? HvNAME(svs) : "<none>"), s
+                    );
+                }
                else
                    sv_setpv(tsv, s);
                Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv));
@@ -6942,8 +6949,12 @@ Returns a string describing what the SV is a reference to.
 char *
 Perl_sv_reftype(pTHX_ SV *sv, int ob)
 {
-    if (ob && SvOBJECT(sv))
-       return HvNAME(SvSTASH(sv));
+    if (ob && SvOBJECT(sv)) {
+        HV *svs = SvSTASH(sv);
+        /* [20011101.072] This bandaid for C<package;> should eventually
+           be removed. AMS 20011103 */
+        return (svs ? HvNAME(svs) : "<none>");
+    }
     else {
        switch (SvTYPE(sv)) {
        case SVt_NULL:
index 029d80f..46d0656 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -46,6 +46,8 @@ sub _ok {
        print "# Failed $where\n";
     }
     $test++;
+
+    return $pass;
 }
 
 sub _where {
@@ -58,15 +60,6 @@ sub ok {
     _ok($pass, _where(), @mess);
 }
 
-sub _expect {
-    my ($got, $pass, @mess) = @_;
-    if ($pass) {
-       ok(1, @mess);
-    } else {
-       ok(0, @mess);
-    }
-} 
-
 sub is {
     my ($got, $expected, @mess) = @_;
     my $pass = $got eq $expected;
@@ -75,7 +68,7 @@ sub is {
                "#      got '$got'\n",
                "# expected '$expected'\n");
     }
-    _expect($pass, _where(), @mess);
+    _ok($pass, _where(), @mess);
 }
 
 # Note: this isn't quite as fancy as Test::More::like().
@@ -96,7 +89,7 @@ sub like {
                    "# expected /$expected/\n");
        }
     }
-    _expect($pass, _where(), @mess);
+    _ok($pass, _where(), @mess);
 }
 
 sub pass {
@@ -133,7 +126,7 @@ sub require_ok {
     eval <<REQUIRE_OK;
 require $require;
 REQUIRE_OK
-    ok(!$@, "require $require");
+    _ok(!$@, _where(), "require $require");
 }
 
 sub use_ok {
@@ -141,7 +134,7 @@ sub use_ok {
     eval <<USE_OK;
 use $use;
 USE_OK
-    ok(!$@, "use $use");
+    _ok(!$@, _where(), "use $use");
 }
 
 1;