Version v5.7.1 Development release working toward v5.8
--------------
____________________________________________________________________________
+[ 11025] By: jhi on 2001/06/29 13:07:57
+ Log: Subject: Re: perl@10967, File::Find, and Cwd
+ From: Mike Guy <mjtg@cam.ac.uk>
+ Date: Fri, 29 Jun 2001 14:56:49 +0100
+ Message-Id: <E15FylN-0004LT-00@draco.cus.cam.ac.uk>
+ Branch: perl
+ ! lib/File/Find/taint.t
+____________________________________________________________________________
+[ 11024] By: jhi on 2001/06/29 12:39:23
+ Log: Update the sv_pvprintify() spec.
+ Branch: perl
+ ! pod/perltodo.pod
+____________________________________________________________________________
+[ 11023] By: jhi on 2001/06/29 12:33:33
+ Log: Known test failures update.
+ Branch: perl
+ ! pod/perl572delta.pod
+____________________________________________________________________________
+[ 11022] By: jhi on 2001/06/29 12:24:32
+ Log: Based on
+
+ Subject: [PATCH @11016] More );) fixes
+ From: Richard Soderberg <rs@crystalflame.net>
+ Date: Fri, 29 Jun 2001 04:09:24 -0700 (PDT)
+ Message-ID: <Pine.LNX.4.21.0106290408200.12037-100000@oregonnet.com>
+ Branch: perl
+ ! ext/Thread/Thread.xs ext/Thread/typemap
+____________________________________________________________________________
+[ 11021] By: jhi on 2001/06/29 12:21:51
+ Log: Subject: [PATCH @11016] Fixes compile errors in four files
+ From: Richard Soderberg <rs@crystalflame.net>
+ Date: Fri, 29 Jun 2001 03:35:11 -0700 (PDT)
+ Message-ID: <Pine.LNX.4.21.0106290333270.9768-100000@oregonnet.com>
+ Branch: perl
+ ! mg.c pp.c pp_hot.c util.c
+____________________________________________________________________________
+[ 11020] By: jhi on 2001/06/29 12:05:54
+ Log: AIX hints tweaking continues, from Merijn Brand.
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 11019] By: jhi on 2001/06/29 12:05:10
+ Log: HP-UX needs gccversion sooner, from Merijn Brand.
+ Branch: perl
+ ! hints/hpux.sh
+____________________________________________________________________________
+[ 11018] By: jhi on 2001/06/29 11:52:31
+ Log: Subject: [PATCH 5.6.1] OS/2 docs
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Fri, 29 Jun 2001 02:34:12 -0400
+ Message-ID: <20010629023412.A6033@math.ohio-state.edu>
+ Branch: perl
+ ! README.os2 os2/Changes
+____________________________________________________________________________
+[ 11017] By: nick on 2001/06/29 10:20:30
+ Log: Integrate mainline
+ Branch: perlio
+ +> (branch 37 files)
+ - ext/ODBM_File/sdbm.t
+ !> (integrate 211 files)
+____________________________________________________________________________
+[ 11016] By: jhi on 2001/06/29 03:38:56
+ Log: Bump up the VERSIONs of modules that have changed since 5.6.0,
+ the modules found using a script written by Larry Schatzer Jr.
+ Branch: perl
+ ! ext/IO/lib/IO/Dir.pm ext/IO/lib/IO/Handle.pm
+ ! ext/IO/lib/IO/Seekable.pm ext/IO/lib/IO/Select.pm
+ ! ext/IO/lib/IO/Socket/INET.pm ext/IO/lib/IO/Socket/UNIX.pm
+ ! ext/IPC/SysV/Msg.pm ext/IPC/SysV/Semaphore.pm
+ ! ext/IPC/SysV/SysV.pm ext/Opcode/Opcode.pm ext/Opcode/Safe.pm
+ ! ext/Thread/Thread.pm ext/attrs/attrs.pm ext/re/re.pm
+ ! lib/AutoSplit.pm lib/Benchmark.pm lib/CGI/Pretty.pm
+ ! lib/CPAN/Nox.pm lib/Exporter.pm lib/ExtUtils/Command.pm
+ ! lib/ExtUtils/MakeMaker.pm lib/ExtUtils/Packlist.pm
+ ! lib/File/Compare.pm lib/FileHandle.pm lib/Math/Complex.pm
+ ! lib/Math/Trig.pm lib/Pod/Html.pm lib/Symbol.pm
+ ! lib/Text/ParseWords.pm lib/Text/Soundex.pm lib/Text/Tabs.pm
+ ! lib/Tie/Array.pm lib/attributes.pm lib/autouse.pm lib/base.pm
+ ! lib/constant.pm lib/fields.pm lib/strict.pm
+____________________________________________________________________________
+[ 11015] By: jhi on 2001/06/29 02:55:58
+ Log: The latest JPL from the anoncvs.
+ Branch: perl
+ ! jpl/JNI/JNI.pm jpl/JNI/JNI.xs jpl/JNI/Makefile.PL
+____________________________________________________________________________
+[ 11014] By: jhi on 2001/06/29 02:16:55
+ Log: In EBCDIC assume UTF-EBCDIC, not UTF-8.
+ Branch: perl
+ ! t/op/pat.t
+____________________________________________________________________________
+[ 11013] By: jhi on 2001/06/28 23:14:53
+ Log: Worrying about insecure directories now is a bit too late.
+ Branch: perl
+ ! lib/File/Find/taint.t
+____________________________________________________________________________
+[ 11012] By: jhi on 2001/06/28 21:36:36
+ Log: Cannot DIE() in a void function,
+ from Richard Hatch <rhatch@austin.ibm.com>.
+ Branch: perl
+ ! ext/IPC/SysV/SysV.xs
+____________________________________________________________________________
+[ 11011] By: jhi on 2001/06/28 19:32:13
+ Log: Subject: [PATCH: perl@11006] s/qdiv/div/ in Time::HiRes for VAX
+ From: Peter Prymmer <pvhp@forte.com>
+ Date: Thu, 28 Jun 2001 13:00:18 -0700 (PDT)
+ Message-ID: <Pine.OSF.4.10.10106281125220.508935-100000@aspara.forte.com>
+
+ (unfinished: time/hires tests 3, 5, 14 failing, but better
+ than wholesale failure)
+ Branch: perl
+ ! ext/Time/HiRes/HiRes.xs
+____________________________________________________________________________
+[ 11010] By: jhi on 2001/06/28 19:10:54
+ Log: Subject: [PATCH 5.6.1] OS/2 improvements
+ From: Ilya Zakharevich <ilya@math.ohio-state.edu>
+ Date: Thu, 28 Jun 2001 16:03:14 -0400
+ Message-ID: <20010628160314.A17906@math.ohio-state.edu>
+ Branch: perl
+ + os2/os2_base.t
+ ! MANIFEST hints/os2.sh makedef.pl os2/OS2/PrfDB/PrfDB.xs
+ ! os2/OS2/Process/Process.pm os2/OS2/Process/Process.xs
+ ! os2/OS2/REXX/REXX.xs os2/dl_os2.c os2/dlfcn.h os2/os2.c
+ ! os2/os2ish.h
+____________________________________________________________________________
+[ 11009] By: jhi on 2001/06/28 18:54:14
+ Log: Subject: Incrementing Extutils::Manifest's $VERSION
+ From: Michael G Schwern <schwern@pobox.com>
+ Date: Thu, 28 Jun 2001 13:13:49 -0400
+ Message-ID: <20010628131349.A14738@blackrider>
+ Branch: maint-5.6/perl
+ ! lib/ExtUtils/Manifest.pm
+____________________________________________________________________________
+[ 11008] By: jhi on 2001/06/28 18:52:20
+ Log: AIX tweak from Merijn Brand.
+ Branch: perl
+ ! hints/aix.sh
+____________________________________________________________________________
+[ 11007] By: jhi on 2001/06/28 17:46:27
+ Log: Create the macperl branch.
+ Branch: maint-5.6/macperl
+ +> (branch 1728 files)
+____________________________________________________________________________
+[ 11006] By: jhi on 2001/06/28 14:46:21
+ Log: Update Changes.
+ Branch: perl
+ ! Changes patchlevel.h
+____________________________________________________________________________
[ 11005] By: jhi on 2001/06/28 14:40:11
Log: More Perforce lore.
Branch: perl
# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Thu Jun 28 18:02:13 EET DST 2001 [metaconfig 3.0 PL70]
+# Generated on Fri Jun 29 17:44:53 EET DST 2001 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.org)
cat >c1$$ <<EOF
d_modfl="$undef"
fi
case "$osname:$gccversion" in
- aix:) $ccflags="$saveccflags" ;; # restore
+ aix:) ccflags="$saveccflags" ;; # restore
esac
;;
esac
ext/Encode/encode.h Encode extension
ext/Encode/Encode.pm Encode extension
ext/Encode/Encode.xs Encode extension
+ext/Encode/Encode/7bit-jis.enc Encoding tables
+ext/Encode/Encode/7bit-kana.enc Encoding tables
+ext/Encode/Encode/7bit-kr.enc Encoding tables
ext/Encode/Encode/ascii.enc Encoding tables
ext/Encode/Encode/ascii.ucm Encoding tables
ext/Encode/Encode/big5.enc Encoding tables
lib/AnyDBM_File.pm Perl module to emulate dbmopen
lib/AnyDBM_File.t See if AnyDBM_File works
lib/assert.pl assertion and panic with stack trace
-lib/Attribute/Handlers/Changes Attribute::Handlers
-lib/Attribute/Handlers/README Attribute::Handlers
lib/Attribute/Handlers.pm Attribute::Handlers
+lib/Attribute/Handlers/Changes Attribute::Handlers
lib/Attribute/Handlers/demo/demo.pl Attribute::Handlers demo
lib/Attribute/Handlers/demo/Demo.pm Attribute::Handlers demo
lib/Attribute/Handlers/demo/demo2.pl Attribute::Handlers demo
lib/Attribute/Handlers/demo/demo_rawdata.pl Attribute::Handlers demo
lib/Attribute/Handlers/demo/Descriptions.pm Attribute::Handlers demo
lib/Attribute/Handlers/demo/MyClass.pm Attribute::Handlers demo
+lib/Attribute/Handlers/README Attribute::Handlers
lib/Attribute/Handlers/test.pl See if Attribute::Handlers works
lib/attributes.pm For "sub foo : attrlist"
lib/AutoLoader.pm Autoloader base class
lib/Test/Harness.t See if Test::Harness works
lib/Test/More.pm More utilities for writing tests
lib/Test/More/Changes Test::More changes
-lib/Test/More/t/More.t Test::More test, basic operation
lib/Test/More/t/fail-like.t Test::More test, like() and qr// bug
lib/Test/More/t/fail.t Test::More test, failing tests
+lib/Test/More/t/More.t Test::More test, basic operation
lib/Test/More/t/plan_is_noplan.t Test::More test, noplan
lib/Test/More/t/skipall.t Test::More test, skipping all tests
lib/Test/Simple.pm Basic utility for writing tests
lib/Time/localtime.t Test for Time::localtime
lib/Time/tm.pm Internal object for Time::{gm,local}time
lib/timelocal.pl Perl library supporting inverse of localtime, gmtime
+lib/Unicode/UCD.pm Unicode character database
+lib/Unicode/UCD.t See if Unicode character database works
lib/unicode/ArabLink.pl Unicode character database
lib/unicode/ArabLnkGrp.pl Unicode character database
lib/unicode/ArabShap.txt Unicode character database
NetWare/nwpipe.h Netware port
NetWare/nwplglob.c Netware port
NetWare/nwplglob.h Netware port
+NetWare/nwstdio.h Netware port
NetWare/NWTInfo.c Netware port
NetWare/nwtinfo.h Netware port
NetWare/NWUtil.c Netware port
NetWare/nwutil.h Netware port
+NetWare/perlsdio.h Netware port
NetWare/t/NWModify.pl Netware port
NetWare/t/NWScripts.pl Netware port
NetWare/t/Readme.txt Netware port
os2/Makefile.SHs Shared library generation for OS/2
os2/os2.c Additional code for OS/2
os2/os2.sym Additional symbols to export
-os2/os2_base.t Additional tests for builtin methods
os2/OS2/ExtAttr/Changes EA access module
os2/OS2/ExtAttr/ExtAttr.pm EA access module
os2/OS2/ExtAttr/ExtAttr.xs EA access module
os2/os2add.sym Overriding symbols to export
os2/os2ish.h Header for OS/2
os2/os2thread.h pthread-like typedefs
+os2/os2_base.t Additional tests for builtin methods
os2/perl2cmd.pl Corrects installed binaries under OS/2
patchlevel.h The current patch level of perl
perl.c main()
t/pod/testpchk.pl Module to test Pod::Checker for a given file
t/pod/testpods/lib/Pod/Stuff.pm Sample data for find.t
t/README Instructions for regression tests
+t/run/exit.t Test perl's exit status.
t/run/runenv.t Test if perl honors its environment variables.
t/TEST The regression tester
t/TestInit.pm Preamble library for core tests
## This file is created by using the makefile that creates Windows Perl as the reference
## Author: sgp
## Date Created: 13th July 2000
-## Date Modified: 03th April 2001
+## Date Modified: 30th June 2001
# Name of the NLM
NLM_NAME = perl.nlm
xcopy /f /r /i /s /d *.t $(INST_NW_TOP2)\scripts\t\lib
cd ..\ext
xcopy /f /r /i /s /d *.t $(INST_NW_TOP2)\scripts\t\ext
- cd ..\netware
+ cd ..\netware\t
+ xcopy /f /r /i /s /d *.pl $(INST_NW_TOP2)\scripts\t
+ cd ..
nwinstall: utils installnw install_tests
d_strctcpy='define'
d_strerrm='strerror(e)'
d_strerror='define'
+d_strftime='define'
d_strtod='define'
d_strtol='define'
d_strtold='undef'
* This symbol, if defined, indicates that the strftime routine is
* available to do time formatting.
*/
-/*#define HAS_STRFTIME /**/
+#define HAS_STRFTIME /**/
/* HAS_SYSCALL_PROTO:
* This symbol, if defined, indicates that the system provides
==============================================================================================*/
EXTERN_C PerlInterpreter*
-perl_alloc_override(struct IPerlMem* ppMem, struct IPerlMem* ppMemShared,
- struct IPerlMem* ppMemParse, struct IPerlEnv* ppEnv,
- struct IPerlStdIO* ppStdIO, struct IPerlLIO* ppLIO,
- struct IPerlDir* ppDir, struct IPerlSock* ppSock,
- struct IPerlProc* ppProc)
+perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared,
+ struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv,
+ struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO,
+ struct IPerlDir** ppDir, struct IPerlSock** ppSock,
+ struct IPerlProc** ppProc)
{
PerlInterpreter *my_perl = NULL;
+ struct IPerlMem* lpMem;
+ struct IPerlEnv* lpEnv;
+ struct IPerlStdIO* lpStdio;
+ struct IPerlLIO* lpLIO;
+ struct IPerlDir* lpDir;
+ struct IPerlSock* lpSock;
+ struct IPerlProc* lpProc;
+
WCValHashTable<void*>* m_allocList;
m_allocList = new WCValHashTable<void*> (fnAllocListHash, 256);
fnInsertHashListAddrs(m_allocList, FALSE);
if (!ppMem)
- ppMem=&perlMem;
+ lpMem=&perlMem;
+ else
+ lpMem=*ppMem;
+
if (!ppEnv)
- ppEnv=&perlEnv;
+ lpEnv=&perlEnv;
+ else
+ lpEnv=*ppEnv;
+
if (!ppStdIO)
- ppStdIO=&perlStdIO;
+ lpStdio=&perlStdIO;
+ else
+ lpStdio=*ppStdIO;
+
if (!ppLIO)
- ppLIO=&perlLIO;
+ lpLIO=&perlLIO;
+ else
+ lpLIO=*ppLIO;
+
if (!ppDir)
- ppDir=&perlDir;
+ lpDir=&perlDir;
+ else
+ lpDir=*ppDir;
+
if (!ppSock)
- ppSock=&perlSock;
+ lpSock=&perlSock;
+ else
+ lpSock=*ppSock;
+
if (!ppProc)
- ppProc=&perlProc;
-
- my_perl = perl_alloc_using(ppMem,
- ppMemShared,
- ppMemParse,
- ppEnv,
- ppStdIO,
- ppLIO,
- ppDir,
- ppSock,
- ppProc);
+ lpProc=&perlProc;
+ else
+ lpProc=*ppProc;
+
+ my_perl = perl_alloc_using(lpMem,
+ NULL,
+ NULL,
+ lpEnv,
+ lpStdio,
+ lpLIO,
+ lpDir,
+ lpSock,
+ lpProc);
+
if (my_perl) {
#ifdef PERL_OBJECT
CPerlObj* pPerl = (CPerlObj*)my_perl;
* platform specific function
* Author : SGP
* Date Created : June 12th 2001.
- * Date Modified: June 26th 2001.
+ * Date Modified: June 30th 2001.
*/
#ifndef ___NWPerlSys_H___
#include "iperlsys.h"
+#include "nwstdio.h"
#include "nw5iop.h"
#include <fcntl.h>
--- /dev/null
+/*
+ * Copyright © 2001 Novell, Inc. All Rights Reserved.
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ */
+
+/*
+ * FILENAME : nwstdio.h
+ * DESCRIPTION : Making stdio calls go thro' the
+ * NetWare specific implementation.
+ * This gets included if PERLIO_IS_STDIO. Instead
+ * of directly calling stdio functions this goes
+ * thro' IPerlStdIO, this ensures that cgi2perl
+ * can call CGI functions and send the o/p to
+ * browser or console.
+ * Author : SGP
+ * Date Created : June 29th 2001.
+ * Date Modified: June 30th 2001.
+ */
+
+#ifndef ___NWStdio_H___
+#define ___NWStdio_H___
+
+#define PerlIO FILE
+
+#define PerlIO_putc(f,c) (*PL_StdIO->pPutc)(PL_StdIO, (f),(c))
+#define PerlIO_fileno(f) (*PL_StdIO->pFileno)(PL_StdIO, (f))
+#define PerlIO_close(f) (*PL_StdIO->pClose)(PL_StdIO, (f))
+#define PerlIO_stderr() (*PL_StdIO->pStderr)(PL_StdIO)
+#define PerlIO_printf Perl_fprintf_nocontext
+#define PerlIO_vprintf(f,fmt,a) (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a)
+#define PerlIO_flush(f) (*PL_StdIO->pFlush)(PL_StdIO, (f))
+#define PerlIO_stdout() (*PL_StdIO->pStdout)(PL_StdIO)
+#define PerlIO_stdin() (*PL_StdIO->pStdin)(PL_StdIO)
+#define PerlIO_clearerr(f) (*PL_StdIO->pClearerr)(PL_StdIO, (f))
+#define PerlIO_fdopen(f,s) (*PL_StdIO->pFdopen)(PL_StdIO, (f),(s))
+#define PerlIO_getc(f) (*PL_StdIO->pGetc)(PL_StdIO, (f))
+#define PerlIO_ungetc(f,c) (*PL_StdIO->pUngetc)(PL_StdIO, (c),(f))
+#define PerlIO_tell(f) (*PL_StdIO->pTell)(PL_StdIO, (f))
+#define PerlIO_seek(f,o,w) (*PL_StdIO->pSeek)(PL_StdIO, (f),(o),(w))
+#define PerlIO_error(f) (*PL_StdIO->pError)(PL_StdIO, (f))
+#define PerlIO_write(f,buf,size) (*PL_StdIO->pWrite)(PL_StdIO, (buf), (size),1, (f))
+#define PerlIO_puts(f,s) (*PL_StdIO->pPuts)(PL_StdIO, (f),(s))
+#define PerlIO_read(f,buf,size) (*PL_StdIO->pRead)(PL_StdIO, (buf), (size), 1, (f))
+#define PerlIO_eof(f) (*PL_StdIO->pEof)(PL_StdIO, (f))
+#define PerlIO_fdupopen(f) (*PL_StdIO->pFdupopen)(PL_StdIO, (f))
+#define PerlIO_reopen(p,m,f) (*PL_StdIO->pReopen)(PL_StdIO, (p), (m), (f))
+#define PerlIO_open(x,y) (*PL_StdIO->pOpen)(PL_StdIO, (x),(y))
+
+#ifdef HAS_SETLINEBUF
+#define PerlIO_setlinebuf(f) (*PL_StdIO->pSetlinebuf)(PL_StdIO, (f))
+#else
+#define PerlIO_setlinebuf(f) setvbuf(f, Nullch, _IOLBF, 0)
+#endif
+
+#define PerlIO_isutf8(f) 0
+
+#ifdef USE_STDIO_PTR
+#define PerlIO_has_cntptr(f) 1
+#define PerlIO_get_ptr(f) FILE_ptr(f)
+#define PerlIO_get_cnt(f) FILE_cnt(f)
+
+#ifdef STDIO_CNT_LVALUE
+#define PerlIO_canset_cnt(f) 1
+#define PerlIO_set_cnt(f,c) (FILE_cnt(f) = (c))
+#ifdef STDIO_PTR_LVALUE
+#ifdef STDIO_PTR_LVAL_NOCHANGE_CNT
+#define PerlIO_fast_gets(f) 1
+#endif
+#endif /* STDIO_PTR_LVALUE */
+#else /* STDIO_CNT_LVALUE */
+#define PerlIO_canset_cnt(f) 0
+#define PerlIO_set_cnt(f,c) abort()
+#endif
+
+#ifdef STDIO_PTR_LVALUE
+#ifdef STDIO_PTR_LVAL_NOCHANGE_CNT
+#define PerlIO_set_ptrcnt(f,p,c) STMT_START {FILE_ptr(f) = (p), PerlIO_set_cnt(f,c);} STMT_END
+#else
+#ifdef STDIO_PTR_LVAL_SETS_CNT
+/* assert() may pre-process to ""; potential syntax error (FILE_ptr(), ) */
+#define PerlIO_set_ptrcnt(f,p,c) STMT_START {FILE_ptr(f) = (p); assert(FILE_cnt(f) == (c));} STMT_END
+#define PerlIO_fast_gets(f) 1
+#else
+#define PerlIO_set_ptrcnt(f,p,c) abort()
+#endif
+#endif
+#endif
+
+#else /* USE_STDIO_PTR */
+
+#define PerlIO_has_cntptr(f) 0
+#define PerlIO_canset_cnt(f) 0
+#define PerlIO_get_cnt(f) (abort(),0)
+#define PerlIO_get_ptr(f) (abort(),(void *)0)
+#define PerlIO_set_cnt(f,c) abort()
+#define PerlIO_set_ptrcnt(f,p,c) abort()
+
+#endif /* USE_STDIO_PTR */
+
+#ifndef PerlIO_fast_gets
+#define PerlIO_fast_gets(f) 0
+#endif
+
+#ifdef FILE_base
+#define PerlIO_has_base(f) 1
+#define PerlIO_get_bufsiz(f) (*PL_StdIO->pGetBufsiz)(PL_StdIO, (f))
+#define PerlIO_get_base(f) (*PL_StdIO->pGetBase)(PL_StdIO, (f))
+#else
+#define PerlIO_has_base(f) 0
+#define PerlIO_get_base(f) (abort(),(void *)0)
+#define PerlIO_get_bufsiz(f) (abort(),0)
+#endif
+
+#define PerlIO_importFILE(f,fl) (f)
+#define PerlIO_exportFILE(f,fl) (f)
+#define PerlIO_findFILE(f) (f)
+#define PerlIO_releaseFILE(p,f) ((void) 0)
+
+#endif /* ___NWStdio_H___ */
--- /dev/null
+--- perlsdio.h.old Sat Jun 30 14:42:22 2001
++++ perlsdio.h Sat Jun 30 14:59:49 2001
+@@ -1,4 +1,9 @@
+ #ifdef PERLIO_IS_STDIO
++
++#ifdef NETWARE
++ #include "nwstdio.h"
++#else
++
+ /*
+ * This file #define-s the PerlIO_xxx abstraction onto stdio functions.
+ * Make this as close to original stdio as possible.
+@@ -136,4 +141,5 @@
+ #define PerlIO_get_bufsiz(f) (abort(),0)
+ #endif
+
++#endif /* NETWARE */
+ #endif /* PERLIO_IS_STDIO */
-A set of Standard Unit Test Scripts to test all the functionalities of Perl5 Interpreter are available along with the CPAN download. They are all located under 't' folder. These include sub-folders under 't' such as: 'base', 'cmd', 'comp', 'io', lib', 'op', 'pod', 'pragma' and 'run'. Each of these sub-folders contain few test scripts ('.t' files) under them.
-
-Executing these test scripts on NetWare can be automated as per the following:
-
-1. Generate automated scripts like 'base.pl', 'cmd.pl', 'comp.pl', 'io.pl', 'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' that execute all the test scripts ('.t' files) under the corresponding folder.
-For example, 'base.pl' to test all the scripts under 'sys:\perl\scripts\t\base' folder,
- 'comp.pl' to test all the scripts under 'sys:\perl\scripts\t\comp' folder and so on.
-
-2. Generate an automated script, 'nwauto.pl' that executes all the above mentioned '.pl' automated scripts, thus in turn executing all the '.t' scripts.
-
-The script, 'NWScripts.pl' available under the 'NetWare\t' folder of the CPAN download, is written to generate these automated scripts when executed on a NetWare server. It generates 'base.pl', 'cmd.pl', 'comp.pl', 'io.pl', 'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' and also 'nwauto.pl' by including all the corresponding '.t' scripts in them in backtick operators.
-For example, all the scripts that are under 't\base' folder will be entered in 'base.pl' and so on. 'nwauto.pl' includes all these '.pl' scripts like 'base.pl', 'comp.pl' etc.
-
-
-The following steps elicits the procedure for executing the automated scripts:
+A set of Standard Unit Test Scripts to test all the functionalities of
+Perl5 Interpreter are available along with the CPAN download. They are
+all located under 't' folder. These include sub-folders under 't' such
+as: 'base', 'cmd', 'comp', 'io', lib', 'op', 'pod', 'pragma' and 'run'.
+Each of these sub-folders contain few test scripts ('.t' files) under
+them.
+
+Executing these test scripts on NetWare can be automated as per the
+following:
+
+1. Generate automated scripts like 'base.pl', 'cmd.pl', 'comp.pl', 'io.pl',
+'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' that execute all the
+test scripts ('.t' files) under the corresponding folder.
+
+For example, 'base.pl' to test all the scripts
+ under 'sys:\perl\scripts\t\base' folder,
+ 'comp.pl' to test all the scripts
+ under 'sys:\perl\scripts\t\comp' folder and so on.
+
+2. Generate an automated script, 'nwauto.pl' that executes all the above
+mentioned '.pl' automated scripts, thus in turn executing all the '.t'
+scripts.
+
+The script, 'NWScripts.pl' available under the 'NetWare\t' folder of the
+CPAN download, is written to generate these automated scripts when
+executed on a NetWare server. It generates 'base.pl', 'cmd.pl', 'comp.pl',
+'io.pl', 'lib.pl', 'op.pl', 'pod.pl', 'pragma.pl', 'run.pl' and also
+'nwauto.pl' by including all the corresponding '.t' scripts in them in
+backtick operators.
+
+For example, all the scripts that are under 't\base' folder will be
+entered in 'base.pl' and so on. 'nwauto.pl' includes all these '.pl'
+scripts like 'base.pl', 'comp.pl' etc.
+
+Perform the following steps to execute the automated scripts:
1. Make sure that your NetWare server is mapped to "i:".
-2. Execute "nmake nwinstall" (after complete build) in the 'NetWare' folder of the CPAN download. This installs all the library files, perl modules and all the 't' scripts in appropriate folders onto your server.
+2. Execute "nmake nwinstall" (after building interpreter and extensions)
+in the 'NetWare' folder of the CPAN download. This installs all the
+library files, perl modules and all the 't' scripts in appropriate
+folders onto your server.
-3. Copy all the files from 'NetWare\t' folder of the CPAN download into 'sys:\perl\scripts\t' folder.
+3. Execute the command "perl t\NWModify.pl" on the console command
+prompt of your server. This script replaces
-4. Execute the command "perl t\NWModify.pl" on the console command prompt of your server. This script replaces
"@INC = " with "unshift @INC, " and
"push @INC, " with "unshift @INC, "
- from all the scripts under 'sys:\perl\scripts\t' folder.
-This is done to include the correct path for libraries into the scripts when executed on NetWare. If this is not done, some of the scripts will not get executed since they cannot locate the corresponding libraries.
+from all the scripts under 'sys:\perl\scripts\t' folder.
+
+This is done to include the correct path for libraries into the scripts
+when executed on NetWare. If this is not done, some of the scripts will
+not get executed since they cannot locate the corresponding libraries.
-5. Execute the command "perl t\NWScripts.pl" on the console command prompt to generate the automated scripts mentioned above under the 'sys:\perl\scripts\t' folder.
+4. Execute the command "perl t\NWScripts.pl" on the console command
+prompt to generate the automated scripts mentioned above
+under the 'sys:\perl\scripts\t' folder.
-6. Execute the command "perl t\nwauto.pl" on the server console command prompt. This runs all the standard test scripts. If you desire to redirect or save the results into a file, say 'nwauto.txt', then the console command to execute is: "perl t\nwauto.pl > nwauto.txt".
+5. Execute the command "perl t\nwauto.pl" on the server console command
+prompt. This runs all the standard test scripts. If you desire to
+redirect or save the results into a file, say 'nwauto.txt', then the
+console command to execute is: "perl t\nwauto.pl > nwauto.txt".
-7. If you wish to execute only a certain set of scripts, then run the corresponding '.pl' file.
-For example, if you wish to execute only the 'lib' scripts, then execute 'lib.pl' through the server console command, "perl t\lib.pl'. To redirect the results into a file, the console command is, "perl t\lib.pl > lib.txt".
+6. If you wish to execute only a certain set of scripts, then run the
+corresponding '.pl' file. For example, if you wish to execute only the
+'lib' scripts, then execute 'lib.pl' through the server console command,
+"perl t\lib.pl'. To redirect the results into a file, the console command
+ is, "perl t\lib.pl > lib.txt".
1. 'openpid.t' in 'sys:\perl\scripts\t\io.pl' script
Reason:
- This either hangs or abends the server when executing through auto scripts. When run individually, the script execution goes through fine.
+ This either hangs or abends the server when executing through auto
+ scripts. When run individually, the script execution goes through
+ fine.
2. 'argv.t' in 'sys:\perl\scripts\t\io.pl' script
Reason:
- This either hangs or abends the server when executing through auto scripts. When run individually, the script execution goes through fine.
+ This either hangs or abends the server when executing through auto
+ scripts. When run individually, the script execution goes through
+ fine.
3. 'filehandle.t' in 'sys:\perl\scripts\t\lib.pl' script
Reason:
- This hangs in the last test case where it uses FileHandle::Pipe whether run individually or through an auto script.
+ This hangs in the last test case where it uses FileHandle::Pipe
+ whether run individually or through an auto script.
ports of '94 - 95. The priorities are absolute, go from 32 to -95,
lower is quicker. 0 is the default priority.
-B<WARNING>. Calling C<getpriority> on a non-existing process can lock the
-system before Warp3 fixpak22.
+B<WARNING>. Calling C<getpriority> on a non-existing process could lock
+the system before Warp3 fixpak22. Starting with Warp3, Perl will use
+a workaround: it aborts getpriority() if the process is not present.
+This is not possible on older versions C<2.*>, and has a race
+condition anyway.
=head2 C<system()>
L<OS2::Process>.
When finding a program to run, Perl first asks the OS to look for executables
-on C<PATH>. If not found, it looks for a script with possible extensions
+on C<PATH> (OS/2 adds extension F<.exe> if no extension is present).
+If not found, it looks for a script with possible extensions
added in this order: no extension, F<.cmd>, F<.btm>,
F<.bat>, F<.pl>. If found, Perl checks the start of the file for magic
strings C<"#!"> and C<"extproc ">. If found, Perl uses the rest of the
extproc /bin/bash -x -c
-If F</bin/bash> is not found, and appending of executable extensions to
-F</bin/bash> does not help either, then Perl looks for an executable F<bash> on
+If F</bin/bash.exe> is not found, then Perl looks for an executable F<bash.exe> on
C<PATH>. If found in F<C:/emx.add/bin/bash.exe>, then the above system() is
translated to
current session, it will start the new process in a separate session of
necessary type. Call via C<OS2::Process> to disable this magic.
+B<WARNING>. Due to the described logic, you need to explicitly
+specify F<.com> extension if needed. Moreover, if the executable
+F<perl5.6.1> is requested, Perl will not look for F<perl5.6.1.exe>.
+[This may change in the future.]
+
=head2 C<extproc> on the first line
If the first chars of a Perl script are C<"extproc ">, this line is treated
C<setpriority> and C<getpriority> are not compatible with earlier
ports by Andreas Kaiser. See C<"setpriority, getpriority">.
-=head2 DLL name mangling
+=head2 DLL name mangling: pre 5.6.2
With the release 5.003_01 the dynamically loadable libraries
should be rebuilt when a different version of Perl is compiled. In particular,
=back
+=head2 DLL name mangling: 5.6.2 and beyound
+
+In fact mangling of I<extension> DLLs was done due to misunderstanding
+of the OS/2 dynaloading model. OS/2 (effectively) maintains two
+different tables of loaded DLL:
+
+=over
+
+=item Global DLLs
+
+those loaded by the base name from C<LIBPATH>; including those
+associated at link time;
+
+=item specific DLLs
+
+loaded by the full name.
+
+=back
+
+When resolving a request for a global DLL, the table of already-loaded
+specific DLLs is (effectively) ignored; moreover, specific DLLs are
+I<always> loaded from the prescribed path.
+
+There is/was a minor twist which makes this scheme fragile: what to do
+with DLLs loaded from
+
+=over
+
+=item C<BEGINLIBPATH> and C<ENDLIBPATH>
+
+(which depend on the process)
+
+=item F<.> from C<LIBPATH>
+
+which I<effectively> depends on the process (although C<LIBPATH> is the
+same for all the processes).
+
+=back
+
+Unless C<LIBPATHSTRICT> is set to C<T> (and the kernel is after
+2000/09/01), such DLLs are considered to be global. When loading a
+global DLL it is first looked in the table of already-loaded global
+DLLs. Because of this the fact that one executable loaded a DLL from
+C<BEGINLIBPATH> and C<ENDLIBPATH>, or F<.> from C<LIBPATH> may affect
+I<which> DLL is loaded when I<another> executable requests a DLL with
+the same name. I<This> is the reason for version-specific mangling of
+the DLL name for perl DLL.
+
+Since the Perl extension DLLs are always loaded with the full path,
+there is no need to mangle their names in a version-specific ways:
+their directory already reflects the corresponding version of perl,
+and @INC takes into account binary compatibility with older version.
+Starting from C<5.6.2> the name mangling scheme is fixed to be the
+same as for Perl 5.005_53 (same as in a popular binary release). Thus
+new Perls will be able to I<resolve the names> of old extension DLLs
+if @INC allows finding their directories.
+
+However, this still does not guarantie that these DLL may be loaded.
+The reason is the mangling of the name of the I<Perl DLL>. And since
+the extension DLLs link with the Perl DLL, extension DLLs for older
+versions would load an older Perl DLL, and would most probably
+segfault (since the data in this DLL is not properly initialized).
+
+There is a partial workaround (which can be made complete with newer
+OS/2 kernels): create a forwarder DLL with the same name as the DLL of
+the older version of Perl, which forwards the entry points to the
+newer Perl's DLL. Make this DLL accessible on (say) the C<BEGINLIBPATH> of
+the new Perl executable. When the new executable accesses old Perl's
+extension DLLs, they would request the old Perl's DLL by name, get the
+forwarder instead, so effectively will link with the currently running
+(new) Perl DLL.
+
+This may break in two ways:
+
+=over
+
+=item *
+
+Old perl executable is started when a new executable is running has
+loaded an extension compiled for the old executable (ouph!). In this
+case the old executable will get a forwarder DLL instead of the old
+perl DLL, so would link with the new perl DLL. While not directly
+fatal, it will behave the same as new excutable. This beats the whole
+purpose of explicitly starting an old executable.
+
+=item *
+
+A new executable loads an extension compiled for the old executable
+when an old perl executable is running. In this case the extension
+will not pick up the forwarder - with fatal results.
+
+=back
+
+With support for C<LIBPATHSTRICT> this may be circumvented - unless
+one of DLLs is started from F<.> from C<LIBPATH> (I do not know
+whether C<LIBPATHSTRICT> affects this case).
+
+B<REMARK>. Unless newer kernels allow F<.> in C<BEGINLIBPATH> (older
+do not), this mess cannot be completely cleaned.
+
+
+B<REMARK>. C<LIBPATHSTRICT>, C<BEGINLIBPATH> and C<ENDLIBPATH> are
+not environment variables, although F<cmd.exe> emulates them on C<SET
+...> lines. From Perl they may be accessed by L<Cwd::extLibpath> and
+L<Cwd::extLibpath_set>.
+
+=head2 DLL forwarder generation
+
+Assume that the old DLL is named F<perlE0AC.dll> (as is one for
+5.005_53), and the new version is 5.6.1. Create a file
+F<perl5shim.def-leader> with
+
+ LIBRARY 'perlE0AC' INITINSTANCE TERMINSTANCE
+ DESCRIPTION '@#perl5-porters@perl.org:5.006001#@ Perl module for 5.00553 -> Perl 5.6.1 forwarder'
+ CODE LOADONCALL
+ DATA LOADONCALL NONSHARED MULTIPLE
+ EXPORTS
+
+modifying the versions/names as needed. Run
+
+ perl -wnle "next if 0../EXPORTS/; print qq( \"$1\") if /\"(\w+)\"/" perl5.def >lst
+
+in the Perl build directory (to make the DLL smaller replace perl5.def
+with the definition file for the older version of Perl if present).
+
+ cat perl5shim.def-leader lst >perl5shim.def
+ gcc -Zomf -Zdll -o perlE0AC.dll perl5shim.def -s -llibperl
+
+(ignore multiple C<warning L4085>).
+
=head2 Threading
As of release 5.003_01 perl is linked to multithreaded C RTL
Note that these problems should not discourage experimenting, since they
have a low probability of affecting small programs.
+=head1 BUGS
+
+This description was not updated since 5.6.1, see F<os2/Changes> for
+more info.
+
=cut
OS/2 extensions
=head1 RESOURCES
-There are many, many source for Solaris information. A few of the
+There are many, many sources for Solaris information. A few of the
important ones for perl:
=over 4
=item Precompiled Binaries
Precompiled binaries, links to many sites, and much, much more is
-available at L<http://www.sunfreeware.com>.
+available at L<http://www.sunfreeware.com/>.
=item Solaris Documentation
-All Solaris documentation is available on-line at L<http://docs.sun.com>.
+All Solaris documentation is available on-line at L<http://docs.sun.com/>.
=back
When you run SunOS4 binaries on Solaris, the run-time system magically
alters pathnames matching m#lib/locale# so that when tar tries to create
lib/locale.pm, a file named lib/oldlocale.pm gets created instead.
-If you found this advice it too late and used a SunOS4-compiled tar
+If you found this advice too late and used a SunOS4-compiled tar
anyway, you must find the incorrectly renamed file and move it back
to lib/locale.pm.
and this is the default for perl-5.6.0.
For a more complete explanation of 64-bit issues, see the Solaris 64-bit
-Developer's Guide at http://docs.sun.com:80/ab2/coll.45.13/SOL64TRANS/
+Developer's Guide at L<http://docs.sun.com:80/ab2/coll.45.13/SOL64TRANS/>
You can detect the OS mode using "isainfo -v", e.g.
want to allocate more than ~ 4GB of memory inside Perl, you probably
don't need Perl to be a 64-bit app.
-=head3 Large File Suppprt
+=head3 Large File Support
For Solaris 2.6 and onwards, there are two different ways for 32-bit
applications to manipulate large files (files whose size is > 2GByte).
You should not use perl's malloc if you are building with gcc. There
are reports of core dumps, especially in the PDL module. The problem
appears to go away under -DDEBUGGING, so it has been difficult to
-track down. Sun's compiler appears to be ok with or without perl's
+track down. Sun's compiler appears to be okay with or without perl's
malloc. [XXX further investigation is needed here.]
=head1 MAKE PROBLEMS.
Proc::ProcessTable doesn't try to share off_t's with the rest of perl,
or if it does they should be explicitly specified as off64_t.
-=head2 BSD::Resource on Solairs
+=head2 BSD::Resource on Solaris
BSD::Resource versions earlier than 1.09 do not compile on Solaris
with perl 5.6.0 and higher, for the same reasons as Proc::ProcessTable.
BSD::Resource versions starting from 1.09 have a workaround for the problem.
-=head2 Net::SSLeay on Soalris
+=head2 Net::SSLeay on Solaris
Net::SSLeay requires a /dev/urandom to be present. This device is not
part of Solaris. You can either get the package SUNWski (packaged with
#define PL_regint_start (vTHX->Tregint_start)
#define PL_regint_string (vTHX->Tregint_string)
#define PL_reginterp_cnt (vTHX->Treginterp_cnt)
+#define PL_reglastcloseparen (vTHX->Treglastcloseparen)
#define PL_reglastparen (vTHX->Treglastparen)
#define PL_regnarrate (vTHX->Tregnarrate)
#define PL_regnaughty (vTHX->Tregnaughty)
#define PL_regint_start (aTHXo->interp.Tregint_start)
#define PL_regint_string (aTHXo->interp.Tregint_string)
#define PL_reginterp_cnt (aTHXo->interp.Treginterp_cnt)
+#define PL_reglastcloseparen (aTHXo->interp.Treglastcloseparen)
#define PL_reglastparen (aTHXo->interp.Treglastparen)
#define PL_regnarrate (aTHXo->interp.Tregnarrate)
#define PL_regnaughty (aTHXo->interp.Tregnaughty)
#define PL_regint_start (aTHX->Tregint_start)
#define PL_regint_string (aTHX->Tregint_string)
#define PL_reginterp_cnt (aTHX->Treginterp_cnt)
+#define PL_reglastcloseparen (aTHX->Treglastcloseparen)
#define PL_reglastparen (aTHX->Treglastparen)
#define PL_regnarrate (aTHX->Tregnarrate)
#define PL_regnaughty (aTHX->Tregnaughty)
#define PL_Tregint_start PL_regint_start
#define PL_Tregint_string PL_regint_string
#define PL_Treginterp_cnt PL_reginterp_cnt
+#define PL_Treglastcloseparen PL_reglastcloseparen
#define PL_Treglastparen PL_reglastparen
#define PL_Tregnarrate PL_regnarrate
#define PL_Tregnaughty PL_regnaughty
package Devel::Peek;
# Underscore to allow older Perls to access older version from CPAN
-$VERSION = '1.00_01';
+$VERSION = '1.00_02';
require Exporter;
use XSLoader ();
--- /dev/null
+# Encoding file: 7bit-jis, escape-driven
+E
+name 7bit-jis
+init {}
+final {}
+ascii \x1b(B
+ascii \x1b(J
+7bit-kana \x1b(I
+jis0208 \x1b$B
+jis0208 \x1b$@
+jis0208 \x1b&@\x1b$B
+jis0212 \x1b$(D
--- /dev/null
+# Encoding file: 7bit-kana, single-byte
+S
+0025 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D00000000
+0010001100120013001400150016001700180019001A0000001C001D001E001F
+0000FF61FF62FF63FF64FF65FF66FF67FF68FF69FF6AFF6BFF6CFF6DFF6EFF6F
+FF70FF71FF72FF73FF74FF75FF76FF77FF78FF79FF7AFF7BFF7CFF7DFF7EFF7F
+FF80FF81FF82FF83FF84FF85FF86FF87FF88FF89FF8AFF8BFF8CFF8DFF8EFF8F
+FF90FF91FF92FF93FF94FF95FF96FF97FF98FF99FF9AFF9BFF9CFF9DFF9EFF9F
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
--- /dev/null
+# Encoding file: 7bit-kr, escape-driven
+E
+name 7bit-kr
+init \x1b$)C
+final {}
+ascii \x0f
+ksc5601 \x0e
my ($obj,$str,$chk) = @_;
my $rep = $obj->{'Rep'};
my $touni = $obj->{'ToUni'};
- my $uni = '';
+ my $uni;
while (length($str))
{
my $ch = ord(substr($str,0,1,''));
{
my ($obj,$uni,$chk) = @_;
my $fmuni = $obj->{'FmUni'};
- my $str = '';
my $def = $obj->{'Def'};
my $rep = $obj->{'Rep'};
+ my $str;
while (length($uni))
{
my $ch = substr($uni,0,1,'');
sub read
{
- my ($class,$fh,$name) = @_;
- my %self = (Name => $name, Num => 0);
+ my ($obj,$fh,$name) = @_;
+ my(%tbl, @esc, $enc);
while (<$fh>)
{
my ($key,$val) = /^(\S+)\s+(.*)$/;
$val =~ s/^\{(.*?)\}/$1/g;
$val =~ s/\\x([0-9a-f]{2})/chr(hex($1))/ge;
- $self{$key} = $val;
+ if($enc = Encode->getEncoding($key)){
+ $tbl{$val} = ref($enc) eq 'Encode::Tcl' ? $enc->loadEncoding : $enc;
+ push @esc, $val;
+ }else{
+ $obj->{$key} = $val;
+ }
}
- return bless \%self,$class;
+ $obj->{'Ctl'} = \@esc;
+ $obj->{'Tbl'} = \%tbl;
+ return $obj;
}
sub decode
{
- croak("Not implemented yet");
+ my ($obj,$str,$chk) = @_;
+ my $tbl = $obj->{'Tbl'};
+ my $ctl = $obj->{'Ctl'};
+ my $ini = $obj->{'init'};
+ my $fin = $obj->{'final'};
+ my $std = $ctl->[0];
+ my $cur = $std;
+ my $uni;
+ while (length($str)){
+ my $uch = substr($str,0,1,'');
+ if($uch eq "\e"){
+ $str =~ s/^([\x20-\x2F]*[\x30-\x7E](?:\x1b[\x20-\x2F]*[\x30-\x7E])*)//;
+ my $esc = "\e$1";
+ if($tbl->{$esc}){ $cur = $esc }
+ elsif($esc eq $ini || $esc eq $fin){ $cur = $std }
+ else{carp "unknown escape sequence" }
+ next;
+ }
+ if($uch eq "\x0e" || $uch eq "\x0f"){
+ $cur = $uch and next;
+ }
+ my $x;
+ if(ref($tbl->{$cur}) eq 'Encode::XS'){
+ $uni .= $tbl->{$cur}->decode($uch);
+ next;
+ }
+ my $ch = ord($uch);
+ my $rep = $tbl->{$cur}->{'Rep'};
+ my $touni = $tbl->{$cur}->{'ToUni'};
+ if (&$rep($ch) eq 'C')
+ {
+ $x = $touni->[0][$ch];
+ }
+ else
+ {
+ $x = $touni->[$ch][ord(substr($str,0,1,''))];
+ }
+ unless (defined $x)
+ {
+ last if $chk;
+ # What do we do here ?
+ $x = '';
+ }
+ $uni .= $x;
+ }
+ $_[1] = $str if $chk;
+ return $uni;
}
sub encode
{
- croak("Not implemented yet");
-}
+ my ($obj,$uni,$chk) = @_;
+ my $tbl = $obj->{'Tbl'};
+ my $ctl = $obj->{'Ctl'};
+ my $ini = $obj->{'init'};
+ my $fin = $obj->{'final'};
+ my $std = $ctl->[0];
+ my $str = $ini;
+ my $pre = $std;
+ my $cur = $pre;
+ while (length($uni)){
+ my $ch = chr(ord(substr($uni,0,1,'')));
+ my $x = ref($tbl->{$pre}) eq 'Encode::XS'
+ ? $tbl->{$pre}->encode($ch,1)
+ : $tbl->{$pre}->{FmUni}->{$ch};
+
+ unless(defined $x){
+ foreach my $esc (@$ctl){
+ $x = ref($tbl->{$esc}) eq 'Encode::XS'
+ ? $tbl->{$esc}->encode($ch,1)
+ : $tbl->{$esc}->{FmUni}->{$ch};
+ $cur = $esc and last if defined $x;
+ }
+ }
+ if($x == 0x0d && !($ini eq '' && $fin eq '') && substr($uni,0,1) eq "\x0a")
+ {
+ $str .= $cur unless $cur eq $pre;
+ $str .= $fin."\x0d\x0a".$ini;
+ substr($uni,0,1,'');
+ $pre = $std;
+ next;
+ }
+ if(ref($tbl->{$cur}) eq 'Encode::XS'){
+ $str .= $cur unless $cur eq $pre;
+ $str .= $x; # "DEF" is lost
+ $pre = $cur;
+ next;
+ }
+ my $def = $tbl->{$cur}->{'Def'};
+ my $rep = $tbl->{$cur}->{'Rep'};
+ unless (defined $x){
+ last if ($chk);
+ $x = $def;
+ }
+ $str .= $cur unless $cur eq $pre;
+ $str .= pack(&$rep($x),$x);
+ $pre = $cur;
+ }
+ $str .= $std unless $cur eq $std;
+ $str .= $fin;
+ $_[1] = $uni if $chk;
+ return $str;
+}
1;
__END__
use Config;
use strict;
-our $VERSION = "1.111";
+our $VERSION = "1.09_00";
my %err = ();
use File::Spec;
@ISA = qw(Tie::Hash Exporter);
-$VERSION = "1.04";
+$VERSION = "1.03_00";
@EXPORT_OK = qw(DIR_UNLINK);
sub DIR_UNLINK () { 1 }
require Exporter;
@ISA = qw(Exporter);
-$VERSION = "1.22";
+$VERSION = "1.21_00";
@EXPORT_OK = qw(
autoflush
@EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END);
@ISA = qw(Exporter);
-$VERSION = "1.09";
+$VERSION = "1.08_00";
sub seek {
@_ == 3 or croak 'usage: $io->seek(POS, WHENCE)';
use Carp;
@ISA = qw(IO::Socket);
-$VERSION = "1.21";
+$VERSION = "1.20_00";
IO::Socket::UNIX->register_domain( AF_UNIX );
use vars qw($VERSION);
use Carp;
-$VERSION = "1.01";
+$VERSION = "1.00_00";
{
package IPC::Msg::stat;
use vars qw($VERSION);
use Carp;
-$VERSION = "1.01";
+$VERSION = "1.00_00";
{
package IPC::Semaphore::stat;
require Exporter;
@ISA = qw(Exporter);
-$VERSION = "1.04";
+$VERSION = "1.03_00";
@EXPORT_OK = qw(
GETALL GETNCNT GETPID GETVAL GETZCNT
* with -DL.
*/
DEBUG_S(PerlIO_printf(Perl_debug_log,
- "handle_thread_signal: got signal %d\n", sig););
+ "handle_thread_signal: got signal %d\n", sig));
write(sig_pipe[1], &c, 1);
}
if (t == thr)
croak("Attempt to join self");
DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: joining %p (state %u)\n",
- thr, t, ThrSTATE(t)););
+ thr, t, ThrSTATE(t)));
MUTEX_LOCK(&t->mutex);
switch (ThrSTATE(t)) {
case THRf_R_JOINABLE:
CODE:
#ifdef USE_THREADS
DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: detaching %p (state %u)\n",
- thr, t, ThrSTATE(t)););
+ thr, t, ThrSTATE(t)));
MUTEX_LOCK(&t->mutex);
switch (ThrSTATE(t)) {
case THRf_R_JOINABLE:
if (ret)
sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no);
DEBUG_S(PerlIO_printf(Perl_debug_log,
- "await_signal returning %s\n", SvPEEK(ST(0))););
+ "await_signal returning %s\n", SvPEEK(ST(0))));
MODULE = Thread PACKAGE = Thread::Specific
croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\");
$var = ($type) SvPVX(mg->mg_obj);
DEBUG_S(PerlIO_printf(Perl_debug_log,
- \"XSUB ${func_name}: %p\\n\", $var);)
+ \"XSUB ${func_name}: %p\\n\", $var));
} STMT_END
T_IVREF
if (SvROK($arg))
@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
getitimer setitimer ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF);
-$VERSION = '1.21';
+$VERSION = '1.20_00';
sub AUTOLOAD {
my $constname;
#include <stdlib.h> /* qdiv */
#include <starlet.h> /* sys$gettim */
#include <descrip.h>
+#ifdef __VAX
+#include <lib$routines.h> /* lib$ediv() */
+#endif
/*
VMS binary time is expressed in 100 nano-seconds since
static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
#ifdef __VAX
-static long base_adjust=0L;
+static long base_adjust[2]={0L,0L};
#else
static __int64 base_adjust=0;
#endif
{
long ret;
#ifdef __VAX
- long quad;
- div_t ans1,ans2;
+ long quad[2];
+ long quad1[2];
+ long div_100ns_to_secs;
+ long div_100ns_to_usecs;
+ long quo,rem;
+ long quo1,rem1;
#else
__int64 quad;
__qdiv_t ans1,ans2;
tp->tv_usec = 0;
+#ifdef __VAX
+ if (base_adjust[0]==0 && base_adjust[1]==0) {
+#else
if (base_adjust==0) { /* Need to determine epoch adjustment */
+#endif
ret=sys$bintim(&dscepoch,&base_adjust);
if (1 != (ret &&1)) {
tp->tv_sec = ret;
ret=sys$gettim(&quad); /* Get VMS system time */
if ((1 && ret) == 1) {
- quad -= base_adjust; /* convert to epoch offset */
#ifdef __VAX
- ans1=div(quad,DIV_100NS_TO_SECS);
- ans2=div(ans1.rem,DIV_100NS_TO_USECS);
+ quad[0] -= base_adjust[0]; /* convert to epoch offset */
+ quad[1] -= base_adjust[1]; /* convert 2nd half of quadword */
+ div_100ns_to_secs = DIV_100NS_TO_SECS;
+ div_100ns_to_usecs = DIV_100NS_TO_USECS;
+ lib$ediv(&div_100ns_to_secs,&quad,&quo,&rem);
+ quad1[0] = rem;
+ quad1[1] = 0L;
+ lib$ediv(&div_100ns_to_usecs,&quad1,&quo1,&rem1);
+ tp->tv_sec = quo; /* Whole seconds */
+ tp->tv_usec = quo1; /* Micro-seconds */
#else
+ quad -= base_adjust; /* convert to epoch offset */
ans1=qdiv(quad,DIV_100NS_TO_SECS);
ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
-#endif
tp->tv_sec = ans1.quot; /* Whole seconds */
tp->tv_usec = ans2.quot; /* Micro-seconds */
+#endif
} else {
tp->tv_sec = ret;
return -1;
case '\006': /* $^F */
case '\010': /* $^H */
case '\011': /* $^I, NOT \t in EBCDIC */
+ case '\016': /* $^N */
case '\020': /* $^P */
case '\024': /* $^T */
if (len > 1)
case '\010': /* $^H */
case '\011': /* $^I, NOT \t in EBCDIC */
case '\014': /* $^L */
+ case '\016': /* $^N */
case '\020': /* $^P */
case '\023': /* $^S */
case '\024': /* $^T */
# AIX 4.3.* and above default to using nm for symbol extraction
case "$osvers" in
- 3.*|4.1.*|4.2.*|4.3.0.*)
- usenm='undef'
- usenativedlopen='false'
+ 3.*|4.1.*|4.2.*)
+ case "$usenm" in
+ '') usenm='undef'
+ esac
+ case "$usenativedlopen" in
+ '') usenativedlopen='false'
+ esac
;;
*)
- usenm='true'
- usenativedlopen='true'
+ case "$usenm" in
+ '') usenm='true'
+ esac
+ case "$usenativedlopen" in
+ '') usenativedlopen='true'
+ esac
;;
esac
lddlflags="$*"
# Insert pthreads to libswanted, before any libc or libC.
- set `echo X "$libswanted "| sed -e 's/ \([cC]\) / pthreads \1 /'`
+ set `echo X "$libswanted "| sed -e 's/ \([cC]_r\) / pthreads \1 /'`
shift
libswanted="$*"
# Insert pthreads to lddlflags, before any libc or libC.
- set `echo X "$lddlflags " | sed -e 's/ \(-l[cC]\) / -lpthreads \1 /'`
+ set `echo X "$lddlflags " | sed -e 's/ \(-l[cC]_r\) / -lpthreads \1 /'`
shift
lddlflags="$*"
exit 1
;;
esac
+ # XXX In 64-bit AIX 5L (oslevel 5.1.0.0, ccversion 5.0.2.0)
+ # the Configure library symbol probe mysteriously finds all
+ # symbols but these two --jhi XXX
+ d_pipe='define'
+ d_times='define'
;;
esac
EOCBU
case `$cc -v 2>&1`"" in
*gcc*) ccisgcc="$define"
ccflags="$cc_cppflags"
+ if [ "X$gccversion" = "X" ]; then
+ # Done too late in Configure if hinted
+ gccversion=`$cc --version`
+ fi
case "`getconf KERNEL_BITS 2>/dev/null`" in
*64*)
- echo "main(){}">try.c
- # gcc with gas will not accept +DA2.0
- case "`$cc -c -Wa,+DA2.0 try.c 2>&1`" in
- *"+DA2.0"*) # gas
- gnu_as=yes
+ case "$gccversion" in
+ 3*) ccflags="$ccflags -mpa-risc-2-0"
;;
- *) # HPas
- case "$gccversion" in
- [12]*) ccflags="$ccflags -Wa,+DA2.0" ;;
- esac
+ *) echo "main(){}">try.c
+ # gcc with gas will not accept +DA2.0
+ case "`$cc -c -Wa,+DA2.0 try.c 2>&1`" in
+ *"+DA2.0"*) # gas
+ gnu_as=yes
+ ;;
+ *) # HPas
+ ccflags="$ccflags -Wa,+DA2.0"
+ ;;
+ esac
;;
esac
# gcc with gld will not accept +vnocompatwarnings
# anyway. Expect auto-detection of 64-bit enabled gcc on
# HP-UX soon, including a user-friendly exit
case $gcc_64native in
- no) ccflags="$ccflags -mlp64"
- ldflags="$ldflags -Wl,+DD64"
+ no) case "$gccversion" in
+ [12]*) ccflags="$ccflags -mlp64"
+ ldflags="$ldflags -Wl,+DD64"
+ ;;
+ esac
;;
esac
;;
use strict;
use CGI ();
-$CGI::Pretty::VERSION = '1.06';
+$CGI::Pretty::VERSION = '1.05_00';
$CGI::DefaultClass = __PACKAGE__;
$CGI::Pretty::AutoloadClass = 'CGI';
@CGI::Pretty::ISA = qw( CGI );
use base 'Exporter';
use CPAN;
-$VERSION = "1.01";
+$VERSION = "1.00_00";
$CPAN::META->has_inst('MD5','no');
$CPAN::META->has_inst('LWP','no');
$CPAN::META->has_inst('Compress::Zlib','no');
print "# $dir being created...\n";
mkdir $dir, 0777 or die "mkdir: $!\n";
+my $output = "output";
END {
use File::Path;
print FH "use strict;\n";
print FH "use $package qw(@names_only);\n";
-print FH <<'EOT';
+print FH <<"EOT";
+
+print "1..1\n";
+if (open OUTPUT, ">$output") {
+ print "ok 1\n";
+ select OUTPUT;
+} else {
+ print "not ok 1 # Failed to open '$output': $!\n";
+ exit 1;
+}
+EOT
+print FH << 'EOT';
+
+# What follows goes to the temporary file.
# IV
my $five = FIVE;
if ($five == 5) {
if ($^O eq 'MSWin32' && $make eq 'nmake') { $make .= " -nologo"; }
-my $makeout;
+my @makeout;
print "# make = '$make'\n";
-$makeout = `$make`;
+@makeout = `$make`;
if ($?) {
print "not ok 3 # $make failed: $?\n";
+ print "# $_" foreach @makeout;
exit($?);
} else {
print "ok 3\n";
} else {
my $makeperl = "$make perl";
print "# make = '$makeperl'\n";
- $makeout = `$makeperl`;
+ @makeout = `$makeperl`;
if ($?) {
print "not ok 4 # $makeperl failed: $?\n";
+ print "# $_" foreach @makeout;
exit($?);
} else {
print "ok 4\n";
}
}
-my $test = 23;
+push @files, $output;
+
my $maketest = "$make test";
print "# make = '$maketest'\n";
-$makeout = `$maketest`;
-
-# echo of running the test script
-$makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m;
-$makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS';
-# GNU make babblings
-$makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig;
+@makeout = `$maketest`;
-# Hopefully gets most make's babblings
-# make -f Makefile.aperl perl
-$makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig;
-# make[1]: `perl' is up to date.
-$makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig;
+if (open OUTPUT, "<$output") {
+ print while <OUTPUT>;
+ close OUTPUT or print "# Close $output failed: $!\n";
+} else {
+ # Harness will report missing test results at this point.
+ print "# Open <$output failed: $!\n";
+}
-print $makeout;
+my $test = 23;
if ($?) {
print "not ok $test # $maketest failed: $?\n";
+ print "# $_" foreach @makeout;
} else {
print "ok $test\n";
}
my $makeclean = "$make clean";
print "# make = '$makeclean'\n";
-$makeout = `$makeclean`;
+@makeout = `$makeclean`;
if ($?) {
print "not ok $test # $make failed: $?\n";
+ print "# $_" foreach @makeout;
} else {
print "ok $test\n";
}
);
use strict;
-$VERSION = sprintf("%d.%02d", q$Revision: 1.2505 $ =~ /(\d+)\.(\d+)/);
+$VERSION = sprintf("%d.%02d", q$Revision: 1.2505_00 $ =~ /(\d+)\.(\d+)/);
@ISA = qw(Exporter);
@EXPORT = qw(&xsinit &ldopts
use 5.005_64;
# Broken out of MakeMaker from version 4.11
-our $VERSION = substr q$Revision: 1.26 $, 10;
+our $VERSION = substr q$Revision: 1.27 $, 10;
use Config;
use Cwd 'cwd';
$Is_MacOS,$Is_VMS,
$Debug,$Verbose,$Quiet,$MANIFEST,$found,$DEFAULT_MSKIP);
-$VERSION = substr(q$Revision: 1.33 $, 10);
+$VERSION = substr(q$Revision: 1.34 $, 10);
@ISA=('Exporter');
@EXPORT_OK = ('mkmanifest', 'manicheck', 'fullcheck', 'filecheck',
'skipcheck', 'maniread', 'manicopy');
our(@ISA, @EXPORT, $VERSION);
@ISA = 'Exporter';
@EXPORT = '&Mksymlists';
-$VERSION = substr q$Revision: 1.17 $, 10;
+$VERSION = substr q$Revision: 1.18 $, 10;
sub Mksymlists {
my(%spec) = @_;
use File::Find;
use File::Spec;
use Cwd;
+use Config;
+
+# Remove insecure directories from PATH
+my @path;
+my $sep = $Config{path_sep};
+foreach my $dir (split(/$sep/,$ENV{'PATH'}))
+ {
+ push(@path,$dir) unless (stat $dir)[2] & 0002;
+ }
+$ENV{'PATH'} = join($sep,@path);
my $NonTaintedCwd = $^O eq 'MSWin32' || $^O eq 'cygwin';
use Carp;
use Symbol qw(gensym qualify);
-$VERSION = 1.0103;
+$VERSION = 1.0104;
@ISA = qw(Exporter);
@EXPORT = qw(open3);
qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)#private-ish
);
-$VERSION = '1.18';
+$VERSION = '1.17_00';
require Exporter;
@ISA=('Exporter');
--- /dev/null
+package Unicode::UCD;
+
+use strict;
+use warnings;
+
+our $VERSION = v3.1.0;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(charinfo charblock);
+
+use Carp;
+
+=head1 NAME
+
+Unicode - Unicode character database
+
+=head1 SYNOPSIS
+
+ use Unicode::UCD 3.1.0;
+ # requires that level of the Unicode character database
+
+ use Unicode::UCD 'charinfo';
+ my %charinfo = charinfo($codepoint);
+
+ use Unicode::UCD 'charblock';
+ my $charblock = charblock($codepoint);
+
+=head1 DESCRIPTION
+
+The Unicode module offers a simple interface to the Unicode Character
+Database.
+
+=cut
+
+my $UNICODE;
+my $BLOCKS;
+
+sub openunicode {
+ my ($rfh, @path) = @_;
+ my $f;
+ unless (defined $$rfh) {
+ for my $d (@INC) {
+ use File::Spec;
+ $f = File::Spec->catfile($d, "unicode", @path);
+ if (open($$rfh, $f)) {
+ last;
+ } else {
+ croak __PACKAGE__, ": open '$f' failed: $!\n";
+ }
+ }
+ croak __PACKAGE__, ": failed to find ",join("/",@path)," in @INC\n"
+ unless defined $rfh;
+ }
+ return $f;
+}
+
+=head2 charinfo
+
+ use Unicode::UCD 'charinfo';
+
+ my %charinfo = charinfo(0x41);
+
+charinfo() returns a hash that has the following fields as defined
+by the Unicode standard:
+
+ key
+
+ code code point with at least four hexdigits
+ name name of the character IN UPPER CASE
+ category general category of the character
+ combining classes used in the Canonical Ordering Algorithm
+ bidi bidirectional category
+ decomposition character decomposition mapping
+ decimal if decimal digit this is the integer numeric value
+ digit if digit this is the numeric value
+ numeric if numeric is the integer or rational numeric value
+ mirrored if mirrored in bidirectional text
+ unicode10 Unicode 1.0 name if existed and different
+ comment ISO 10646 comment field
+ upper uppercase equivalent mapping
+ lower lowercase equivalent mapping
+ title titlecase equivalent mapping
+ block block the character belongs to (used in \p{In...})
+
+If no match is found, an empty hash is returned.
+
+The C<block> property is the same as as returned by charinfo().
+(It is not defined in the Unicode Character Database proper but
+instead in an auxiliary database.)
+
+=cut
+
+sub charinfo {
+ my $code = shift;
+ my $hexk = sprintf("%04X", $code);
+
+ openunicode(\$UNICODE, "Unicode.txt");
+ if (defined $UNICODE) {
+ use Search::Dict;
+ if (look($UNICODE, "$hexk;") >= 0) {
+ my $line = <$UNICODE>;
+ chomp $line;
+ my %prop;
+ @prop{qw(
+ code name category
+ combining bidi decomposition
+ decimal digit numeric
+ mirrored unicode10 comment
+ upper lower title
+ )} = split(/;/, $line, -1);
+ if ($prop{code} eq $hexk) {
+ $prop{block} = charblock($code);
+ return %prop;
+ }
+ }
+ }
+ return;
+}
+
+=head2 charbloc
+
+ use Unicode::UCD 'charblock';
+
+ my $charblock = charblock(0x41);
+
+charblock() returns the block the character belongs to, e.g.
+C<Basic Latin>. Note that not all the character positions within all
+block are defined.
+
+The name is the same name that is used in the C<\p{In...}> construct,
+for example C<\p{InBasicLatin}> (spaces and dashes ('-') are squished
+away from the names for the C<\p{In...}>.
+
+=cut
+
+my @BLOCKS;
+
+sub _charblock {
+ my ($code, $lo, $hi) = @_;
+
+ return if $lo > $hi;
+
+ my $mid = int(($lo+$hi) / 2);
+
+ if ($BLOCKS[$mid]->[0] < $code) {
+ if ($BLOCKS[$mid]->[1] >= $code) {
+ return $BLOCKS[$mid]->[2];
+ } else {
+ _charblock($code, $mid + 1, $hi);
+ }
+ } elsif ($BLOCKS[$mid]->[0] > $code) {
+ _charblock($code, $lo, $mid - 1);
+ } else {
+ return $BLOCKS[$mid]->[2];
+ }
+}
+
+sub charblock {
+ my $code = shift;
+
+ unless (@BLOCKS) {
+ if (openunicode(\$BLOCKS, "Blocks.pl")) {
+ while (<$BLOCKS>) {
+ if (/^([0-9A-F]+)\s+([0-9A-F]+)\s+(.+)/) {
+ push @BLOCKS, [ hex($1), hex($2), $3 ];
+ }
+ }
+ close($BLOCKS);
+ }
+ }
+
+ _charblock($code, 0, $#BLOCKS);
+}
+
+=head1 AUTHOR
+
+Jarkko Hietaniemi
+
+=cut
+
+1;
--- /dev/null
+use Unicode::UCD 3.1.0;
+
+use Test;
+use strict;
+
+BEGIN { plan tests => 81 };
+
+use Unicode::UCD 'charinfo';
+
+my %charinfo;
+
+%charinfo = charinfo(0x41);
+
+ok($charinfo{code}, '0041');
+ok($charinfo{name}, 'LATIN CAPITAL LETTER A');
+ok($charinfo{category}, 'Lu');
+ok($charinfo{combining}, '0');
+ok($charinfo{bidi}, 'L');
+ok($charinfo{decomposition}, '');
+ok($charinfo{decimal}, '');
+ok($charinfo{digit}, '');
+ok($charinfo{numeric}, '');
+ok($charinfo{mirrored}, 'N');
+ok($charinfo{unicode10}, '');
+ok($charinfo{comment}, '');
+ok($charinfo{upper}, '');
+ok($charinfo{lower}, '0061');
+ok($charinfo{title}, '');
+ok($charinfo{block}, 'Basic Latin');
+
+%charinfo = charinfo(0x100);
+
+ok($charinfo{code}, '0100');
+ok($charinfo{name}, 'LATIN CAPITAL LETTER A WITH MACRON');
+ok($charinfo{category}, 'Lu');
+ok($charinfo{combining}, '0');
+ok($charinfo{bidi}, 'L');
+ok($charinfo{decomposition}, '0041 0304');
+ok($charinfo{decimal}, '');
+ok($charinfo{digit}, '');
+ok($charinfo{numeric}, '');
+ok($charinfo{mirrored}, 'N');
+ok($charinfo{unicode10}, 'LATIN CAPITAL LETTER A MACRON');
+ok($charinfo{comment}, '');
+ok($charinfo{upper}, '');
+ok($charinfo{lower}, '0101');
+ok($charinfo{title}, '');
+ok($charinfo{block}, 'Latin Extended-A');
+
+%charinfo = charinfo(0x590);
+
+ok($charinfo{code}, undef);
+ok($charinfo{name}, undef);
+ok($charinfo{category}, undef);
+ok($charinfo{combining}, undef);
+ok($charinfo{bidi}, undef);
+ok($charinfo{decomposition}, undef);
+ok($charinfo{decimal}, undef);
+ok($charinfo{digit}, undef);
+ok($charinfo{numeric}, undef);
+ok($charinfo{mirrored}, undef);
+ok($charinfo{unicode10}, undef);
+ok($charinfo{comment}, undef);
+ok($charinfo{upper}, undef);
+ok($charinfo{lower}, undef);
+ok($charinfo{title}, undef);
+ok($charinfo{block}, undef);
+
+%charinfo = charinfo(0x5d0);
+
+ok($charinfo{code}, '05D0');
+ok($charinfo{name}, 'HEBREW LETTER ALEF');
+ok($charinfo{category}, 'Lo');
+ok($charinfo{combining}, '0');
+ok($charinfo{bidi}, 'R');
+ok($charinfo{decomposition}, '');
+ok($charinfo{decimal}, '');
+ok($charinfo{digit}, '');
+ok($charinfo{numeric}, '');
+ok($charinfo{mirrored}, 'N');
+ok($charinfo{unicode10}, '');
+ok($charinfo{comment}, '');
+ok($charinfo{upper}, '');
+ok($charinfo{lower}, '');
+ok($charinfo{title}, '');
+ok($charinfo{block}, 'Hebrew');
+
+use Unicode::UCD 'charblock';
+
+ok(charblock(0x590), 'Hebrew');
+
+%charinfo = charinfo(0xbe);
+
+ok($charinfo{code}, '00BE');
+ok($charinfo{name}, 'VULGAR FRACTION THREE QUARTERS');
+ok($charinfo{category}, 'No');
+ok($charinfo{combining}, '0');
+ok($charinfo{bidi}, 'ON');
+ok($charinfo{decomposition}, '<fraction> 0033 2044 0034');
+ok($charinfo{decimal}, '');
+ok($charinfo{digit}, '');
+ok($charinfo{numeric}, '3/4');
+ok($charinfo{mirrored}, 'N');
+ok($charinfo{unicode10}, 'FRACTION THREE QUARTERS');
+ok($charinfo{comment}, '');
+ok($charinfo{upper}, '');
+ok($charinfo{lower}, '');
+ok($charinfo{title}, '');
+ok($charinfo{block}, 'Latin-1 Supplement');
+
goto getparen;
}
return 0;
+ case '\016': /* ^N */
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+ paren = rx->lastcloseparen;
+ if (paren)
+ goto getparen;
+ }
+ return 0;
case '`':
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if (rx->startp[0] != -1) {
}
sv_setsv(sv,&PL_sv_undef);
break;
+ case '\016': /* ^N */
+ if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
+ paren = rx->lastcloseparen;
+ if (paren)
+ goto getparen;
+ }
+ sv_setsv(sv,&PL_sv_undef);
+ break;
case '`':
if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
if ((s = rx->subbeg) && rx->startp[0] != -1) {
{
DEBUG_S(PerlIO_printf(Perl_debug_log,
"0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv));)
+ PTR2UV(thr), PTR2UV(sv)));
if (MgOWNER(mg))
Perl_croak(aTHX_ "panic: magic_mutexfree");
MUTEX_DESTROY(MgMUTEXP(mg));
compartment. As a result, the return string was not initialized.
A complete example of a mini-application added to OS2::REXX.
README.os2 updated to reflect the current state of Perl.
+
+pre 5.6.2:
+ aout build: kid bootstrap_* were not associated with XS.
+ bldlevel did not contain enough info.
+ extLibpath* was failing on the call of the second type.
+ Configure defines flushNULL now (EMX -Zomf bug broke autodetection).
+ Configure did not find SIGBREAK.
+ extLibpath supports LIBSTRICT, better error detection.
+ crypt() used if present in -lcrypt or -lufc.
+ dumb getpw*(), getgr*() etc. supported; as in EMX, but if no
+ $ENV{PW_PASSWD}, the passwd field contains a string which
+ cannot be returned by crypt() (for security reasons).
+ The unwound recursion in detecting executable by script was
+ using static buffers. Thus system('pod2text') would fail if the
+ current directory contained an empty file named 'perl'.
+ Put ordinals in the base DLL.
+ Enable EXE-compression.
+ Load time (ms): Without /e:2: 70.6; With /e:2: 75.3; Lxlite: 62.8
+ Size drops from 750K to 627K, with lxlite to 515K.
+ lxlite /c:max gives 488K, but dumps core in t/TEST
+ os2ish.h defines SYSLOG constants ==> Sys::Syslog works.
+ Corrected warnings related to OS/2 code.
+ At one place = was put instead of ==.
+ Setting $^E should work.
+ Force "SYS0dddd=0xbar: " to error messages and to dlerror().
+ ($^E == 2 printed SYS0002 itself, but 110 did not.)
+ $OS2::nsyserror=0 switches off forcing SYSdddd on $^E.
+ perl_.exe does not require PM dlls any more (symbols resolved at
+ runtime on the as needed basis).
+ OS2::Process:
+ get/set: term size; codepages; screen's cursor; screen's contents
+ reliable session name setting;
+ process's parent pid, and the session id;
+ switching to and enumeration of sessions
+ window hierarchy inspection
+ post a message to a window
+ More robust getpriority() on older Warps.
#if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT)
static char *local_patches[] = {
NULL
- ,"DEVEL11005"
+ ,"DEVEL11025"
,NULL
};
#define PL_regint_string (*Perl_Tregint_string_ptr(aTHXo))
#undef PL_reginterp_cnt
#define PL_reginterp_cnt (*Perl_Treginterp_cnt_ptr(aTHXo))
+#undef PL_reglastcloseparen
+#define PL_reglastcloseparen (*Perl_Treglastcloseparen_ptr(aTHXo))
#undef PL_reglastparen
#define PL_reglastparen (*Perl_Treglastparen_ptr(aTHXo))
#undef PL_regnarrate
=item *
-GMAGIC (right-hand side magic) could in many cases such as concatenation
-of string be invoked too many times.
+GMAGIC (right-hand side magic) could in many cases such as string
+concatenation be invoked too many times.
=item *
=item *
-The MAGIC constants (e.g. C<'P'>) have been macrofied
-(e.g. C<PERL_MAGIC_TIED>) for better source code readability
-and maintainability.
+The C<op_clear> and C<op_null> are now exported.
=item *
-The C<op_clear> and C<op_null> are now exported.
+A new special regular expression variable has been introduced:
+C<$^N>, which contains the most-recently closed group (submatch).
=item *
L<perlhack>. There is a make target "perl.gprof" for generating a
gprofiled Perl executable.
-=item *
-
-(Code documentation) F<perly.c> and F<sv.c> have now been extensively
-commented.
-
=back
=head1 Installation and Configuration Improvements
=item *
-The C code has been made much more C<gcc -Wall> clean. Some warning
-messages still remain, though, so if you are compiling with gcc you
-will see some warnings about dubious practices. The warnings are
-being worked on.
-
-=item *
-
In AFS installations one can configure the root of the AFS to be
somewhere else than the default F</afs> by using the Configure
parameter C<-Dafsroot=/some/where/else>.
=back
-=head1 Changed Internals
+=head1 Source Code Enhancements
+
+=head2 MAGIC constants
+
+The MAGIC constants (e.g. C<'P'>) have been macrofied
+(e.g. C<PERL_MAGIC_TIED>) for better source code readability
+and maintainability.
+
+=head2 Better commented code
+
+F<perly.c>, F<sv.c>, and F<sv.h> have now been extensively commented.
=head2 Regex pre-/post-compilation items matched up
C<offsets> member of the C<struct regexp>. See L<perldebguts> for more
complete information.
+=head2 gcc -Wall
+
+The C code has been made much more C<gcc -Wall> clean. Some warning
+messages still remain, though, so if you are compiling with gcc you
+will see some warnings about dubious practices. The warnings are
+being worked on.
+
=head1 New Tests
Several new tests have been added, especially for the F<lib> subsection.
Many floating point inaccuracies:
- op/numconvert 511,657,658,659,665-667,831,991,1151
- op/pack 10,22,149,156
- op/sprintf 8,10,13,102-107,134-135,146-153,159-162
- lib/Math/BigInt/bigintpm 1145,1183
- lib/Math/Complex 250,257,514,521,722-724,
- 934,935,945,949,955,956,975,976
- ext/POSIX/POSIX 14
+ op/numconvert 511,657,658,659,665-667,831,991,1151
+ op/pack 10,22,149,156
+ op/sprintf 8,10,13,102-107,134-135,146-153,159-162
+ lib/Math/BigInt/bigintpm 1145,1183
+ lib/Math/Complex 250,257,514,521,722-724,
+ 934,935,945,949,955,956,975,976
+ ext/POSIX/POSIX 14
+
+=head2 VMS
+
+DEC C V5.3-006 on OpenVMS VAX V6.2
+
+ [-.ext.list.util.t]tainted..............FAILED on test 3
+ [-.ext.posix]sigaction..................FAILED on test 7
+ [-.ext.time.hires]hires.................FAILED on test 14
+ [-.lib.file.find]taint..................FAILED on test 17
+ [-.lib.math.bigint.t]bigintpm...........FAILED on test 1183
+ [-.lib.test.simple.t]exit...............FAILED on test 1
+ [.lib]vmsish............................FAILED on test 13
+ [.op]sprintf............................FAILED on test 12
+ Failed 8/399 tests, 91.23% okay.
+
+DEC C V6.0-001 on OpenVMS Alpha V7.2-1
+
+ [-.ext.list.util.t]tainted..............FAILED on test 3
+ [-.lib.file.find]taint..................FAILED on test 17
+ [-.lib.test.simple.t]exit...............FAILED on test 1
+ [.lib]vmsish............................FAILED on test 13
+ Failed 4/399 tests, 92.48% okay.
=head2 Localising a Tied Variable Leaks Memory
/(ab(cd|ef)((gi)|j))/;
1 2 34
-so that if the regexp matched, e.g., C<$2> would contain 'cd' or 'ef'.
-For convenience, perl sets C<$+> to the highest numbered C<$1>, C<$2>,
-... that got assigned.
+so that if the regexp matched, e.g., C<$2> would contain 'cd' or 'ef'. For
+convenience, perl sets C<$+> to the string held by the highest numbered
+C<$1>, C<$2>, ... that got assigned (and, somewhat related, C<$^N> to the
+value of the C<$1>, C<$2>, ... most-recently assigned; i.e. the C<$1>,
+C<$2>, ... associated with the rightmost closing parenthesis used in the
+match).
Closely associated with the matching variables C<$1>, C<$2>, ... are
the B<backreferences> C<\1>, C<\2>, ... . Backreferences are simply
$EVAL_ERROR, $@, $PROCESS_ID, $PID, $$, $REAL_USER_ID, $UID, $<,
$EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, $GID, $(,
$EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $], $COMPILING, $^C,
-$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, %^H, $INPLACE_EDIT, $^I, $^M,
+$DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, %^H, $INPLACE_EDIT, $^I, $^M, $^N,
$OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80,
0x100, 0x200, $LAST_REGEXP_CODE_RESULT, $^R, $EXCEPTIONS_BEING_CAUGHT, $^S,
$BASETIME, $^T, $PERL_VERSION, $^V, $WARNING, $^W, ${^WARNING_BITS},
Requirements: should handle both byte and UTF8 strings. isPRINT()
characters printed as-is, character less than 256 as \xHH, Unicode
-characters as \x{HHH}.
+characters as \x{HHH}. Don't assume ASCII-like, either, get somebody
+on EBCDIC to test the output.
Possible options, controlled by the flags:
-- whitespace (other than ' ' of isPRINTF()) printed as-is
+- whitespace (other than ' ' of isPRINT()) printed as-is
- use isPRINT_LC() instead of isPRINT()
- print control characters like this: "\cA"
- print control characters like this: "^A"
-- non-printables printed as '.' instead of \xHH
-- print the \OOO instead of \xHH
+- non-PRINTables printed as '.' instead of \xHH
+- use \OOO instead of \xHH
+- use the C/Perl-metacharacters like \n, \t
- have a maximum length for the produced string (read it from *lenp)
- append a "..." to the produced string if the maximum length is exceeded
+- really fancy: print unicode characters as \N{...}
=head2 Autoload byte.pm
=item $+
-The last bracket matched by the last search pattern. This is useful if
-you don't know which one of a set of alternative patterns matched. For
-example:
+The text matched by the last bracket of the last successful search pattern.
+This is useful if you don't know which one of a set of alternative patterns
+matched. For example:
/Version: (.*)|Revision: (.*)/ && ($rev = $+);
(Mnemonic: be positive and forward looking.)
This variable is read-only and dynamically scoped to the current BLOCK.
+=item $^N
+
+The text matched by the used group most-recently closed (i.e. the group
+with the rightmost closing parenthesis) of the last successful search
+pattern. This is primarly used inside C<(?{...})> blocks for examining text
+recently matched. For example, to effectively capture text to a variable
+(in addition to C<$1>, C<$2>, etc.), replace C<(...)> with
+
+ (?:(...)(?{ $var = $^N }))
+
+By setting and then using C<$var> in this way relieves you from having to
+worry about exactly which numbered set of parentheses they are.
+
+This variable is dynamically scoped to the current BLOCK.
+
=item @LAST_MATCH_END
=item @+
MgOWNER(mg) = 0;
COND_SIGNAL(MgOWNERCONDP(mg));
DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(svv));)
+ PTR2UV(thr), PTR2UV(svv)));
MUTEX_UNLOCK(MgMUTEXP(mg));
}
#endif /* USE_THREADS */
if (!PM_GETRE(pm)->prelen && PL_curpm)
pm = PL_curpm;
- else if (strEQ("\\s+", PM_GETRE(pm)->precomp))
- pm->op_pmflags |= PMf_WHITE;
+ else
+ if (strEQ("\\s+", PM_GETRE(pm)->precomp))
+ pm->op_pmflags |= PMf_WHITE;
+ else
+ pm->op_pmflags &= ~PMf_WHITE;
/* XXX runtime compiled output needs to move to the pad */
if (pm->op_pmflags & PMf_KEEP) {
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: pp_entersub lock %p\n",
- thr, sv);)
+ thr, sv));
MUTEX_UNLOCK(MgMUTEXP(mg));
SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
}
DEBUG_S(if (CvDEPTH(cv) != 0)
PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
- CvDEPTH(cv)););
+ CvDEPTH(cv)));;
SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
}
}
MUTEX_LOCK(CvMUTEXP(cv));
DEBUG_S(if (CvDEPTH(cv) != 0)
PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
- CvDEPTH(cv)););
+ CvDEPTH(cv)));;
assert(thr == CvOWNER(cv));
CvOWNER(cv) = 0;
MUTEX_UNLOCK(CvMUTEXP(cv));
if (paren_elems_to_push < 0)
Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
-#define REGCP_OTHER_ELEMS 5
+#define REGCP_OTHER_ELEMS 6
SSCHECK(paren_elems_to_push + REGCP_OTHER_ELEMS);
for (p = PL_regsize; p > parenfloor; p--) {
/* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
/* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
SSPUSHINT(PL_regsize);
SSPUSHINT(*PL_reglastparen);
+ SSPUSHINT(*PL_reglastcloseparen);
SSPUSHPTR(PL_reginput);
#define REGCP_FRAME_ELEMS 2
/* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
i = SSPOPINT; /* Parentheses elements to pop. */
input = (char *) SSPOPPTR;
+ *PL_reglastcloseparen = SSPOPINT;
*PL_reglastparen = SSPOPINT;
PL_regsize = SSPOPINT;
PL_regstartp = prog->startp;
PL_regendp = prog->endp;
PL_reglastparen = &prog->lastparen;
+ PL_reglastcloseparen = &prog->lastcloseparen;
prog->lastparen = 0;
PL_regsize = 0;
DEBUG_r(PL_reg_starttry = startpos);
cache_re(re);
state.ss = PL_savestack_ix;
*PL_reglastparen = 0;
+ *PL_reglastcloseparen = 0;
PL_reg_call_cc = &state;
PL_reginput = locinput;
PL_regendp[n] = locinput - PL_bostr;
if (n > *PL_reglastparen)
*PL_reglastparen = n;
+ *PL_reglastcloseparen = n;
break;
case GROUPP:
n = ARG(scan); /* which paren pair */
I32 prelen; /* length of precomp */
U32 nparens; /* number of parentheses */
U32 lastparen; /* last paren matched */
+ U32 lastcloseparen; /* last paren matched */
U32 reganch; /* Internal use only +
Tainted information used by regexec? */
regnode program[1]; /* Unwarranted chumminess with compiler. */
if (mg->mg_type == PERL_MAGIC_qr) {
nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj);
}
+ else if(mg->mg_type == PERL_MAGIC_backref) {
+ AV *av = (AV*) mg->mg_obj;
+ SV **svp;
+ I32 i;
+ nmg->mg_obj = (SV*)newAV();
+ svp = AvARRAY(av);
+ i = AvFILLp(av);
+ while (i >= 0) {
+ av_push((AV*)nmg->mg_obj,sv_dup(svp[i],param));
+ i--;
+ }
+ }
else {
nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED)
? sv_dup_inc(mg->mg_obj, param)
break;
case SVt_RV:
SvANY(dstr) = new_XRV();
- SvRV(dstr) = SvRV(sstr) && SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvRV(sstr) && SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
break;
SvCUR(dstr) = SvCUR(sstr);
SvLEN(dstr) = SvLEN(sstr);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
SvLEN(dstr) = SvLEN(sstr);
SvIVX(dstr) = SvIVX(sstr);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
SvIVX(dstr) = SvIVX(sstr);
SvNVX(dstr) = SvNVX(sstr);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr), param);
SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr), param);
if (SvROK(sstr))
- SvRV(dstr) = SvWEAKREF(SvRV(sstr))
+ SvRV(dstr) = SvWEAKREF(sstr)
? sv_dup(SvRV(sstr), param)
: sv_dup_inc(SvRV(sstr), param);
else if (SvPVX(sstr) && SvLEN(sstr))
if (eval "\$ {\cX}" != 17 or $@) { print "not " }
print "ok 32\n";
- eval "\$\cN = 24"; # Literal control character
- if ($@ or ${"\cN"} != 24) { print "not " }
+ eval "\$\cQ = 24"; # Literal control character
+ if ($@ or ${"\cQ"} != 24) { print "not " }
print "ok 33\n";
- if ($^N != 24) { print "not " } # Control character escape sequence
+ if ($^Q != 24) { print "not " } # Control character escape sequence
print "ok 34\n";
# Does the old UNBRACED syntax still do what it used to?
print "ok 35\n";
sub XX () { 6 }
- $ {"\cN\cXX"} = 119;
- $^N = 5; # This should be an unused ^Var.
+ $ {"\cQ\cXX"} = 119;
+ $^Q = 5; # This should be an unused ^Var.
$N = 5;
# The second caret here should be interpreted as an xor
- if (($^N^XX) != 3) { print "not " }
+ if (($^Q^XX) != 3) { print "not " }
print "ok 36\n";
# if (($N ^ XX()) != 3) { print "not " }
# print "ok 32\n";
# Now let's make sure that caret variables are all forced into the main package.
package Someother;
- $^N = 'Someother';
- $ {^Nostril} = 'Someother 2';
+ $^Q = 'Someother';
+ $ {^Quixote} = 'Someother 2';
$ {^M} = 'Someother 3';
package main;
- print "not " unless $^N eq 'Someother';
+ print "not " unless $^Q eq 'Someother';
print "ok 39\n";
- print "not " unless $ {^Nostril} eq 'Someother 2';
+ print "not " unless $ {^Quixote} eq 'Someother 2';
print "ok 40\n";
print "not " unless $ {^M} eq 'Someother 3';
print "ok 41\n";
print "# ok, as string ++ of max_uv is \"$max_uv_pp\", numeric is $max_uv_p1\n"
} elsif ($opnames[$last] eq 'I' and $ans[1] eq "-1"
and $ans[0] eq $max_uv_p1_as_iv) {
+ # Max UV plus 1 is NV. This NV may stringify in E notation.
+ # And the number of decimal digits shown in E notation will depend
+ # on the binary digits in the mantissa. And it may be that
+ # (say) 18446744073709551616 in E notation is truncated to
+ # (say) 1.8446744073709551e+19 (say) which gets converted back
+ # as 1.8446744073709551000e+19
+ # ie 18446744073709551000
+ # which isn't the integer we first had.
+ # But each step of conversion is correct. So it's not an error.
+ # (Only shows up for 64 bit UVs and NVs with 64 bit mantissas,
+ # and on Crays (64 bit integers, 48 bit mantissas) IIRC)
print "# ok, \"$max_uv_p1\" correctly converts to IV \"$max_uv_p1_as_iv\"\n";
} elsif ($opnames[$last] eq 'U' and $ans[1] eq ~0
and $ans[0] eq $max_uv_p1_as_uv) {
+ # as aboce
print "# ok, \"$max_uv_p1\" correctly converts to UV \"$max_uv_p1_as_uv\"\n";
} elsif (grep {/^N$/} @opnames[@{$curops[0]}]
- and $ans[0] == $ans[1] and $ans[0] <= ~0) {
+ and $ans[0] == $ans[1] and $ans[0] <= ~0
+ # First must be in E notation (ie not just digits) and
+ # second must still be an integer.
+ # I can't remember why there isn't symmetry in this
+ # exception, ie why only the first ops are tested for 'N'
+ and $ans[0] !~ /^-?\d+$/ and $ans[0] !~ /^-?\d+$/) {
print "# ok, numerically equal - notation changed due to adding zero\n";
} else {
$nok++,
}
}
}
- print "not " if $nok;
- print "ok $test\n";
+ if ($nok) {
+ print "not ok $test\n";
+ } else {
+ print "ok $test\n";
+ }
#print $txt if $nok;
$test++;
}
$| = 1;
-print "1..639\n";
+print "1..660\n";
BEGIN {
chdir 't' if -d 't';
print "not " unless " " =~ /[[:print:]]/;
print "ok 639\n";
+##
+## Test basic $^N usage outside of a regex
+##
+$x = "abcdef";
+$T="ok 640\n";if ($x =~ /cde/ and not defined $^N) {print $T} else {print "not $T"};
+$T="ok 641\n";if ($x =~ /(cde)/ and $^N eq "cde") {print $T} else {print "not $T"};
+$T="ok 642\n";if ($x =~ /(c)(d)(e)/ and $^N eq "e") {print $T} else {print "not $T"};
+$T="ok 643\n";if ($x =~ /(c(d)e)/ and $^N eq "cde") {print $T} else {print "not $T"};
+$T="ok 644\n";if ($x =~ /(foo)|(c(d)e)/ and $^N eq "cde") {print $T} else {print "not $T"};
+$T="ok 645\n";if ($x =~ /(c(d)e)|(foo)/ and $^N eq "cde") {print $T} else {print "not $T"};
+$T="ok 646\n";if ($x =~ /(c(d)e)|(abc)/ and $^N eq "abc") {print $T} else {print "not $T"};
+$T="ok 647\n";if ($x =~ /(c(d)e)|(abc)x/ and $^N eq "cde") {print $T} else {print "not $T"};
+$T="ok 648\n";if ($x =~ /(c(d)e)(abc)?/ and $^N eq "cde") {print $T} else {print "not $T"};
+$T="ok 649\n";if ($x =~ /(?:c(d)e)/ and $^N eq "d" ) {print $T} else {print "not $T"};
+$T="ok 650\n";if ($x =~ /(?:c(d)e)(?:f)/ and $^N eq "d" ) {print $T} else {print "not $T"};
+$T="ok 651\n";if ($x =~ /(?:([abc])|([def]))*/ and $^N eq "f" ){print $T} else {print "not $T"};
+$T="ok 652\n";if ($x =~ /(?:([ace])|([bdf]))*/ and $^N eq "f" ){print $T} else {print "not $T"};
+$T="ok 653\n";if ($x =~ /(([ace])|([bd]))*/ and $^N eq "e" ){print $T} else {print "not $T"};
+{
+ $T="ok 654\n";if($x =~ /(([ace])|([bdf]))*/ and $^N eq "f" ){print $T} else {print "not $T"};
+}
+## test to see if $^N is automatically localized -- it should now
+## have the value set in test 653
+$T="ok 655\n";if ($^N eq "e" ){print $T} else {print "not $T"};
+
+##
+## Now test inside (?{...})
+##
+$T="ok 656\n";if ($x =~ /a([abc])(?{$y=$^N})c/ and $y eq "b" ){print $T} else {print "not $T"};
+$T="ok 657\n";if ($x =~ /a([abc]+)(?{$y=$^N})d/ and $y eq "bc"){print $T} else {print "not $T"};
+$T="ok 658\n";if ($x =~ /a([abcdefg]+)(?{$y=$^N})d/ and $y eq "bc"){print $T} else {print "not $T"};
+$T="ok 659\n";if ($x =~ /(a([abcdefg]+)(?{$y=$^N})d)(?{$z=$^N})e/ and $y eq "bc" and $z eq "abcd")
+ {print $T} else {print "not $T"};
+$T="ok 660\n";if ($x =~ /(a([abcdefg]+)(?{$y=$^N})de)(?{$z=$^N})/ and $y eq "bc" and $z eq "abcde")
+ {print $T} else {print "not $T"};
@INC = '../lib';
}
-print "1..44\n";
+print "1..45\n";
$FS = ':';
print "ok 44\n";
}
+{
+ # check that PMf_WHITE is cleared after \s+ is used
+ # reported in <20010627113312.RWGY6087.viemta06@localhost>
+ my $r;
+ foreach my $pat ( qr/\s+/, qr/ll/ ) {
+ $r = join ':' => split($pat, "hello cruel world");
+ }
+ print "not " unless $r eq "he:o cruel world";
+ print "ok 45\n";
+}
--- /dev/null
+#!./perl
+#
+# Tests for perl exit codes, playing with $?, etc...
+
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+# VMS needs -e "...", most everything else works better with '
+my $quote = $^O eq 'VMS' ? q{"} : q{'};
+
+# Run some code, return its wait status.
+sub run {
+ my($code) = shift;
+ my $cmd = "$^X -e ";
+ return system($cmd.$quote.$code.$quote);
+}
+
+use Test::More tests => 3;
+
+my $exit;
+
+$exit = run('exit');
+is( $exit >> 8, 0, 'Normal exit' );
+
+$exit = run('exit 42');
+is( $exit >> 8, 42, 'Non-zero exit' );
+
+$exit = run('END { $? = 42 }');
+is( $exit >> 8, 42, 'Changing $? in END block' );
PERLVAR(Tregstartp, I32 *) /* Pointer to startp array. */
PERLVAR(Tregendp, I32 *) /* Ditto for endp. */
PERLVAR(Treglastparen, U32 *) /* Similarly for lastparen. */
+PERLVAR(Treglastcloseparen, U32 *) /* Similarly for lastcloseparen. */
PERLVAR(Tregtill, char *) /* How far we are required to go. */
PERLVAR(Tregcompat1, char) /* used to be regprev1 */
PERLVAR(Treg_start_tmp, char **) /* from regexec.c */
mg->mg_len = sizeof(cp);
UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */
DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log,
- "%p: condpair_magic %p\n", thr, sv));)
+ "%p: condpair_magic %p\n", thr, sv)));
}
}
return mg;
MgOWNER(mg) = thr;
DEBUG_S(PerlIO_printf(Perl_debug_log,
"0x%"UVxf": Perl_lock lock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv));)
+ PTR2UV(thr), PTR2UV(sv)));
MUTEX_UNLOCK(MgMUTEXP(mg));
SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
projects / p5sagit/p5-mst-13.2.git / commitdiff