# $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $
#
-# Generated on Thu Jan 24 16:12:51 EET 2002 [metaconfig 3.0 PL70]
+# Generated on Mon Jan 28 01:36:10 EET 2002 [metaconfig 3.0 PL70]
# (with additional metaconfig patches by perlbug@perl.org)
cat >c1$$ <<EOF
linux*) # ld won't link with a bare -lperl otherwise.
dflt=libperl.$so
;;
- cygwin*) # include version
- dflt=`echo libperl$version | sed -e 's/\./_/g'`$lib_ext
+ cygwin*) # ld links against an importlib
+ dflt=libperl$lib_ext
;;
*) # Try to guess based on whether libc has major.minor.
case "$libc" in
*" "*) ldlibpth=`echo $ldlibpth|sed 's/ /\\\\ /g'` ;;
esac
+case "$osname" in
+os390) test -f /bin/env && ldlibpth="/bin/env $ldlibpth"
+ ;;
+esac
+
: Prepare dependency lists for Makefile.
dynamic_list=' '
for f in $dynamic_ext; do
# make sure that all library names are not malformed
libperl=`echo $libperl|sed -e s,\\\..*,,`
-# it would be nice to allow dll to have any name,
-# but for now i insist on 'lib<whatever>.dll'
-if ( ! ( echo $libperl | grep '^lib' >/dev/null ) )
-then
- libperl=lib$libperl
-fi
linklibperl=-l`echo $libperl|sed -e s,^lib,,`
$spitshell >>Makefile <<!GROK!THIS!
# library used to make statically linked executables
# miniperl is linked against it to avoid libperl.dll locking
-$(LIBPERL)s$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj)
+$(LIBPERL)$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj)
$(AR) rcu $@ perl$(OBJ_EXT) $(cwobj)
# dll and import library
-$(LIBPERL)$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj) ld2
+$(LIBPERL).dll$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj) ld2
$(LDLIBPTH) ld2 $(SHRPLDFLAGS) -o $(LIBPERL)$(DLSUFFIX) \
perl$(OBJ_EXT) $(cwobj) $(libs)
# The Module used here must not depend on Config or any extensions.
miniperl.exe \
-miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)s$(LIB_EXT) opmini$(OBJ_EXT)
- $(LDLIBPTH) $(CC) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL)s $(libs)
+miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) opmini$(OBJ_EXT)
+ $(LDLIBPTH) $(CC) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs)
$(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest
+perl.exe \
+perl: $& perlmain$(OBJ_EXT) $(LIBPERL).dll$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL).dll$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) purify $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL).dll$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) purecov $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL).dll$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) quantify $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
!NO!SUBS!
;;
*)
$(LDLIBPTH) $(CC) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs)
$(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '<?>' || $(MAKE) minitest
+perl.exe \
+perl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) -Wl,-Bstatic $(LLIBPERL) -Wl,-Bdynamic `cat ext.libs` $(libs)
+
+pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) purify $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) purecov $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
+quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
+ $(SHRPENV) $(LDLIBPTH) quantify $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
+
!NO!SUBS!
;;
esac
#
$spitshell >>Makefile <<'!NO!SUBS!'
-perl.exe \
-perl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(LDLIBPTH) $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) -Wl,-Bstatic $(LLIBPERL) -Wl,-Bdynamic `cat ext.libs` $(libs)
-
-pureperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(LDLIBPTH) purify $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
-
-purecovperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(LDLIBPTH) purecov $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o purecovperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
-
-quantperl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs
- $(SHRPENV) $(LDLIBPTH) quantify $(CC) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs)
!NO!SUBS!
# to be built, special processing is done, else the standard ld is called.
#
-# theese are pretty mandatory
+# these are pretty mandatory
my $CC = '@CC@';
-my $DLLWRAP = '@DLLWRAP@';
-
-# following are optional.
-my $WRAPDRIVER = '@WRAPDRIVER@';
-my $AS = '@AS@';
-my $DLLTOOL = '@DLLTOOL@';
my $EXPORT_ALL = @EXPORT_ALL@;
+
# if some of extensions are undefined,
# no corresponding output will be done.
# most probably, you'd like to have an export library
-my $DEF_EXT = '@DEF_EXT@';
+# my $DEF_EXT = '@DEF_EXT@';
# my $EXP_EXT = '@EXP_EXT@';
my $LIB_EXT = '@LIB_EXT@';
$path =~ s,[/\\](\.[/\\])*,/,g;
}
if ($dllname =~ /\./) { $libname =$`; } else { $libname =$dllname; };
+ my $v_e_r_s = '5_7_2';
+ if ( $dllname =~ /.*perl.*/) {
+ $dllname ="cygperl$v_e_r_s.dll";
+ } else {
$dllname ="$libname.dll";
+ }
$libname ="lib$libname" unless ($libname =~ /^lib/);
print DEBUGFILE "dll name: $dllname\nimport library: $libname\npath: $path\n" if $DEBUG;
- $command ="$DLLWRAP --dllname $dllname";
- $command .=" --driver-name $WRAPDRIVER" if $WRAPDRIVER;
- $command .=" --dlltool $DLLTOOL" if $DLLTOOL;
- $command .=" --export-all-symbols" if $EXPORT_ALL;
- $command .=" --as $AS" if $AS;
- $command .=" --verbose" if $verbose;
+ $command ="$CC -shared -o $dllname";
+# $command .=" --verbose" if $verbose;
- $command .=" --output-def $libname$DEF_EXT" if $DEF_EXT;
- $command .=" --output-exp $libname$EXP_EXT" if $EXP_EXT;
- $command .=" --output-lib $libname$LIB_EXT" if $LIB_EXT;
+ $command .=" -Wl,--output-def=$libname$DEF_EXT" if $DEF_EXT;
+ $command .=" -Wl,--output-exp=$libname$EXP_EXT" if $EXP_EXT;
+ $command .=" -Wl,--out-implib=$libname.dll$LIB_EXT" if $LIB_EXT;
+ $command .=" -Wl,--export-all-symbols" if $EXPORT_ALL;
+ $command .=" -Wl,--enable-auto-import -Wl,--stack,67108864"; # always
# other args are passed through
shellexec("$command \\\n$args\n");
if ($path) {
$command ="mv $dllname";
- $command .=" $libname$LIB_EXT" if $LIB_EXT;
+ $command .=" $libname.dll$LIB_EXT" if $LIB_EXT;
shellexec("$command $path\n");
};
};
if (as_raw) {
/* sysopen style args, i.e. integer mode and permissions */
STRLEN ix = 0;
- if (num_svs != 0) {
- Perl_croak(aTHX_ "panic: sysopen with multiple args");
- }
- if (rawmode & (O_WRONLY|O_RDWR|O_CREAT
+ int appendtrunc =
+ 0
#ifdef O_APPEND /* Not fully portable. */
- |O_APPEND
+ |O_APPEND
#endif
#ifdef O_TRUNC /* Not fully portable. */
- |O_TRUNC
+ |O_TRUNC
#endif
- ))
- TAINT_PROPER("sysopen");
+ ;
+ int modifyingmode =
+ O_WRONLY|O_RDWR|O_CREAT|appendtrunc;
+ int ismodifying;
+
+ if (num_svs != 0) {
+ Perl_croak(aTHX_ "panic: sysopen with multiple args");
+ }
+ /* It's not always
+
+ O_RDONLY 0
+ O_WRONLY 1
+ O_RDWR 2
+
+ It might be (in OS/390 and Mac OS Classic it is)
+
+ O_WRONLY 1
+ O_RDONLY 2
+ O_RDWR 3
+
+ This means that simple & with O_RDWR would look
+ like O_RDONLY is present. Therefore we have to
+ be more careful.
+ */
+ if ((ismodifying = (rawmode & modifyingmode))) {
+ if ((ismodifying & O_WRONLY) == O_WRONLY ||
+ (ismodifying & O_RDWR) == O_RDWR ||
+ (ismodifying & (O_CREAT|appendtrunc)))
+ TAINT_PROPER("sysopen");
+ }
mode[ix++] = '#'; /* Marker to openn to use numeric "sysopen" */
#if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
sprintf(escbuff, "\\%03o", '?');
sv_catpv(sstr, escbuff);
}
- else if (*s >= ' ' && *s < 127) /* XXX not portable */
+#ifdef EBCDIC
+ else if (isPRINT(*s))
+#else
+ else if (*s >= ' ' && *s < 127)
+#endif /* EBCDIC */
sv_catpvn(sstr, s, 1);
else if (*s == '\n')
sv_catpv(sstr, "\\n");
sv_catpv(sstr, "\\'");
else if (*s == '\\')
sv_catpv(sstr, "\\\\");
- else if (*s >= ' ' && *s < 127) /* XXX not portable */
+#ifdef EBCDIC
+ else if (isPRINT(8s))
+#else
+ else if (*s >= ' ' && *s < 127)
+#endif /* EBCDIC */
sv_catpvn(sstr, s, 1);
else if (*s == '\n')
sv_catpv(sstr, "\\n");
$self->{'files'}{$1} = 1;
} elsif ($arg eq "-p") {
$self->{'parens'} = 1;
+ } elsif ($arg eq "-P") {
+ $self->{'noproto'} = 1;
} elsif ($arg eq "-l") {
$self->{'linenums'} = 1;
} elsif ($arg eq "-q") {
# or ("", $args_after_prototype_demunging) if it does.
sub check_proto {
my $self = shift;
+ return "&" if $self->{'noproto'};
my($proto, @args) = @_;
my($arg, $real);
my $doneok = 0;
my($str) = @_;
# the insane complexity here is due to the behaviour of "\c\"
- $str =~ s/(^|[^\\]|\\c\\)(?<!\\c)\\(\\\\)*(?=[\0-\031\177-\377])/$1$2/g;
+ $str =~ s/(^|[^\\]|\\c\\)(?<!\\c)\\(\\\\)*(?=[^[:print:]])/$1$2/g;
return $str;
}
which probably isn't what you intended (the C<'???'> is a sign that
perl optimized away a constant value).
+=item B<-P>
+
+Disable prototype checking. With this option, all function calls are
+deparsed as if no prototype was defined for them. In other words,
+
+ perl -MO=Deparse,-P -e 'sub foo (\@) { 1 } foo @x'
+
+will print
+
+ sub foo (\@) {
+ 1;
+ }
+ &foo(\@x);
+
+making clear how the parameters are actually passed to C<foo>.
+
=item B<-q>
Expand double-quoted strings into the corresponding combinations of
print "# use5005threads: test $test skipped\n";
} else {
$a = `$^X $path "-MO=Showlex" -e "my \@one" $redir`;
- if (ord('A') != 193) { # ASCIIish
- print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*\@one.*sv_undef.*AV/s;
- }
- else { # EBCDICish C<1: PVNV (0x1a7ede34) "@\226\225\205">
- print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*\@\\[0-9].*sv_undef.*AV/s;
- }
+ print "# [$a]\nnot " unless $a =~ /sv_undef.*PVNV.*\@one.*sv_undef.*AV/s;
}
ok;
sub ok { print "ok $test\n"; $test++ }
-my $a;
+my $got;
my $Is_VMS = $^O eq 'VMS';
my $Is_MacOS = $^O eq 'MacOS';
$path = '"-I../lib" "-Iperl_root:[lib]"' if $Is_VMS; # gets too long otherwise
my $redir = $Is_MacOS ? "" : "2>&1";
+chomp($got = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
+
+$got =~ s/-u//g;
+
+print "# got = $got\n";
+
+my @got = map { s/^\S+ //; $_ }
+ sort { $a cmp $b }
+ map { lc($_) . " " . $_ }
+ split /,/, $got;
+
+print "# (after sorting)\n";
+print "# got = @got\n";
+
+@got = grep { ! /^(PerlIO|open)(?:::\w+)?$/ } @got;
+
+print "# (after perlio censorings)\n";
+print "# got = @got\n";
+
+@got = grep { ! /^Win32$/ } @got if $^O eq 'MSWin32';
+@got = grep { ! /^NetWare$/ } @got if $^O eq 'NetWare';
+@got = grep { ! /^(Cwd|File|File::Copy|OS2)$/ } @got if $^O eq 'os2';
+@got = grep { ! /^Cwd$/ } @got if $^O eq 'cygwin';
-chomp($a = `$^X $path "-MB::Stash" "-Mwarnings" -e1`);
-$a = join ',', sort split /,/, $a;
-$a =~ s/-u(PerlIO|open)(?:::\w+)?,//g;
-$a =~ s/-uWin32,// if $^O eq 'MSWin32';
-$a =~ s/-uNetWare,// if $^O eq 'NetWare';
-$a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
-$a =~ s/-uCwd,// if $^O eq 'cygwin';
- $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uaccess,-uattributes,'
- . '-umain,-uutf8,-uwarnings';
if ($Is_VMS) {
- $a =~ s/-uFile,-uFile::Copy,//;
- $a =~ s/-uVMS,-uVMS::Filespec,//;
- $a =~ s/-uvmsish,//;
- $a =~ s/-uSocket,//; # Socket is optional/compiler version dependent
+ @got = grep { ! /^File(?:::Copy)?$/ } @got;
+ @got = grep { ! /^VMS(?:::Filespec)?$/ } @got;
+ @got = grep { ! /^vmsish$/ } @got;
+ # Socket is optional/compiler version dependent
+ @got = grep { ! /^Socket$/ } @got;
}
+print "# (after platform censorings)\n";
+print "# got = @got\n";
+
+$got = "@got";
+
+my $expected = "access attributes Carp Carp::Heavy DB Exporter Exporter::Heavy main utf8 warnings";
+
{
no strict 'vars';
use vars '$OS2::is_aout';
}
+
if ((($Config{static_ext} eq ' ') || ($Config{static_ext} eq ''))
&& !($^O eq 'os2' and $OS2::is_aout)
) {
- if (ord('A') == 193) { # EBCDIC sort order is qw(a A) not qw(A a)
- $b = join ',', sort split /,/, $b;
- }
- print "# [$a]\n# vs.\n# [$b]\nnot " if $a ne $b;
+ print "# [$got]\n# vs.\n# [$expected]\nnot " if $got ne $expected;
ok;
} else {
print "ok $test # skipped: one or more static extensions\n"; $test++;
MAX = 7
RITER = -1
EITER = $ADDR
- Elt "\\\241\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
+ Elt "\\\214\\\101" \[UTF8 "\\\x\{100\}"\] HASH = $ADDR
SV = PV\\($ADDR\\) at $ADDR
REFCNT = 1
FLAGS = \\(POK,pPOK,UTF8\\)
}
if (open(UTF, "<$utf")) {
- # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
- print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3";
+ if (ord('A') == 193) { # EBCDIC
+ # alpha beta gamma in UTF-EBCDIC Unicode (0x3b1 0x3b2 0x3b3)
+ print "not " unless <UTF> eq "\xb4\x58\xb4\x59\xb4\x62";
+ } else {
+ # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3)
+ print "not " unless <UTF> eq "\xce\xb1\xce\xb2\xce\xb3";
+ }
print "ok 4\n";
close UTF;
}
my $buf2;
read(RUSSKI, $buf2, 1);
my $offset = tell(RUSSKI);
- if (ord($buf1) == 0x3c && ord($buf2) == 0x3f && $offset == 2) {
+ if (ord($buf1) == 0x3c &&
+ ord($buf2) == (ord('A') == 193) ? 0x6f : 0x3f &&
+ $offset == 2) {
print "ok 11\n";
} else {
- printf "not ok 11 # %#x %#x %d\n",
- ord($buf1), ord($buf2), $offset;
+ printf "not ok 11 # [%s] [%s] %d\n",
+ join(" ", unpack("H*", $buf1)),
+ join(" ", unpack("H*", $buf2)), $offset;
}
close(RUSSKI);
} else {
if ($Is_Cygwin) {
$perldll = $libperl;
- $perldll =~ s/(\..*)?$/.$dlext/;
+ my $v_e_r_s = $ver; $v_e_r_s =~ tr/./_/;
+ $perldll =~ s/(\..*)?$/$v_e_r_s.$dlext/;
+ $perldll =~ s/^lib/cyg/;
if ($Config{useshrplib} eq 'true') {
# install ld2 and perlld as well
foreach ('ld2', 'perlld') {
copy("$_", "$installbin/$_");
chmod(0755, "$installbin/$_");
};
+ {
+ open (LD2, ">$installbin/ld2");
+ print LD2 "#!/bin/sh\n#\n# ld wrapper, passes all args to perlld;\n#\n"
+ . "for trythis in $installbin/perl\ndo\n if [ -x \$trythis ]\n"
+ . " then\n \$trythis $installbin/perlld \"\$\@\"\n"
+ . " exit \$?\n fi\ndone\n# hard luck!\necho i see no perl"
+ . " executable around there\necho perl is required to build "
+ . "dynamic libraries\necho look if the path to perl in /bin/ld2"
+ . " is correct\nexit 1\n";
+ close LD2;
+ };
+ chmod(0755, "$installbin/ld2");
};
} else {
$perldll = 'perl57.' . $dlext;
sub perl_archive
{
+ if ($Config{useshrplib} eq 'true')
+ {
+ my $libperl = '$(PERL_INC)' .'/'. "$Config{libperl}";
+ $libperl =~ s/a$/dll.a/;
+ return $libperl;
+ } else {
return '$(PERL_INC)' .'/'. ("$Config{libperl}" or "libperl.a");
+ }
}
1;
my $Is_Mac = $^O eq 'MacOS';
my $Is_Win32 = $^O eq 'MSWin32';
my $Is_Cygwin = $^O eq 'cygwin';
-my $Is_NetWare = $Config{osname} eq 'NetWare';
+my $Is_NetWare = $Config{osname} eq 'NetWare'; # $Config{osname} intentional
my $Is_BeOS = $^O =~ /beos/i; # XXX should this be that loose?
require ExtUtils::MM_Unix;
SKIP: {
if ($^O eq 'amigaos' || $^O eq 'os2' || $^O eq 'MSWin32' ||
$^O eq 'NetWare' || $^O eq 'dos' || $^O eq 'cygwin') {
- skip( "different file permission semantics on $^O\n", 3);
+ skip( "different file permission semantics on $^O", 3);
}
# change a file to execute-only
s!-bE:(\S+)!-bE:$perl_exp!;
}
}
- elsif ($^O eq 'cygwin') { # Cygwin needs the libperl copied
+ elsif ($^O eq 'cygwin') { # Cygwin needs the shared libperl copied
my $v_e_r_s = $Config{version};
$v_e_r_s =~ tr/./_/;
- system("cp ../libperl$v_e_r_s.dll ./"); # for test 1
- system("cp ../$Config{'libperl'} ../libperl.a"); # for test 1
+ system("cp ../cygperl$v_e_r_s.dll ./"); # for test 1
}
elsif ($Config{'libperl'} !~ /\Alibperl\./) {
# Everyone needs libperl copied if it's not found by '-lperl'.
unlink($exe,"embed_test.c",$obj);
unlink("$exe$Config{exe_ext}") if $skip_exe;
unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS';
-unlink(glob("./libperl*.dll")) if $^O eq 'cygwin';
-unlink("../libperl.a") if $^O eq 'cygwin';
+unlink(glob("./*.dll")) if $^O eq 'cygwin';
unlink($testlib) if $libperl_copied;
# gcc -g -I.. -L../ -o perl_test perl_test.c -lperl `../perl -I../lib -MExtUtils::Embed -I../ -e ccopts -e ldopts`
# test perl_archive
my $libperl = $Config{libperl} || 'libperl.a';
+$libperl =~ s/.a/.dll.a/;
is( $args->perl_archive(), "\$(PERL_INC)/$libperl",
'perl_archive() should respect libperl setting' );
# Pod::Text::Overstrike -- Convert POD data to formatted overstrike text
-# $Id: Overstrike.pm,v 1.6 2001/11/28 01:16:54 eagle Exp $
+# $Id: Overstrike.pm,v 1.7 2002/01/28 01:55:42 eagle Exp $
#
# Created by Joe Smith <Joe.Smith@inwap.com> 30-Nov-2000
# (based on Pod::Text::Color by Russ Allbery <rra@stanford.edu>)
# Don't use the CVS revision as the version, since this module is also in Perl
# core and too many things could munge CVS magic revision strings. This
# number should ideally be the same as the CVS revision in podlators, however.
-$VERSION = 1.06;
+$VERSION = 1.07;
##############################################################################
my $spaces = ' ' x $$self{MARGIN};
my $width = $$self{width} - $$self{MARGIN};
while (length > $width) {
- if (s/^((?:(?:[^\n]\cH)?[^\n]){0,$width})(\Z|\s+)//
- || s/^((?:(?:[^\n]\cH)?[^\n]){$width})//) {
+ if (s/^((?:(?:[^\n][\b])?[^\n]){0,$width})(\Z|\s+)//
+ || s/^((?:(?:[^\n][\b])?[^\n]){$width})//) {
$output .= $spaces . $1 . "\n";
} else {
last;
# version.
sub strip_format {
my ($self, $text) = @_;
- $text =~ s/(.)\cH\1/$1/g;
- $text =~ s/_\cH//g;
+ $text =~ s/(.)[\b]\1/$1/g;
+ $text =~ s/_[\b]//g;
return $text;
}
unless ((ref $opts{"-input"}) || (-e $opts{"-input"})) {
my ($dirname, $basename) = ('', $opts{"-input"});
my $pathsep = ($^O =~ /^(?:dos|os2|MSWin32)$/) ? ";"
- : (($^O eq 'MacOS') ? ',' : ":");
+ : (($^O eq 'MacOS' || $^O eq 'VMS') ? ',' : ":");
my $pathspec = $opts{"-pathlist"} || $ENV{PATH} || $ENV{PERL5LIB};
my @paths = (ref $pathspec) ? @$pathspec : split($pathsep, $pathspec);
}
{ # Test exit status from pod2usage()
- my $exit = 42;
+ my $exit = ($^O eq 'VMS' ? 2 : 42);
my $dev_null = File::Spec->devnull;
my $args = join ", ", (
"-verbose => 0",
"-exit => $exit",
- "-output => q[$dev_null]",
- "-input => q[$0]",
+ "-output => q{$dev_null}",
+ "-input => q{$0}",
);
- my $prg = qq[pod2usage({ $args })];
- my @cmd = ( $^X, '-I../lib', '-MPod::Usage', '-e', $prg );
+ my $cq = (($^O eq 'MSWin32'
+ || $^O eq 'NetWare'
+ || $^O eq 'VMS') ? '"'
+ : "");
+ my @params = ( "${cq}-I../lib$cq", "${cq}-MPod::Usage$cq", '-e' );
+ my $prg = qq[${cq}pod2usage({ $args })$cq];
+ my @cmd = ( $^X, @params, $prg );
+
+ print "# cmd = @cmd\n";
is( system( @cmd ) >> 8, $exit, 'Exit status of pod2usage()' );
}
#!/usr/bin/perl -w
-# $Id: basic.t,v 1.3 2001/11/26 09:24:37 eagle Exp $
+# $Id: basic.t,v 1.4 2002/01/28 02:56:19 eagle Exp $
#
# basic.t -- Basic tests for podlators.
#
# Hard-code a few values to try to get reproducible results.
$ENV{COLUMNS} = 80;
-$ENV{TERM} = 'xterm';
+$ENV{TERM} = 'xterm';
$ENV{TERMCAP} = 'xterm:co=80:do=^J:md=\E[1m:us=\E[4m:me=\E[m';
# Map of translators to file extensions to find the formatted output to
open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n";
open (OUTPUT, "> out.$translators{$_}")
or die "Cannot create out.$translators{$_}: $!\n";
- binmode OUTPUT;
local $_;
while (<TMP>) { last if /^\.TH/ }
print OUTPUT while <TMP>;
my $output = <OUTPUT>;
close MASTER;
close OUTPUT;
+
+ # OS/390 is EBCDIC, which uses a different character for ESC
+ # apparently. Try to convert so that the test still works.
+ if ($^O eq 'os390' && $_ eq 'Pod::Text::Termcap') {
+ $output =~ tr/\033/\047/;
+ }
+
if ($master eq $output) {
print "ok $n\n";
unlink "out.$translators{$_}";
} else {
- my @master = split m/[\r\n]+/, $master;
- my @output = split m/[\r\n]+/, $output;
print "not ok $n\n";
print "# Non-matching output left in out.$translators{$_}\n";
- "@master" eq "@output" and
- print "# But the line-end stripped versions are equal\n";
}
}
$n++;
($^O eq 'cygwin' && $pwent->uid == 500); # go figure
print "ok 2\n";
-print "not " unless $pwent->name == $pwent[0];
+print "not " unless $pwent->name eq $pwent[0];
print "ok 3\n";
-print "not " unless $pwent->passwd eq $pwent[1];
+if ($^O eq 'os390') {
+ print "not "
+ unless not defined $pwent->passwd &&
+ $pwent[1] eq '0'; # go figure
+} else {
+ print "not " unless $pwent->passwd eq $pwent[1];
+}
print "ok 4\n";
print "not " unless $pwent->uid == $pwent[2];
} else {
use locale;
no utf8;
+ my $re = qr/[\[\(\{\*\+\?\|\^\$\\]/;
my @f = ();
foreach my $x (keys %UPPER) {
print "# UPPER $x lc $y ",
$x =~ /$y/i ? 1 : 0, " ",
$y =~ /$x/i ? 1 : 0, "\n" if 0;
+ # If $x and $y contain regular expression characters
+ # AND THEY lowercase (/i) to regular expression characters,
+ # regcomp() will be mightily confused. No, the \Q doesn't
+ # help here (maybe regex engine internal lowercasing
+ # is done after the \Q?) An example of this happening is
+ # the bg_BG (Bulgarian) locale under EBCDIC (OS/390 USS):
+ # the chr(173) (the "[") is the lowercase of the chr(235).
+ # Similarly losing EBCDIC locales include cs_cz, cs_CZ,
+ # el_gr, el_GR, en_us.IBM-037 (!), en_US.IBM-037,
+ # et_ee, et_EE, hr_hr, hr_HR, hu_hu, hu_HU, lt_LT,
+ # mk_mk, mk_MK, nl_nl.IBM-037, nl_NL.IBM-037,
+ # pl_pl, pl_PL, ro_ro, ro_RO, ru_ru, ru_RU,
+ # sk_sk, sk_SK, sl_si, sl_SI, tr_tr, tr_TR,
+ if ($x =~ $re || $y =~ $re) {
+ print "# Regex characters in '$x' or '$y', skipping test 117 for locale '$Locale'\n";
+ next;
+ }
# With utf8 both will fail since the locale concept
# of upper/lower does not work well in Unicode.
push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
print "# lower $x uc $y ",
$x =~ /$y/i ? 1 : 0, " ",
$y =~ /$x/i ? 1 : 0, "\n" if 0;
+ if ($x =~ $re || $y =~ $re) { # See above.
+ print "# Regex characters in '$x' or '$y', skipping test 117 for locale '$Locale'\n";
+ next;
+ }
# With utf8 both will fail since the locale concept
# of upper/lower does not work well in Unicode.
push @f, $x unless $x =~ /$y/i == $y =~ /$x/i;
=head1 NAME
-perlfaq - frequently asked questions about Perl ($Date: 2002/01/11 02:31:20 $)
+perlfaq - frequently asked questions about Perl ($Date: 2002/01/28 04:17:26 $)
=head1 DESCRIPTION
=head1 Author and Copyright Information
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
=head2 Bundled Distributions
=head1 NAME
-perlfaq1 - General Questions About Perl ($Revision: 1.4 $, $Date: 2002/01/18 21:00:17 $)
+perlfaq1 - General Questions About Perl ($Revision: 1.5 $, $Date: 2002/01/27 20:22:52 $)
=head1 DESCRIPTION
At The Second O'Reilly Open Source Software Convention, Larry Wall
announced Perl6 development would begin in earnest. Perl6 was an oft
used term for Chip Salzenberg's project to rewrite Perl in C++ named
-Topaz. However, Topaz should not be confused with the nisus to rewrite
-Perl while keeping the lessons learned from other software, as well as
-Perl5, in mind.
+Topaz. However, Topaz provided valuable insights to the next version
+of Perl and its implementation, but was ultimately abandoned.
-If you have a desire to help in the crusade to make Perl a better place
-then peruse the Perl6 developers page at http://www.perl.org/perl6/ and
-get involved.
+If you want to learn more about Perl6, or have a desire to help in
+the crusade to make Perl a better place then peruse the Perl6 developers
+page at http://dev.perl.org/perl6/ and get involved.
-The first alpha release is expected by Summer 2001.
+Perl6 is not scheduled for release yet, and Perl5 will still be supported
+for quite awhile after its release. Do not wait for Perl6 to do whatever
+you need to do.
"We're really serious about reinventing everything that needs reinventing."
--Larry Wall
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002 Tom Christiansen and
-Nathan Torkington. All rights reserved.
+Copyright (c) 1997, 1998, 1999, 2000, 2001 Tom Christiansen and Nathan
+Torkington. All rights reserved.
This documentation is free; you can redistribute it and/or modify it
under the same terms as Perl itself.
=head1 NAME
-perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.5 $, $Date: 2002/01/18 21:00:17 $)
+perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.6 $, $Date: 2002/01/25 21:22:22 $)
=head1 DESCRIPTION
see their FAQ (http://www.faqs.org/faqs/alt-sources-intro/) for details.
If you're just looking for software, first use Google
-(http://www.google.com), Deja (http://www.deja.com), and
-CPAN Search (http://search.cpan.org). This is faster and more
-productive than just posting a request.
+(http://www.google.com), Google's usenet search interface
+(http://groups.google.com), and CPAN Search (http://search.cpan.org).
+This is faster and more productive than just posting a request.
=head2 Perl Books
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2001 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head1 NAME
-perlfaq3 - Programming Tools ($Revision: 1.11 $, $Date: 2002/01/11 02:31:20 $)
+perlfaq3 - Programming Tools ($Revision: 1.12 $, $Date: 2002/01/28 04:17:26 $)
=head1 DESCRIPTION
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head1 NAME
-perlfaq4 - Data Manipulation ($Revision: 1.11 $, $Date: 2002/01/11 02:31:20 $)
+perlfaq4 - Data Manipulation ($Revision: 1.12 $, $Date: 2002/01/28 04:17:26 $)
=head1 DESCRIPTION
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head1 NAME
-perlfaq5 - Files and Formats ($Revision: 1.7 $, $Date: 2002/01/11 02:31:20 $)
+perlfaq5 - Files and Formats ($Revision: 1.8 $, $Date: 2002/01/28 04:17:26 $)
=head1 DESCRIPTION
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head1 NAME
-perlfaq6 - Regexes ($Revision: 1.6 $, $Date: 2002/01/01 22:26:45 $)
+perlfaq6 - Regexes ($Revision: 1.7 $, $Date: 2002/01/28 04:17:26 $)
=head1 DESCRIPTION
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head1 NAME
-perlfaq7 - Perl Language Issues ($Revision: 1.5 $, $Date: 2002/01/01 22:26:45 $)
+perlfaq7 - Perl Language Issues ($Revision: 1.6 $, $Date: 2002/01/28 04:17:26 $)
=head1 DESCRIPTION
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head1 NAME
-perlfaq8 - System Interaction ($Revision: 1.5 $, $Date: 2002/01/11 02:31:20 $)
+perlfaq8 - System Interaction ($Revision: 1.6 $, $Date: 2002/01/28 04:17:27 $)
=head1 DESCRIPTION
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
=head1 NAME
-perlfaq9 - Networking ($Revision: 1.5 $, $Date: 2001/11/09 08:06:04 $)
+perlfaq9 - Networking ($Revision: 1.7 $, $Date: 2002/01/28 04:17:27 $)
=head1 DESCRIPTION
=head2 My CGI script runs from the command line but not the browser. (500 Server Error)
-If you can demonstrate that you've read the FAQs and that
+Several things could be wrong. You can go through the "Troubleshooting
+Perl CGI scripts" guide at
+
+ http://www.perl.org/troubleshooting_CGI.html
+
+If, after that, you can demonstrate that you've read the FAQs and that
your problem isn't something simple that can be easily answered, you'll
probably receive a courteous and useful reply to your question if you
post it on comp.infosystems.www.authoring.cgi (if it's something to do
=head1 AUTHOR AND COPYRIGHT
-Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington.
+Copyright (c) 1997-2002 Tom Christiansen and Nathan Torkington.
All rights reserved.
This documentation is free; you can redistribute it and/or modify it
# test that nul bytes get copied
{
-# Character 'b' occurs at codepoint 130 decimal or \202 octal
-# under an EBCDIC coded character set.
-# my($a, $ab) = ("a", "a\000b");
- my($a, $ab) = ("\141", "\141\000\142");
- my($u, $ub) = map pack("U0a*", $_), $a, $ab;
+ my ($a, $ab) = ("a", "a\0b");
+ my ($u, $ub) = map pack("U0a*", $_), $a, $ab;
+
+ my $c = $u eq $a ? 'b' : pack("U0a*", 'b');
+
my $t1 = $a; $t1 .= $ab;
- print $t1 =~ /\142/ ? "ok 6\n" : "not ok 6\t# $t1\n";
+
+ print $t1 =~ /$c/ ? "ok 6\n" : "not ok 6\t# $t1\n";
+
my $t2 = $a; $t2 .= $ub;
- if (ord('A') == 193) {
- # print $t2 eq "\141\141\000" ? "ok 7\n" : "not ok 7\t# $t2\n";
- print eval '$t2 =~ /\141/' ? "ok 7\n" : "not ok 7\t# $t2\n";
- }
- else {
- print eval '$t2 =~ /\142/' ? "ok 7\n" : "not ok 7\t# $t2\n";
- }
+
+ print eval '$t2 =~ /$c/' ? "ok 7\n" : "not ok 7\t# $t2\n";
+
my $t3 = $u; $t3 .= $ab;
- print $t3 =~ /\142/ ? "ok 8\n" : "not ok 8\t# $t3\n";
+
+ print $t3 =~ /$c/ ? "ok 8\n" : "not ok 8\t# $t3\n";
+
my $t4 = $u; $t4 .= $ub;
- if (ord('A') == 193) {
- print eval '$t4 =~ /\141/' ? "ok 9\n" : "not ok 9\t# $t4\n";
- }
- else {
- print eval '$t4 =~ /\142/' ? "ok 9\n" : "not ok 9\t# $t4\n";
- }
+
+ print eval '$t4 =~ /$c/' ? "ok 9\n" : "not ok 9\t# $t4\n";
+
my $t5 = $a; $t5 = $ab . $t5;
- print $t5 =~ /\142/ ? "ok 10\n" : "not ok 10\t# $t5\n";
+
+ print $t5 =~ /$c/ ? "ok 10\n" : "not ok 10\t# $t5\n";
+
my $t6 = $a; $t6 = $ub . $t6;
- if (ord('A') == 193) {
- print eval '$t6 =~ /\141/' ? "ok 11\n" : "not ok 11\t# $t6\n";
- }
- else {
- print eval '$t6 =~ /\142/' ? "ok 11\n" : "not ok 11\t# $t6\n";
- }
+
+ print eval '$t6 =~ /$c/' ? "ok 11\n" : "not ok 11\t# $t6\n";
+
my $t7 = $u; $t7 = $ab . $t7;
- print $t7 =~ /\142/ ? "ok 12\n" : "not ok 12\t# $t7\n";
+
+ print $t7 =~ /$c/ ? "ok 12\n" : "not ok 12\t# $t7\n";
+
my $t8 = $u; $t8 = $ub . $t8;
- if (ord('A') == 193) {
- print eval '$t8 =~ /\141/' ? "ok 13\n" : "not ok 13\t# $t8\n";
- }
- else {
- print eval '$t8 =~ /\142/' ? "ok 13\n" : "not ok 13\t# $t8\n";
- }
+
+ print eval '$t8 =~ /$c/' ? "ok 13\n" : "not ok 13\t# $t8\n";
}
# from Wolfgang Laun: fix in change #13163
my $s = 'ABC' x 10;
- my $x = 42;
+ my $t = '*';
+ my $x = ord($t);
my $buf = pack( 'Z*/A* C', $s, $x );
my $y;
my $h = $buf;
$h =~ s/[^[:print:]]/./g;
( $s, $y ) = unpack( "Z*/A* C", $buf );
- is($h, "30.ABCABCABCABCABCABCABCABCABCABC*");
+ is($h, "30.ABCABCABCABCABCABCABCABCABCABC$t");
is(length $buf, 34);
is($s, "ABCABCABCABCABCABCABCABCABCABC");
- is($y, 42);
+ is($y, $x);
}
{
# /dev/stdout might be either character special or a named pipe,
# or a symlink, or a socket, depending on which OS and how are
# you running the test, so let's censor that one away.
+ # Similar remarks hold for stderr.
$DEV =~ s{^[cpls].+?\sstdout$}{}m;
@DEV = grep { $_ ne 'stdout' } @DEV;
+ $DEV =~ s{^[cpls].+?\sstderr$}{}m;
+ @DEV = grep { $_ ne 'stderr' } @DEV;
# /dev/printer is also naughty: in IRIX it shows up as
# Srwx-----, not srwx------.
# hash keys too
$h{v150.146} = "ok";
- is('ok',$h{v111.107},'ASCII hash keys');
+ is('ok',$h{v150.146},'EBCDIC hash keys');
}
# poetry optimization should also
projects / p5sagit/p5-mst-13.2.git / commitdiff