diff options
author | Andy Dougherty <doughera@lafcol.lafayette.edu> | 1995-06-05 02:03:44 +0000 |
---|---|---|
committer | Andy Dougherty <doughera@lafcol.lafayette.edu> | 1995-06-05 02:03:44 +0000 |
commit | c296029969658ed2c8d9a223d4b09026463ca970 (patch) | |
tree | aa1524c2a7ae100bfbfcb083cf37a7626aeab87b /lib | |
parent | 16d20bd98cd29be76029ebf04027a7edd34d817b (diff) | |
download | perl-c296029969658ed2c8d9a223d4b09026463ca970.tar.gz |
This is my patch patch.1j for perl5.001.
To apply, change to your perl directory and apply with
patch -p1 -N < thispatch.
After you apply this patch, I would recommend:
rm config.sh
sh Configure [whatever options you use]
make depend
make
make test
Here are the highlights:
Linux fixes: Now correctly sets & uses stdio _ptr and _cnt
tricks only when feasible (Configure, config_h.SH, config_H,
doio.c, sv.c x2p/str.c)
#!path-to-perl fixed to use $binexp instead of $bin. This should
really be fixed to do the correct perl start-up stuff. Volunteers?
(c2ph.SH, h2ph.SH, h2xs.SH, makeaperl.SH, perldoc.SH,
pod/pod2*.SH, x2p/find2perl.SH, x2p/s2p.SH)
hint updates: hints/apollo.sh, hints/linux.sh, hints/freebsd.sh,
hints/sco_3.sh.
xsubpp version 1.7. (includes CASE support)
pod/perlbot updates.
my lib/AutoLoader patch (to use @INC).
[ON]DBM_File/Makefile.PL now have a few hint files.
Other sundry small things.
Patch and enjoy,
Andy Dougherty doughera@lafcol.lafayette.edu
Dept. of Physics
Lafayette College Easton, PA 18042
Here's the file-by-file breakdown of what's included:
Configure
Checks if File_ptr(fp) and File_cnt(fp) can be assigned to.
Fix typo: s/sytem/system/
MANIFEST
Include new extension hint files.
README
Some clarifications, thanks to John Stoeffel. Tell users how to
not use dynamic loading.
c2ph.SH
Use $binexp instead of $bin.
config_H
Updated to match config_h.SH.
config_h.SH
Include defines for whether File_ptr(fp) and File_cnt(fp)
can be assigned to.
doio.c
Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.
ext/DynaLoader/DynaLoader.pm
Improve error messages and a little documentation.
ext/NDBM_File/hints/solaris.pl
New hint file.
ext/ODBM_File/Makefile.PL
Removed -ldbm.nfs, since it's now in the sco hint file.
ext/ODBM_File/hints/sco.pl
ext/ODBM_File/hints/solaris.pl
ext/ODBM_File/hints/svr4.pl
New hint files.
h2ph.SH
h2xs.SH
Use $binexp instead of $bin.
hints/apollo.sh
hints/freebsd.sh
hints/linux.sh
hints/sco_3.sh
Updated.
lib/AutoLoader.pm
Eliminate else clause in sub import.
Handle case where @INC contains relative paths.
lib/ExtUtils/xsubpp
Update to version 1.7. This includes CASE support.
lib/I18N/Collate.pm
Updated documentation.
lib/ftp.pl
Look for socket.ph or sys/socket.ph
lib/getcwd.pl
Use defined().
makeaperl.SH
Use $binexp instead of $bin.
perl.c
fputs("\tUnofficial patchlevel 1j.\n",stdout);
perldoc.SH
Use $binexp instead of $bin.
Turn off debugging messages.
pod/perlbot.pod
Updated.
pod/pod2html.SH
pod/pod2latex.SH
pod/pod2man.SH
Use $binexp instead of $bin.
sv.c
Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.
toke.c
Fix spelling of ambiguous.
x2p/find2perl.SH
x2p/s2p.SH
Use $binexp instead of $bin.
x2p/str.c
Use defines for whether File_ptr(fp) and File_cnt(fp) can be assigned to.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/AutoLoader.pm | 38 | ||||
-rwxr-xr-x | lib/ExtUtils/xsubpp | 163 | ||||
-rw-r--r-- | lib/I18N/Collate.pm | 30 | ||||
-rw-r--r-- | lib/ftp.pl | 2 | ||||
-rw-r--r-- | lib/getcwd.pl | 2 |
5 files changed, 175 insertions, 60 deletions
diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index 449498c367..b38915872c 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -43,22 +43,30 @@ AUTOLOAD { goto &$AUTOLOAD; } -sub import -{ - my ($callclass, $callfile, $callline,$path,$callpack) = caller(0); - ($callpack = $callclass) =~ s#::#/#; - if (defined($path = $INC{$callpack . '.pm'})) - { - if ($path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix# && -e $path) - { - eval {require $path}; - carp $@ if ($@); +sub import { + my ($callclass, $callfile, $callline,$path,$callpack) = caller(0); + ($callpack = $callclass) =~ s#::#/#; + # Try to find the autosplit index file. Eg., if the call package + # is POSIX, then $INC{POSIX.pm} is something like + # '/usr/local/lib/perl5/POSIX.pm', and the autosplit index file is in + # '/usr/local/lib/perl5/auto/POSIX/autosplit.ix', so we require that. + # + # However, if @INC is a relative path, this might not work. If, + # for example, @INC = ('lib'), then + # $INC{POSIX.pm} is 'lib/POSIX.pm', and we want to require + # 'auto/POSIX/autosplit.ix' (without the leading 'lib'). + # + if (defined($path = $INC{$callpack . '.pm'})) { + # Try absolute path name. + $path =~ s#^(.*)$callpack\.pm$#$1auto/$callpack/autosplit.ix#; + eval { require $path; }; + # If that failed, try relative path with normal @INC searching. + if ($@) { + $path ="auto/$callpack/autosplit.ix"; + eval { require $path; }; + } + carp $@ if ($@); } - else - { - croak "Have not loaded $callpack.pm"; - } - } } 1; diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index 3be47e005c..e46b732e37 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -132,14 +132,40 @@ a type and name pair. When parsing the OUTPUT arguments check that they are all present in the corresponding input argument definitions. +=head2 1.5 + +Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 1 June 1995. + +Started tidy up to allow clean run using C<-w> flag. + +Added some more error checking. + +The CASE: functionality now works. + +=head2 1.6 + +Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 3 June 1995. + +Added some more error checking. + +=head2 1.7 + +Changes by Paul Marquess <pmarquess@bfsec.bt.co.uk>, 5 June 1995. + +When an error or warning message is printed C<xsubpp> will now attempt +to identify the exact line in the C<.xs> file where the fault occurs. +This can be achieved in the majority of cases. + =head1 SEE ALSO perl(1) =cut +use FileHandle ; + # Global Constants -$XSUBPP_version = "1.4" ; +$XSUBPP_version = "1.7" ; $usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n"; @@ -155,8 +181,8 @@ SWITCH: while ($ARGV[0] =~ s/^-//) { chop($pwd = `pwd`); # Check for error message from VMS if ($pwd =~ /unrecognized command verb/) { $Is_VMS = 1; $pwd = $ENV{DEFAULT} } -($dir, $filename) = @ARGV[0] =~ m#(.*)/(.*)# - or ($dir, $filename) = @ARGV[0] =~ m#(.*[>\]])(.*)# +($dir, $filename) = $ARGV[0] =~ m#(.*)/(.*)# + or ($dir, $filename) = $ARGV[0] =~ m#(.*[>\]])(.*)# or ($dir, $filename) = ('.', $ARGV[0]); chdir($dir); @@ -196,6 +222,7 @@ foreach $typemap (@tm) { open(TYPEMAP, $typemap) or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; $mode = Typemap; + $junk = "" ; $current = \$junk; while (<TYPEMAP>) { next if /^#/; @@ -209,7 +236,7 @@ foreach $typemap (@tm) { # skip blank lines and comment lines next if /^$/ or /^#/ ; my @words = split (' ') ; - blurt("Error: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next + warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 columns\n"), next unless @words >= 2 ; my $kind = pop @words ; TrimWhitespace($kind) ; @@ -251,6 +278,8 @@ sub Q { $text; } +open(F, $filename) or die "cannot open $filename: $!\n"; + # Identify the version of xsubpp used $TimeStamp = localtime ; print <<EOM ; @@ -263,8 +292,6 @@ print <<EOM ; EOM -open(F, $filename) or die "cannot open $filename: $!\n"; - while (<F>) { last if ($Module, $foo, $Package, $foo1, $Prefix) = /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/; @@ -276,6 +303,7 @@ $lastline = $_; sub fetch_para { # parse paragraph @line = (); + @line_no = () ; if ($lastline ne "") { if ($lastline =~ /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/) { @@ -294,10 +322,11 @@ sub fetch_para { !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/; last if /^\S/; } - push(@line, $_) if $_ ne ""; + push(@line, $_), push(@line_no, input_line_number F) if $_ ne ""; } else { push(@line, $lastline); + push(@line_no, $lastline_no) ; } $lastline = ""; while (<F>) { @@ -306,18 +335,21 @@ sub fetch_para { chop; if (/^\S/ && @line && $line[-1] eq "") { $lastline = $_; + $lastline_no = input_line_number F ; last; } else { push(@line, $_); + push(@line_no, input_line_number F) ; } } - pop(@line) while @line && $line[-1] =~ /^\s*$/; + pop(@line), pop(@line_no) while @line && $line[-1] =~ /^\s*$/; } $PPCODE = grep(/PPCODE:/, @line); scalar @line; } +PARAGRAPH: while (&fetch_para) { # initialize info arrays undef(%args_match); @@ -332,21 +364,37 @@ while (&fetch_para) { # extract return type, function name and arguments $ret_type = TidyType(shift(@line)); + if ($ret_type =~ /^BOOT:/) { push (@BootCode, @line, "", "") ; - next ; + next PARAGRAPH ; } + + # a function definition needs at least 2 lines + blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH + unless @line ; + if ($ret_type =~ /^static\s+(.*)$/) { $static = 1; $ret_type = $1; } $func_header = shift(@line); - ($func_name, $orig_args) = $func_header =~ /^([\w:]+)\s*\((.*)\)$/; + blurt ("Error: Cannot parse function definition from '$func_header'"), next PARAGRAPH + unless $func_header =~ /^([\w:]+)\s*\((.*)\)$/; + + ($func_name, $orig_args) = ($1, $2) ; if ($func_name =~ /(.*)::(.*)/) { $class = $1; $func_name = $2; } + $Prefix = '' unless defined $Prefix ; # keep -w happy ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/; + + # Check for duplicate function definition + blurt("Error: ignoring duplicate function definition '$func_name'"), next PARAGRAPH + if defined $Func_name{"${Packid}_$func_name"} ; + $Func_name{"${Packid}_$func_name"} ++ ; + push(@Func_name, "${Packid}_$func_name"); push(@Func_pname, $pname); @args = split(/\s*,\s*/, $orig_args); @@ -368,7 +416,7 @@ while (&fetch_para) { if ($args[$i] =~ s/\.\.\.//) { $elipsis = 1; $min_args--; - if ($args[i] eq '' && $i == $num_args - 1) { + if ($args[$i] eq '' && $i == $num_args - 1) { pop(@args); last; } @@ -421,22 +469,31 @@ EOF # Now do a block of some sort. $condnum = 0; + $else_cond = 0 ; if (!@line) { @line = "CLEANUP:"; } while (@line) { - if ($_[0] =~ s/^\s*CASE\s*:\s*//) { + if ($line[0] =~ s/^\s*CASE\s*:\s*//) { $cond = shift(@line); + TrimWhitespace($cond) ; if ($condnum == 0) { - print " if ($cond)\n"; + # Check $cond is not blank + blurt("Error: First CASE: needs a condition") + if $cond eq '' ; + print " if ($cond)\n" } elsif ($cond ne '') { print " else if ($cond)\n"; } else { + blurt ("Error: Too many CASE: statements without a condition") + unless $else_cond ; + ++ $else_cond ; print " else\n"; } $condnum++; + $_ = '' ; } if ($except) { @@ -454,6 +511,8 @@ EOF $thisdone = 0; $retvaldone = 0; $deferred = ""; + %arg_list = () ; + $gotRETVAL = 0; while (@line) { $_ = shift(@line); last if /^\s*NOT_IMPLEMENTED_YET/; @@ -463,8 +522,13 @@ EOF # skip blank lines next if /^$/ ; my $line = $_ ; + + # remove trailing semicolon if no initialisation + s/\s*;+\s*$//g unless /=/ ; + # check for optional initialisation code - my $var_init = $1 if s/\s*(=.*)$// ; + my $var_init = '' ; + $var_init = $1 if s/\s*(=.*)$// ; my @words = split (' ') ; blurt("Error: invalid argument declaration '$line'"), next @@ -472,9 +536,6 @@ EOF my $var_name = pop @words ; my $var_type = "@words" ; - # catch C style argument declaration (this could be made alowable syntax) - warn("Warning: ignored semicolon in $pname argument declaration '$_'\n") - if ($var_name =~ s/;//g); # eg SV *<tab>name; # catch many errors similar to: SV<tab>* name blurt("Error: invalid $pname argument name '$var_name' (type '$var_type')\n") unless ($var_name =~ m/^&?\w+$/); @@ -493,7 +554,7 @@ EOF print "\t" . &map_type($var_type); $var_num = $args_match{$var_name}; if ($var_addr{$var_name}) { - $func_args =~ s/\b($var_name)\b/&\1/; + $func_args =~ s/\b($var_name)\b/&$1/; } if ($var_init !~ /^=\s*NO_INIT\s*$/) { if ($var_init !~ /^\s*$/) { @@ -536,7 +597,7 @@ EOF print $deferred; while (@line) { $_ = shift(@line); - die "PPCODE must be last thing" + death ("PPCODE must be last thing") if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; print "$_\n"; } @@ -572,26 +633,25 @@ EOF $func_name = $2; } print "$func_name($func_args);\n"; - $wantRETVAL = 1 - unless $ret_type eq "void"; + $wantRETVAL = 1 unless $ret_type eq "void"; } } # do output variables if (/^\s*OUTPUT\s*:/) { - my $gotRETVAL ; + $gotRETVAL = 0; + my $RETVAL_code ; my %outargs ; while (@line) { $_ = shift(@line); - last if /^\s*CLEANUP\s*:/; + last if /^\s*CLEANUP|CASE\s*:/; TrimWhitespace($_) ; next if /^$/ ; my ($outarg, $outcode) = /^(\S+)\s*(.*)/ ; if (!$gotRETVAL and $outarg eq 'RETVAL') { # deal with RETVAL last - push(@line, $_) ; + $RETVAL_code = $outcode ; $gotRETVAL = 1 ; - undef ($wantRETVAL) ; next ; } blurt ("Error: duplicate OUTPUT argument '$outarg' ignored"), next @@ -608,11 +668,18 @@ EOF $outarg); } } + + if ($gotRETVAL) { + if ($RETVAL_code) + { print "\t$RETVAL_code\n" } + else + { &generate_output($ret_type, 0, 'RETVAL') } + } } # all OUTPUT done, so now push the return value on the stack &generate_output($ret_type, 0, "RETVAL") - if $wantRETVAL ; + if $wantRETVAL and ! $gotRETVAL ; # do cleanup if (/^\s*CLEANUP\s*:/) { @@ -690,7 +757,25 @@ sub output_init { eval qq/print " $init\\\n"/; } -sub blurt { warn @_; $errors++ } +sub Warn +{ + # work out the line number + my $line_no = $line_no[@line_no - @line -1] ; + + print STDERR "@_ in $filename, line $line_no\n" ; +} + +sub blurt +{ + Warn @_ ; + $errors ++ +} + +sub death +{ + Warn @_ ; + exit 1 ; +} sub generate_init { local($type, $num, $var) = @_; @@ -700,7 +785,9 @@ sub generate_init { local($tk); $type = TidyType($type) ; - blurt("Error: '$type' not in typemap"), return unless defined($type_kind{$type}); + blurt("Error: '$type' not in typemap"), return + unless defined($type_kind{$type}); + ($ntype = $type) =~ s/\s*\*/Ptr/g; $subtype = $ntype; $subtype =~ s/Ptr$//; @@ -708,8 +795,14 @@ sub generate_init { $tk = $type_kind{$type}; $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/; $type =~ s/:/_/g; + blurt("Error: No INPUT definition for type '$type' found"), return + unless defined $input_expr{$tk} ; $expr = $input_expr{$tk}; if ($expr =~ /DO_ARRAY_ELEM/) { + blurt("Error: '$subtype' not in typemap"), return + unless defined($type_kind{$subtype}); + blurt("Error: No INPUT definition for type '$subtype' found"), return + unless defined $input_expr{$type_kind{$subtype}} ; $subexpr = $input_expr{$type_kind{$subtype}}; $subexpr =~ s/ntype/subtype/g; $subexpr =~ s/\$arg/ST(ix_$var)/g; @@ -743,6 +836,8 @@ sub generate_output { } else { blurt("Error: '$type' not in typemap"), return unless defined($type_kind{$type}); + blurt("Error: No OUTPUT definition for type '$type' found"), return + unless defined $output_expr{$type_kind{$type}} ; ($ntype = $type) =~ s/\s*\*/Ptr/g; $ntype =~ s/\(\)//g; $subtype = $ntype; @@ -750,6 +845,10 @@ sub generate_output { $subtype =~ s/Array$//; $expr = $output_expr{$type_kind{$type}}; if ($expr =~ /DO_ARRAY_ELEM/) { + blurt("Error: '$subtype' not in typemap"), return + unless defined($type_kind{$subtype}); + blurt("Error: No OUTPUT definition for type '$subtype' found"), return + unless defined $output_expr{$type_kind{$subtype}} ; $subexpr = $output_expr{$type_kind{$subtype}}; $subexpr =~ s/ntype/subtype/g; $subexpr =~ s/\$arg/ST(ix_$var)/g; @@ -771,12 +870,6 @@ sub generate_output { elsif ($arg =~ /^ST\(\d+\)$/) { eval "print qq\a$expr\a"; } - elsif ($arg =~ /^ST\(\d+\)$/) { - eval "print qq\a$expr\a"; - } - elsif ($arg =~ /^ST\(\d+\)$/) { - eval "print qq\a$expr\a"; - } } } @@ -794,4 +887,4 @@ sub map_type { # If this is VMS, the exit status has meaning to the shell, so we # use a predictable value (SS$_Abort) rather than an arbitrary # number. -exit $Is_VMS ? 44 : $errors; +exit ($Is_VMS ? 44 : $errors) ; diff --git a/lib/I18N/Collate.pm b/lib/I18N/Collate.pm index 35c8025367..170032c1b3 100644 --- a/lib/I18N/Collate.pm +++ b/lib/I18N/Collate.pm @@ -23,14 +23,21 @@ You can compare $s1 and $s2 above with to extract the data itself, you'll need a dereference: $$s1 -This uses POSIX::setlocale The basic collation conversion is done by +This uses POSIX::setlocale. The basic collation conversion is done by strxfrm() which terminates at NUL characters being a decent C routine. collate_xfrm() handles embedded NUL characters gracefully. Due to C<cmp> and overload magic, C<lt>, C<le>, C<eq>, C<ge>, and C<gt> work also. The available locales depend on your operating system; try whether C<locale --a> shows them or the more direct approach C<ls /usr/lib/nls/loc> or C<ls -/usr/lib/nls>. The locale names are probably something like -"xx_XX.(ISO)?8859-N". +-a> shows them or man pages for "locale" or "nlsinfo" or +the direct approach C<ls /usr/lib/nls/loc> or C<ls +/usr/lib/nls>. Not all the locales that your vendor supports +are necessarily installed: please consult your operating system's +documentation. + +The locale names are probably something like +C<"xx_XX.(ISO)?8859-N"> or C<"xx_XX.(ISO)?8859N">, for example +C<"fr_CH.ISO8859-1"> is the Swiss (CH) variant of French (fr), +ISO Latin (8859) 1 (-1) which is the Western European character set. =cut @@ -54,7 +61,7 @@ available locales depend on your operating system; try whether C<locale # Overloads: cmp # 3) # # Usage: use Collate; -# setlocale(&LC_COLLATE, 'locale-of-your-choice'); # 4) +# setlocale(LC_COLLATE, 'locale-of-your-choice'); # 4) # $s1 = new Collate "scalar_data_1"; # $s2 = new Collate "scalar_data_2"; # @@ -68,12 +75,19 @@ available locales depend on your operating system; try whether C<locale # collate_xfrm handles embedded NUL characters gracefully. # 3) due to cmp and overload magic, lt le eq ge gt work also # 4) the available locales depend on your operating system; -# try whether "locale -a" shows them or the more direct +# try whether "locale -a" shows them or man pages for +# "locale" or "nlsinfo" work or the more direct # approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls". +# Not all the locales that your vendor supports +# are necessarily installed: please consult your +# operating system's documentation. # The locale names are probably something like -# 'xx_XX.(ISO)?8859-N'. +# 'xx_XX.(ISO)?8859-N' or 'xx_XX.(ISO)?8859N', +# for example 'fr_CH.ISO8859-1' is the Swiss (CH) +# variant of French (fr), ISO Latin (8859) 1 (-1) +# which is the Western European character set. # -# Updated: 19940913 1341 GMT +# Updated: 19950602 1601 GMT # # --- diff --git a/lib/ftp.pl b/lib/ftp.pl index e87a9b260c..f366cdb6fd 100644 --- a/lib/ftp.pl +++ b/lib/ftp.pl @@ -89,7 +89,7 @@ # require 'chat2.pl'; -require 'socket.ph'; +eval "require 'socket.ph'" || eval "require 'sys/socket.ph'" || die "socket.ph missing: $!\n"; package ftp; diff --git a/lib/getcwd.pl b/lib/getcwd.pl index a3214ba715..8db8e20c06 100644 --- a/lib/getcwd.pl +++ b/lib/getcwd.pl @@ -36,7 +36,7 @@ sub getcwd { do { - unless ($dir = readdir(getcwd'PARENT)) #')) + unless (defined ($dir = readdir(getcwd'PARENT))) #')) { warn "readdir($dotdots): $!"; closedir(getcwd'PARENT); #'); |