[win32] merge changes#1014,1038 from maintbranch
authorGurusamy Sarathy <gsar@cpan.org>
Fri, 29 May 1998 02:31:44 +0000 (02:31 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Fri, 29 May 1998 02:31:44 +0000 (02:31 +0000)
p4raw-link: @1038 on //depot/maint-5.004/perl: c3cf4c2be38f0215f451c3dd6cb13089e5f2329f
p4raw-link: @1014 on //depot/maint-5.004/perl: d14230f9721c31ac6e9e2fdb706c7fc95118b4e6

p4raw-id: //depot/win32/perl@1052

20 files changed:
MANIFEST
Makefile.SH
doio.c
ext/POSIX/POSIX.xs
gv.c
lib/Benchmark.pm
lib/ExtUtils/MM_Unix.pm
pod/perldebug.pod
pod/perldiag.pod
pod/perlfunc.pod
pod/perlop.pod
pod/perlre.pod
pod/perltie.pod
pod/perltrap.pod
sv.c
t/io/pipe.t
t/lib/h2ph.h [new file with mode: 0644]
t/lib/h2ph.pht [new file with mode: 0644]
t/lib/h2ph.t [new file with mode: 0755]
utils/h2ph.PL

index ccb78e4..3041ffd 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index a70b53e..4f78f57 100644 (file)
@@ -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
 
diff --git a/doio.c b/doio.c
index 37d6167..94311c1 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -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 */
 
index 6b96111..661592e 100644 (file)
@@ -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>
 
diff --git a/gv.c b/gv.c
index 6ee8d23..a6b7687 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -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;
index 920968d..f490998 100644 (file)
@@ -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 )
 
index 99ca0bd..1018121 100644 (file)
@@ -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)');
index 8f49541..cb042e9 100644 (file)
@@ -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
index b23dcc5..8dd2f82 100644 (file)
@@ -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.
index 16292f6..e867a0c 100644 (file)
@@ -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
-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
 
index 538745d..cae38eb 100644 (file)
@@ -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:
 
index 68ce4b9..8fb5820 100644 (file)
@@ -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 "_")
index 398c3a0..da4fbe9 100644 (file)
@@ -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;
index 9d861e3..4159777 100644 (file)
@@ -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";
diff --git a/sv.c b/sv.c
index 71ad3d8..6e299ae 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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";
        }
     }
index 4a7cb7a..63614f5 100755 (executable)
@@ -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 (file)
index 0000000..cddf0a7
--- /dev/null
@@ -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 (file)
index 0000000..80867a6
--- /dev/null
@@ -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 (executable)
index 0000000..a486feb
--- /dev/null
@@ -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");
+}
index 730c225..da7bb64 100644 (file)
@@ -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";