diff options
| -rw-r--r-- | MANIFEST | 3 | ||||
| -rw-r--r-- | Makefile.SH | 7 | ||||
| -rw-r--r-- | doio.c | 15 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 2 | ||||
| -rw-r--r-- | gv.c | 2 | ||||
| -rw-r--r-- | lib/Benchmark.pm | 4 | ||||
| -rw-r--r-- | lib/ExtUtils/MM_Unix.pm | 4 | ||||
| -rw-r--r-- | pod/perldebug.pod | 2 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 72 | ||||
| -rw-r--r-- | pod/perlop.pod | 13 | ||||
| -rw-r--r-- | pod/perlre.pod | 5 | ||||
| -rw-r--r-- | pod/perltie.pod | 6 | ||||
| -rw-r--r-- | pod/perltrap.pod | 4 | ||||
| -rw-r--r-- | sv.c | 4 | ||||
| -rwxr-xr-x | t/io/pipe.t | 1 | ||||
| -rw-r--r-- | t/lib/h2ph.h | 85 | ||||
| -rw-r--r-- | t/lib/h2ph.pht | 69 | ||||
| -rwxr-xr-x | t/lib/h2ph.t | 28 | ||||
| -rw-r--r-- | utils/h2ph.PL | 78 |
20 files changed, 334 insertions, 76 deletions
@@ -781,6 +781,9 @@ t/lib/filepath.t See if File::Path works t/lib/findbin.t See if FindBin works t/lib/gdbm.t See if GDBM_File works t/lib/getopt.t See if Getopt::Std and Getopt::Long works +t/lib/h2ph.h Test header file for h2ph +t/lib/h2ph.pht Generated output from h2ph.h by h2ph, for comparison +t/lib/h2ph.t See if h2ph works like it should t/lib/hostname.t See if Sys::Hostname works t/lib/io_dup.t See if dup()-related methods from IO work t/lib/io_pipe.t See if pipe()-related methods from IO work diff --git a/Makefile.SH b/Makefile.SH index a70b53e4fe..4f78f57d74 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -552,7 +552,7 @@ depend: makedepend makedepend: makedepend.SH config.sh sh ./makedepend.SH -test-prep: miniperl perl preplibrary $(dynamic_ext) +test-prep: miniperl perl preplibrary utilities $(dynamic_ext) cd t && (rm -f perl$(EXE_EXT); $(LNS) ../perl$(EXE_EXT) perl$(EXE_EXT)) test check: test-prep @@ -573,10 +573,13 @@ minitest: miniperl # Handy way to run perlbug -ok without having to install and run the # installed perlbug. We don't re-run the tests here - we trust the user. # Please *don't* use this unless all tests pass. -# If you want to report test failures, just use "perlbug -Ilib". +# If you want to report test failures, use "make nok" instead. ok: utilities $(LBLIBPTH) ./perl -Ilib utils/perlbug -ok -s '(UNINSTALLED)' +nok: utilities + $(LBLIBPTH) ./perl -Ilib utils/perlbug -nok -s '(UNINSTALLED)' + clist: $(c) echo $(c) | tr ' ' '\012' >.clist @@ -579,14 +579,17 @@ do_close(GV *gv, bool not_implicit) if (!gv) gv = argvgv; if (!gv || SvTYPE(gv) != SVt_PVGV) { - SETERRNO(EBADF,SS$_IVCHAN); + if (not_implicit) + SETERRNO(EBADF,SS$_IVCHAN); return FALSE; } io = GvIO(gv); if (!io) { /* never opened */ - if (dowarn && not_implicit) - warn("Close on unopened file <%s>",GvENAME(gv)); - SETERRNO(EBADF,SS$_IVCHAN); + if (not_implicit) { + if (dowarn) + warn("Close on unopened file <%s>",GvENAME(gv)); + SETERRNO(EBADF,SS$_IVCHAN); + } return FALSE; } retval = io_close(io); @@ -1085,7 +1088,7 @@ apply(I32 type, register SV **mark, register SV **sp) SV **oldmark = mark; #define APPLY_TAINT_PROPER() \ - if (!(tainting && tainted)) {} else { goto taint_proper; } + if (!(tainting && tainted)) {} else { goto taint_proper_label; } /* This is a first heuristic; it doesn't catch tainting magic. */ if (tainting) { @@ -1271,7 +1274,7 @@ nothing in the core. } return tot; - taint_proper: + taint_proper_label: TAINT_PROPER(what); return 0; /* this should never happen */ diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 6b9611129f..661592e7fe 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -44,7 +44,7 @@ #include <sys/types.h> #include <time.h> #ifdef I_UNISTD -#include <unistd.h> /* see hints/sunos_4_1.sh */ +#include <unistd.h> #endif #include <fcntl.h> @@ -722,7 +722,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type) SPAGAIN; stash = gv_stashpvn("Errno",5,FALSE); if (!stash || !(gv_fetchmethod(stash, "TIEHASH"))) - croak("Can't use %%! because Errno.pm is not avaliable"); + croak("Can't use %%! because Errno.pm is not available"); } } goto magicalize; diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index 920968d01d..f490998039 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -115,7 +115,9 @@ call timethis(COUNT, VALUE, KEY, STYLE) -The Count can be zero or negative, see timethis(). +The routines are called in string comparison order of KEY. + +The COUNT can be zero or negative, see timethis(). =item timediff ( T1, T2 ) diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 99ca0bd1fb..101812145d 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -1005,8 +1005,8 @@ $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists if ($^O eq 'solaris'); # The IRIX linker also doesn't use LD_RUN_PATH - $ldrun = "-rpath $self->{LD_RUN_PATH}" - if ($^O eq 'irix'); + $ldrun = qq{-rpath "$self->{LD_RUN_PATH}"} + if ($^O eq 'irix' && $self->{LD_RUN_PATH}); push(@m,' LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ '.$ldrun.' $(LDDLFLAGS) '.$ldfrom. ' $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)'); diff --git a/pod/perldebug.pod b/pod/perldebug.pod index 8f49541b40..cb042e9752 100644 --- a/pod/perldebug.pod +++ b/pod/perldebug.pod @@ -1083,7 +1083,7 @@ file. Some functions are provided to simplify customization. See L<"Debugger Customization"> for description of C<DB::parse_options(string)>. The function C<DB::dump_trace(skip[, count])> skips the specified number -of frames, and returns an array containing info about the caller +of frames, and returns a list containing info about the caller frames (all if C<count> is missing). Each entry is a hash with keys C<context> (C<$> or C<@>), C<sub> (subroutine name, or info about eval), C<args> (C<undef> or a reference to an array), C<file>, and diff --git a/pod/perldiag.pod b/pod/perldiag.pod index b23dcc537a..8dd2f823a0 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -823,6 +823,12 @@ message indicates that such a conversion was attempted. of upgradability. Upgrading to undef indicates an error in the code calling sv_upgrade. +=item Can't use %%! because Errno.pm is not available + +(F) The first time the %! hash is used, perl automatically loads the +Errno.pm module. The Errno module is expected to tie the %! hash to +provide symbolic names for C<$!> errno values. + =item Can't use "my %s" in sort comparison (F) The global variables $a and $b are reserved for sort comparisons. diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 16292f67da..e867a0c65d 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -603,6 +603,25 @@ it can be used to increment a loop variable, even when the loop has been continued via the C<next> statement (which is similar to the C C<continue> statement). +C<last>, C<next>, or C<redo> may appear within a C<continue> +block. C<last> and C<redo> will behave as if they had been executed within +the main block. So will C<next>, but since it will execute a C<continue> +block, it may be more entertaining. + + while (EXPR) { + ### redo always comes here + do_something; + } continue { + ### next always comes here + do_something_else; + # then back the top to re-check EXPR + } + ### last always comes here + +Omitting the C<continue> section is semantically equivalent to using an +empty one, logically enough. In that case, C<next> goes directly back +to check the condition at the top of the loop. + =item cos EXPR Returns the cosine of EXPR (expressed in radians). If EXPR is omitted @@ -673,8 +692,8 @@ variables, not set them. If you want to test whether you can write, either use file tests or try setting a dummy hash entry inside an eval(), which will trap the error. -Note that functions such as keys() and values() may return huge array -values when used on large DBM files. You may prefer to use the each() +Note that functions such as keys() and values() may return huge lists +when used on large DBM files. You may prefer to use the each() function to iterate over large DBM files. Example: # print out history file offsets @@ -908,7 +927,7 @@ Example: =item each HASH -When called in a list context, returns a 2-element array consisting of the +When called in a list context, returns a 2-element list consisting of the key and value for the next element of a hash, so that you can iterate over it. When called in a scalar context, returns the key for only the next element in the hash. (Note: Keys may be "0" or "", which are logically @@ -1707,8 +1726,8 @@ See L<perlfunc/split>. =item keys HASH -Returns a normal array consisting of all the keys of the named hash. (In -a scalar context, returns the number of keys.) The keys are returned in +Returns a list consisting of all the keys of the named hash. (In a +scalar context, returns the number of keys.) The keys are returned in an apparently random order, but it is the same order as either the values() or each() function produces (given that the hash has not been modified). As a side effect, it resets HASH's iterator. @@ -1777,6 +1796,9 @@ C<continue> block, if any, is not executed: ... } +See also L</continue> for an illustration of how C<last>, C<next>, and +C<redo> work. + =item lc EXPR =item lc @@ -1967,6 +1989,9 @@ Note that if there were a C<continue> block on the above, it would get executed even on discarded lines. If the LABEL is omitted, the command refers to the innermost enclosing loop. +See also L</continue> for an illustration of how C<last>, C<next>, and +C<redo> work. + =item no Module LIST See the "use" function, which "no" is the opposite of. @@ -2567,6 +2592,9 @@ themselves about what was just input: print; } +See also L</continue> for an illustration of how C<last>, C<next>, and +C<redo> work. + =item ref EXPR =item ref @@ -3196,7 +3224,7 @@ Splits a string into an array of strings, and returns it. If not in a list context, returns the number of fields found and splits into the @_ array. (In a list context, you can force the split into @_ by -using C<??> as the pattern delimiters, but it still returns the array +using C<??> as the pattern delimiters, but it still returns the list value.) The use of implicit split to @_ is deprecated, however. If EXPR is omitted, splits the $_ string. If PATTERN is also omitted, @@ -3395,11 +3423,10 @@ one-third of the time. So don't do that. =item stat -Returns a 13-element array giving the status info for a file, either the -file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted, it -stats $_. Returns a null list if the stat fails. Typically used as -follows: - +Returns a 13-element list giving the status info for a file, either +the file opened via FILEHANDLE, or named by EXPR. If EXPR is omitted, +it stats $_. Returns a null list if the stat fails. Typically used +as follows: ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,$blksize,$blocks) @@ -3434,6 +3461,10 @@ last stat or filetest are returned. Example: (This works on machines only for which the device number is negative under NFS.) +In scalar context, C<stat> returns a boolean value indicating success +or failure, and, if successful, sets the information associated with +the special filehandle C<_>. + =item study SCALAR =item study @@ -3741,9 +3772,9 @@ function of C. The object returned by the "new" method is also returned by the tie() function, which would be useful if you want to access other methods in CLASSNAME. -Note that functions such as keys() and values() may return huge array -values when used on large objects, like DBM files. You may prefer to -use the each() function to iterate over such. Example: +Note that functions such as keys() and values() may return huge lists +when used on large objects, like DBM files. You may prefer to use the +each() function to iterate over such. Example: # print out history file offsets use NDBM_File; @@ -3801,7 +3832,7 @@ Suitable for feeding to gmtime() and localtime(). =item times -Returns a four-element array giving the user and system times, in +Returns a four-element list giving the user and system times, in seconds, for this process and the children of this process. ($user,$system,$cuser,$csystem) = times; @@ -4026,11 +4057,12 @@ command if the files already exist: =item values HASH -Returns a normal array consisting of all the values of the named hash. -(In a scalar context, returns the number of values.) The values are -returned in an apparently random order, but it is the same order as either -the keys() or each() function would produce on the same hash. As a side -effect, it resets HASH's iterator. See also keys(), each(), and sort(). +Returns a list consisting of all the values of the named hash. (In a +scalar context, returns the number of values.) The values are +returned in an apparently random order, but it is the same order as +either the keys() or each() function would produce on the same hash. +As a side effect, it resets HASH's iterator. See also keys(), each(), +and sort(). =item vec EXPR,OFFSET,BITS diff --git a/pod/perlop.pod b/pod/perlop.pod index 538745dd6a..cae38ebf55 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -601,11 +601,16 @@ a transliteration, the first ten of these sequences may be used. \L lowercase till \E \U uppercase till \E \E end case modification - \Q quote regexp metacharacters till \E + \Q quote non-word characters till \E If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u> and C<\U> is taken from the current locale. See L<perllocale>. +You cannot include a literal C<$> or C<@> within a C<\Q> sequence. +An unescaped C<$> or C<@> interpolates the corresponding variable, +while escaping will cause the literal string C<\$> to be inserted. +You'll need to write something like C<m/\Quser\E\@\Qhost/>. + Patterns are subject to an additional level of interpretation as a regular expression. This is done as a second pass, after variables are interpolated, so that regular expressions may be incorporated into the @@ -681,9 +686,9 @@ successfully matched regular expression is used instead. If used in a context that requires a list value, a pattern match returns a list consisting of the subexpressions matched by the parentheses in the pattern, i.e., (C<$1>, $2, $3...). (Note that here $1 etc. are also set, and -that this differs from Perl 4's behavior.) If the match fails, a null -array is returned. If the match succeeds, but there were no parentheses, -a list value of (1) is returned. +that this differs from Perl 4's behavior.) If there are no parentheses, +the return value is the list C<(1)> for success or C<('')> upon failure. +With parentheses, C<()> is returned upon failure. Examples: diff --git a/pod/perlre.pod b/pod/perlre.pod index 68ce4b9bf7..8fb582074c 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -148,6 +148,11 @@ also work: If C<use locale> is in effect, the case map used by C<\l>, C<\L>, C<\u> and C<\U> is taken from the current locale. See L<perllocale>. +You cannot include a literal C<$> or C<@> within a C<\Q> sequence. +An unescaped C<$> or C<@> interpolates the corresponding variable, +while escaping will cause the literal string C<\$> to be matched. +You'll need to write something like C<m/\Quser\E\@\Qhost/>. + In addition, Perl defines the following: \w Match a "word" character (alphanumeric plus "_") diff --git a/pod/perltie.pod b/pod/perltie.pod index 398c3a0d29..da4fbe99cf 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -603,9 +603,9 @@ or have auxiliary state to clean up. Here's a very simple function: =back -Note that functions such as keys() and values() may return huge array -values when used on large objects, like DBM files. You may prefer to -use the each() function to iterate over such. Example: +Note that functions such as keys() and values() may return huge lists +when used on large objects, like DBM files. You may prefer to use the +each() function to iterate over such. Example: # print out history file offsets use NDBM_File; diff --git a/pod/perltrap.pod b/pod/perltrap.pod index 9d861e3ae5..4159777146 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -451,8 +451,8 @@ Also see precedence traps, for parsing C<$:>. The second and third arguments of C<splice()> are now evaluated in scalar context (as the Camel says) rather than list context. - sub sub1{return(0,2) } # return a 2-elem array - sub sub2{ return(1,2,3)} # return a 3-elem array + sub sub1{return(0,2) } # return a 2-element list + sub sub2{ return(1,2,3)} # return a 3-element list @a1 = ("a","b","c","d","e"); @a2 = splice(@a1,&sub1,&sub2); print join(' ',@a2),"\n"; @@ -1703,7 +1703,7 @@ sv_2pv(register SV *sv, STRLEN *lp) case SVt_PVHV: s = "HASH"; break; case SVt_PVCV: s = "CODE"; break; case SVt_PVGV: s = "GLOB"; break; - case SVt_PVFM: s = "FORMLINE"; break; + case SVt_PVFM: s = "FORMAT"; break; case SVt_PVIO: s = "IO"; break; default: s = "UNKNOWN"; break; } @@ -3993,7 +3993,7 @@ sv_reftype(SV *sv, int ob) case SVt_PVHV: return "HASH"; case SVt_PVCV: return "CODE"; case SVt_PVGV: return "GLOB"; - case SVt_PVFM: return "FORMLINE"; + case SVt_PVFM: return "FORMAT"; default: return "UNKNOWN"; } } diff --git a/t/io/pipe.t b/t/io/pipe.t index 4a7cb7a423..63614f5f4f 100755 --- a/t/io/pipe.t +++ b/t/io/pipe.t @@ -59,6 +59,7 @@ close READER; $SIG{'PIPE'} = 'broken_pipe'; sub broken_pipe { + $SIG{'PIPE'} = 'IGNORE'; # loop preventer print "ok 7\n"; } diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h new file mode 100644 index 0000000000..cddf0a7d94 --- /dev/null +++ b/t/lib/h2ph.h @@ -0,0 +1,85 @@ +/* + * Test header file for h2ph + * + * Try to test as many constructs as possible + * For example, the multi-line comment :) + */ + +/* And here's a single line comment :) */ + +/* Test #define with no indenting, over multiple lines */ +#define SQUARE(x) \ +((x)*(x)) + +/* Test #ifndef and parameter interpretation*/ +#ifndef ERROR +#define ERROR(x) fprintf(stderr, "%s\n", x[2][3][0]) +#endif /* ERROR */ + +#ifndef _H2PH_H_ +#define _H2PH_H_ + +/* #ident - doesn't really do anything, but I think it always gets included anyway */ +#ident "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $" + +/* Test #undef */ +#undef MAX +#define MAX(a,b) ((a) > (b) ? (a) : (b)) + +/* Test #ifdef */ +#ifdef __SOME_UNIMPORTANT_PROPERTY +#define MIN(a,b) ((a) < (b) ? (a) : (b)) +#endif /* __SOME_UNIMPORTANT_PROPERTY */ + +/* + * Test #if, #elif, #else, #endif, #warn and #error, and `!' + * Also test whitespace between the `#' and the command + */ +#if !(defined __SOMETHING_MORE_IMPORTANT) +# warn Be careful... +#elif !(defined __SOMETHING_REALLY_REALLY_IMPORTANT) +# error Nup, can't go on /* ' /* stupid font-lock-mode */ +#else /* defined __SOMETHING_MORE_IMPORTANT && defined __SOMETHING_REALLY_REALLY_IMPORTANT */ +# define EVERYTHING_IS_OK +#endif + +/* Test && and || */ +#undef WHATEVER +#if (!((defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO)) \ + || defined __SOMETHING_OVERPOWERING) +# define WHATEVER 6 +#elif !(defined __SOMETHING_TRIVIAL) /* defined __SOMETHING_LESS_SO */ +# define WHATEVER 7 +#elif !(defined __SOMETHING_LESS_SO) /* defined __SOMETHING_TRIVIAL */ +# define WHATEVER 8 +#else /* defined __SOMETHING_TRIVIAL && defined __SOMETHING_LESS_SO */ +# define WHATEVER 1000 +#endif + +/* + * Test #include, #import and #include_next + * #include_next is difficult to test, it really depends on the actual + * circumstances - for example, `#include_next <limits.h>' on a Linux system + * with `use lib qw(/opt/perl5/lib/site_perl/i586-linux/linux);' or whatever + * your equivalent is... + */ +#include <sys/socket.h> +#import "sys/ioctl.h" +#include_next <sys/fcntl.h> + +/* typedefs should be ignored */ +typedef struct a_struct { + int typedefs_should; + char be_ignored; + long as_well; +} a_typedef; + +/* + * however, typedefs of enums and just plain enums should end up being treated + * like a bunch of #defines... + */ + +typedef enum _days_of_week { sun, mon, tue, wed, thu, fri, sat, Sun=0, Mon, + Tue, Wed, Thu, Fri, Sat } days_of_week; + +#endif /* _H2PH_H_ */ diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht new file mode 100644 index 0000000000..80867a6113 --- /dev/null +++ b/t/lib/h2ph.pht @@ -0,0 +1,69 @@ +unless(defined(&SQUARE)) { + sub SQUARE { + local($x) = @_; + eval q((($x)*($x))); + } +} +unless(defined(&ERROR)) { + eval 'sub ERROR { + local($x) = @_; + eval q( &fprintf( &stderr, \\"%s\\\\n\\", $x->[2][3][0])); + }' unless defined(&ERROR); +} +unless(defined(&_H2PH_H_)) { + eval 'sub _H2PH_H_ () {1;}' unless defined(&_H2PH_H_); + # "$Revision h2ph.h,v 1.0 98/05/04 20:42:14 billy $" + undef(&MAX) if defined(&MAX); + eval 'sub MAX { + local($a,$b) = @_; + eval q((($a) > ($b) ? ($a) : ($b))); + }' unless defined(&MAX); + if(defined(&__SOME_UNIMPORTANT_PROPERTY)) { + eval 'sub MIN { + local($a,$b) = @_; + eval q((($a) < ($b) ? ($a) : ($b))); + }' unless defined(&MIN); + } + if(!(defined (defined(&__SOMETHING_MORE_IMPORTANT) ? &__SOMETHING_MORE_IMPORTANT : 0))) { + } + elsif(!(defined (defined(&__SOMETHING_REALLY_REALLY_IMPORTANT) ? &__SOMETHING_REALLY_REALLY_IMPORTANT : 0))) { + die("Nup, can't go on "); + } else { + eval 'sub EVERYTHING_IS_OK () {1;}' unless defined(&EVERYTHING_IS_OK); + } + undef(&WHATEVER) if defined(&WHATEVER); + if((!((defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0) && defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0))) || defined (defined(&__SOMETHING_OVERPOWERING) ? &__SOMETHING_OVERPOWERING : 0))) { + eval 'sub WHATEVER () {6;}' unless defined(&WHATEVER); + } + elsif(!(defined (defined(&__SOMETHING_TRIVIAL) ? &__SOMETHING_TRIVIAL : 0)) ) { + eval 'sub WHATEVER () {7;}' unless defined(&WHATEVER); + } + elsif(!(defined (defined(&__SOMETHING_LESS_SO) ? &__SOMETHING_LESS_SO : 0)) ) { + eval 'sub WHATEVER () {8;}' unless defined(&WHATEVER); + } else { + eval 'sub WHATEVER () {1000;}' unless defined(&WHATEVER); + } + require 'sys/socket.ph'; + require 'sys/ioctl.ph'; + eval { + my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC)); + my(@REM) = map { "$_/sys/fcntl.ph" } (grep { not exists($INCD{"$_/sys/fcntl.ph"})and -f "$_/sys/fcntl.ph" } @INC); + require "$REM[0]" if @REM; + }; + warn($@) if $@; + eval("sub sun () { 0; }") unless defined(&sun); + eval("sub mon () { 1; }") unless defined(&mon); + eval("sub tue () { 2; }") unless defined(&tue); + eval("sub wed () { 3; }") unless defined(&wed); + eval("sub thu () { 4; }") unless defined(&thu); + eval("sub fri () { 5; }") unless defined(&fri); + eval("sub sat () { 6; }") unless defined(&sat); + eval("sub Sun () { 0; }") unless defined(&Sun); + eval("sub Mon () { 1; }") unless defined(&Mon); + eval("sub Tue () { 2; }") unless defined(&Tue); + eval("sub Wed () { 3; }") unless defined(&Wed); + eval("sub Thu () { 4; }") unless defined(&Thu); + eval("sub Fri () { 5; }") unless defined(&Fri); + eval("sub Sat () { 6; }") unless defined(&Sat); +} +1; diff --git a/t/lib/h2ph.t b/t/lib/h2ph.t new file mode 100755 index 0000000000..a486feb6d2 --- /dev/null +++ b/t/lib/h2ph.t @@ -0,0 +1,28 @@ +#!./perl + +# quickie tests to see if h2ph actually runs and does more or less what is +# expected + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use File::Compare; +print "1..2\n"; + +unless(-e '../utils/h2ph') { + print("ok 1\nok 2\n"); + # i'll probably get in trouble for this :) +} else { + # does it run? + $ok = system("./perl -I../lib ../utils/h2ph -d. lib/h2ph.h"); + print(($ok == 0 ? "" : "not "), "ok 1\n"); + + # does it work? well, does it do what we expect? :-) + $ok = compare("lib/h2ph.ph", "lib/h2ph.pht"); + print(($ok == 0 ? "" : "not "), "ok 2\n"); + + # cleanup - should this be in an END block? + unlink("lib/h2ph.ph"); +} diff --git a/utils/h2ph.PL b/utils/h2ph.PL index 730c2259e7..da7bb64843 100644 --- a/utils/h2ph.PL +++ b/utils/h2ph.PL @@ -112,7 +112,7 @@ while (defined ($file = next_file())) { redo; } } - if (s/^\s*#\s*//) { + if (s/^\s*\#\s*//) { if (s/^define\s+(\w+)//) { $name = $1; $new = ''; @@ -171,37 +171,25 @@ while (defined ($file = next_file())) { print OUT $t,"require '$incl';\n"; } elsif(/^include_next\s*[<"](.*)[>"]/) { ($incl = $1) =~ s/\.h$/.ph/; - # should've read up on #include_next properly before attempting - # to implement it... - # - #print OUT $t, "{\n"; - #$tab += 4; - #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - #print OUT $t, "my(\$INC) = shift(\@INC);\n"; - #print OUT $t, "require '$incl';\n"; - #print OUT $t, "unshift(\@INC, \$INC);}\n"; - #$tab -= 4; - #$t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - #print OUT $t, "}\n"; - # - # try this instead: - print OUT ($t, "my(\$i) = 0;\n"); - print OUT ($t, "if(exists(\$INC{$incl})) {\n"); - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT ($t, "++\$i while (\$i <= \$#INC", - " and \$INC[\$i].'/$incl' ne \$INC{'$incl'});\n"); - print OUT ($t, "\$i = 0 if \$INC[\$i].'/$incl' ne", - " \$INC{'$incl'};\n"); - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT ($t, "}\n"); print OUT ($t, - "eval(\"require '\" . ", - "(\$i ? \$INC[\$i].'/' : '') . \"\$incl';\");"); - # any better? require is smart enough not to try and include a - # file twice, i believe, so require-ing the same actual file - # should end up just being a null operation... + "eval {\n"); + $tab += 4; + $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); + print OUT ($t, + "my(\%INCD) = map { \$INC{\$_} => 1 } ", + "(grep { \$_ eq \"$incl\" } keys(\%INC));\n"); + print OUT ($t, + "my(\@REM) = map { \"\$_/$incl\" } ", + "(grep { not exists(\$INCD{\"\$_/$incl\"})", + "and -f \"\$_/$incl\" } \@INC);\n"); + print OUT ($t, + "require \"\$REM[0]\" if \@REM;\n"); + $tab -= 4; + $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); + print OUT ($t, + "};\n"); + print OUT ($t, + "warn(\$\@) if \$\@;\n"); } elsif (/^ifdef\s+(\w+)/) { print OUT $t,"if(defined(&$1)) {\n"; $tab += 4; @@ -247,6 +235,34 @@ while (defined ($file = next_file())) { } elsif(/^ident\s+(.*)/) { print OUT $t, "# $1\n"; } + } elsif(/^\s*(typedef\s*)?enum\b/) { + until(/\}.*?;/) { + chomp($next = <IN>); + $_ .= $next; + print OUT "# $next\n" if $opt_D; + } + s@/\*.*?\*/@@g; + s/\s+/ /g; + /^\s?(typedef\s?)?enum\s?([a-zA-Z_]\w*)?\s?\{(.*)\}\s?([a-zA-Z_]\w*)?\s?;/; + ($enum_subs = $3) =~ s/\s//g; + @enum_subs = split(/,/, $enum_subs); + $enum_val = -1; + for $enum (@enum_subs) { + ($enum_name, $enum_value) = $enum =~ /^([a-zA-Z_]\w*)(=.+)?$/; + $enum_value =~ s/^=//; + $enum_val = (length($enum_value) ? $enum_value : $enum_val + 1); + if ($opt_h) { + print OUT ($t, + "eval(\"\\n#line $eval_index $outfile\\n", + "sub $enum_name () \{ $enum_val; \}\") ", + "unless defined(\&$enum_name);\n"); + ++ $eval_index; + } else { + print OUT ($t, + "eval(\"sub $enum_name () \{ $enum_val; \}\") ", + "unless defined(\&$enum_name);\n"); + } + } } } print OUT "1;\n"; |