dslinux/user/perl/t/lib 1_compile.t NoExporter.pm TieIn.pm TieOut.pm commonsense.t compmod.pl contains_pod.xr cygwin.t filter-util.pl h2ph.h h2ph.pht
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 18:01:51 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/t/lib
In directory antilope:/tmp/cvs-serv17422/t/lib
Added Files:
1_compile.t NoExporter.pm TieIn.pm TieOut.pm commonsense.t
compmod.pl contains_pod.xr cygwin.t filter-util.pl h2ph.h
h2ph.pht
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: NoExporter.pm ---
package NoExporter;
$VERSION = 1.02;
sub import {
shift;
die "NoExporter exports nothing. You asked for: @_" if @_;
}
1;
--- NEW FILE: TieIn.pm ---
package TieIn;
sub TIEHANDLE {
bless( \(my $scalar), $_[0]);
}
sub write {
my $self = shift;
$$self .= join '', @_;
}
sub READLINE {
my $self = shift;
$$self =~ s/^(.*\n?)//;
return $1;
}
sub EOF {
my $self = shift;
return !length $$self;
}
1;
--- NEW FILE: filter-util.pl ---
use strict ;
use warnings;
use vars qw( $Perl $Inc);
sub readFile
{
my ($filename) = @_ ;
my ($string) = '' ;
open (F, "<$filename")
or die "Cannot open $filename: $!\n" ;
while (<F>)
{ $string .= $_ }
close F ;
$string ;
}
sub writeFile
{
my($filename, @strings) = @_ ;
open (F, ">$filename")
or die "Cannot open $filename: $!\n" ;
binmode(F) if $filename =~ /bin$/i;
foreach (@strings)
{ print F }
close F or die "Could not close: $!" ;
}
sub ok
{
my($number, $result, $note) = @_ ;
$note = "" if ! defined $note ;
if ($note) {
$note = "# $note" if $note !~ /^\s*#/ ;
$note =~ s/^\s*/ / ;
}
print "not " if !$result ;
print "ok ${number}${note}\n";
}
$Inc = '' ;
foreach (@INC)
{ $Inc .= "\"-I$_\" " }
$Inc = "-I::lib" if $^O eq 'MacOS';
$Perl = '' ;
$Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ;
$Perl = "$Perl -MMac::err=unix" if $^O eq 'MacOS';
$Perl = "$Perl -w" ;
1;
--- NEW FILE: h2ph.pht ---
require '_h2ph_pre.ph';
no warnings 'redefine';
unless(defined(&SQUARE)) {
sub SQUARE {
my($x) = @_;
eval q((($x)*($x)));
}
}
unless(defined(&ERROR)) {
eval 'sub ERROR {
my($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 {
my($a,$b) = @_;
eval q((($a) > ($b) ? ($a) : ($b)));
}' unless defined(&MAX);
if(defined(&__SOME_UNIMPORTANT_PROPERTY)) {
eval 'sub MIN {
my($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(@REM);
my(%INCD) = map { $INC{$_} => 1 } (grep { $_ eq "sys/fcntl.ph" } keys(%INC));
@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);
unless(defined(&_SOMETHING_TRIGRAPHIC)) {
eval 'sub _SOMETHING_TRIGRAPHIC () {1;}' unless defined(&_SOMETHING_TRIGRAPHIC);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_0 () {"|";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_0);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_1 () {"^";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_1);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_2 () {"[";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_2);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_3 () {"]";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_3);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_4 () {"~0";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_4);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_5 () {"\\ ";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_5);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_6 () {"{";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_6);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_7 () {"#";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_7);
eval 'sub SOMETHING_ELSE_TRIGRAPHIC_8 () {"}";}' unless defined(&SOMETHING_ELSE_TRIGRAPHIC_8);
}
if(1) {
}
eval("sub flim () { 0; }") unless defined(&flim);
eval("sub flam () { 1; }") unless defined(&flam);
eval 'sub multiline () {"multilinestring";}' unless defined(&multiline);
}
1;
--- NEW FILE: 1_compile.t ---
#!./perl
# Modules should have their own tests. For historical reasons, some
# do not. This does basic compile tests on modules that have no tests
# of their own.
BEGIN {
chdir 't';
@INC = '../lib';
}
use strict;
use warnings;
use File::Spec::Functions;
# Okay, this is the list.
my @Core_Modules = grep /\S/, <DATA>;
chomp @Core_Modules;
if (eval { require Socket }) {
push @Core_Modules, qw(Net::Domain);
# Two Net:: modules need the Convert::EBCDIC if in EBDCIC.
if (ord("A") != 193 || eval { require Convert::EBCDIC }) {
push @Core_Modules, qw(Net::Cmd Net::POP3);
}
}
if(eval { require B }) {
push @Core_Modules, qw(B::C B::CC B::Stackobj);
}
@Core_Modules = sort @Core_Modules;
print "1..".(1+ at Core_Modules)."\n";
my $message
= "ok 1 - All modules should have tests # TODO Make Schwern Poorer\n";
if (@Core_Modules) {
print "not $message";
} else {
print $message;
}
print <<'EOREWARD';
# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2001-04/msg01223.html
# 20010421230349.P2946 at blackrider.blackstar.co.uk
EOREWARD
my $test_num = 2;
foreach my $module (@Core_Modules) {
my $todo = '';
$todo = "# TODO $module needs porting on $^O" if $module eq 'ByteLoader' && $^O eq 'VMS';
print "# $module compile failed\nnot " unless compile_module($module);
print "ok $test_num $todo\n";
$test_num++;
}
# We do this as a separate process else we'll blow the hell
# out of our namespace.
sub compile_module {
my ($module) = $_[0];
my $compmod = catfile(curdir(), 'lib', 'compmod.pl');
my $lib = '-I' . catdir(updir(), 'lib');
my $out = scalar `$^X $lib $compmod $module`;
print "# $out";
return $out =~ /^ok/;
}
# These modules have no tests of their own.
# Keep up to date with
# http://www.pobox.com/~schwern/cgi-bin/perl-qa-wiki.cgi?UntestedModules
# and vice-versa. The list should only shrink.
__DATA__
ByteLoader
CPAN::FirstTime
DynaLoader
Pod::Plainer
--- NEW FILE: contains_pod.xr ---
=head1 foo
bar baz.
=cut
--- NEW FILE: commonsense.t ---
#!./perl
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
if (($Config{'extensions'} !~ /\b(DB|[A-Z]DBM)_File\b/) ){
print "Bail out! Perl configured without DB_File or [A-Z]DBM_File\n";
exit 0;
}
if (($Config{'extensions'} !~ /\bFcntl\b/) ){
print "Bail out! Perl configured without Fcntl module\n";
exit 0;
}
if (($Config{'extensions'} !~ /\bIO\b/) ){
print "Bail out! Perl configured without IO module\n";
exit 0;
}
# hey, DOS users do not need this kind of common sense ;-)
if ($^O ne 'dos' && ($Config{'extensions'} !~ /\bFile\/Glob\b/) ){
print "Bail out! Perl configured without File::Glob module\n";
exit 0;
}
print "1..1\nok 1\n";
--- NEW FILE: compmod.pl ---
#!./perl
BEGIN {
chdir 't';
@INC = '../lib';
}
my $module = shift;
# 'require open' confuses Perl, so we use instead.
eval "use $module ();";
if( $@ ) {
print "not ";
$@ =~ s/\n/\n# /g;
warn "# require failed with '$@'\n";
}
print "ok - $module\n";
--- NEW FILE: h2ph.h ---
/*
* 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 passing through the alien constructs (perlbug #34493) */
#ifdef __LANGUAGE_PASCAL__
function Tru64_Pascal(n: Integer): Integer;
#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;
/*
* Some moderate flexing of tri-graph pre substitution.
*/
??=ifndef _SOMETHING_TRIGRAPHIC
??=define _SOMETHING_TRIGRAPHIC
??= define SOMETHING_ELSE_TRIGRAPHIC_0 "??!" /* | ??!| || */
??=define SOMETHING_ELSE_TRIGRAPHIC_1 "??'" /* | ??'| ^| */
??= define SOMETHING_ELSE_TRIGRAPHIC_2 "??(" /* | ??(| [| */
??= define SOMETHING_ELSE_TRIGRAPHIC_3 "??)" /* | ??)| ]| */
??=define SOMETHING_ELSE_TRIGRAPHIC_4 "??-0" /* | ??-| ~| */
??= define SOMETHING_ELSE_TRIGRAPHIC_5 "??/ " /* | ??/| \| */
??= define SOMETHING_ELSE_TRIGRAPHIC_6 "??<" /* | ??<| {| */
??=define SOMETHING_ELSE_TRIGRAPHIC_7 "??=" /* | ??=| #| */
??= define SOMETHING_ELSE_TRIGRAPHIC_8 "??>" /* | ??>| }| */
??=endif
// test C++-style comment
#if 1
typdef struct empty_struct {
} // trailing C++-style comment should not force continuation
#endif
/* comments (that look like string) inside enums... */
enum {
/* foo;
can't
*/
};
enum flimflam {
flim,
/* foo;
can't
*/
flam
} flamflim;
/* Handle multi-line quoted strings: */
__asm__ __volatile__("
this
produces
no
output
");
#define multiline "multiline
string"
#endif /* _H2PH_H_ */
--- NEW FILE: TieOut.pm ---
package TieOut;
sub TIEHANDLE {
my $scalar = '';
bless( \$scalar, $_[0]);
}
sub PRINT {
my $self = shift;
$$self .= join('', @_);
}
sub PRINTF {
my $self = shift;
my $fmt = shift;
$$self .= sprintf $fmt, @_;
}
sub FILENO {}
sub read {
my $self = shift;
my $data = $$self;
$$self = '';
return $data;
}
1;
--- NEW FILE: cygwin.t ---
#!perl
BEGIN {
chdir 't' if -d 't';
@INC = ('../lib');
unless ($^O eq "cygwin") {
print "1..0 # skipped: cygwin specific test\n";
exit 0;
}
}
use Test::More tests => 4;
is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($$)), $$,
"perl pid translates to itself");
my $parent = getppid;
SKIP: {
skip "test not run from cygwin process", 1 if $parent <= 1;
is(Cygwin::winpid_to_pid(Cygwin::pid_to_winpid($parent)), $parent,
"parent pid translates to itself");
}
my $catpid = open my $cat, "|cat" or die "Couldn't cat: $!";
open my $ps, "ps|" or die "Couldn't do ps: $!";
my ($catwinpid) = map /^.\s+$catpid\s+\d+\s+\d+\s+(\d+)/, <$ps>;
close($ps);
is(Cygwin::winpid_to_pid($catwinpid), $catpid, "winpid to pid");
is(Cygwin::pid_to_winpid($catpid), $catwinpid, "pid to winpid");
close($cat);
More information about the dslinux-commit
mailing list