Front page | perl.perl5.porters |
Postings from April 2003
[PATCH 5.8.1 @19053] microperl
Thread Next
From:
Ilya Zakharevich
Date:
April 1, 2003 13:33
Subject:
[PATCH 5.8.1 @19053] microperl
Message ID:
20030401213301.GA4773@math.berkeley.edu
With these patches
make CC="gcc -Zmtd -Zexe" -f Makefile.micro
cp microperl.exe t/perl.exe
cd t
perl.exe harness base/*.t comp/*.t cmd/*.t run/*.t io/*.t op/*.t uni/*.t
"works" here. No core dumps during the tests. The results are provided below.
Comments: the open_script() chunk looks fishy, but without it I get segfaults.
The actual problem may be in a different place.
uconfig.h chunk should be moved in the script which generates it.
However, here I can't run this script.
Cwd.pm chunk fixes a buglet: *PARENT was not localized (maybe
not needed?).
The parse_body() chunk I do not understand completely: apparently,
BEGIN{} is needed (?!). Maybe one can put "\n"s there too, but
I did not try.
[I did not try to fix individual tests.]
[Makefile.SH puts the "special perls" targets in the same chunk
as perl$(EXE_EXT), so they are confined to "no special
instructions for exe/dlls" branch. Should not this special branch
be restricted to perl$(EXE_EXT), and the rest of targets be always
included? Grep for microperl...]
Enjoy,
Ilya
Failed 45/194 test scripts, 76.80% okay. 354/27082 subtests failed, 98.69% okay.
Failed Test Stat Wstat Total Fail Failed List of Failed
-------------------------------------------------------------------------------
comp/proto.t 140 4 2.86% 136-139
comp/redef.t 20 19 95.00% 1-19
comp/require.t 23 3 13.04% 21-23
io/argv.t 22 6 27.27% 8-9 11-12 21-22
io/dup.t 2 512 8 7 87.50% 2-8
io/fs.t 34 5 14.71% 1 16 18-19 33
io/inplace.t 2 2 100.00% 1-2
io/iprefix.t 2 2 100.00% 1-2
io/open.t 95 8 8.42% 4 44 90-95
io/openpid.t 2 512 10 5 50.00% 6-10
io/tell.t 27 3 11.11% 25-27
op/alarm.t 2 512 4 4 100.00% 1-4
op/assignwarn.t 63 24 38.10% 5 9-13 18-20 25-27 36 40-44 49-
51 56-58
op/attrs.t 47 2 4.26% 32-33
op/bless.t 31 2 6.45% 26 28
op/chdir.t 31 18 58.06% 1-4 6-13 15-20
op/crypt.t 2 512 4 4 100.00% 1-4
op/defins.t 2 512 14 9 64.29% 6-14
op/die.t 10 7 70.00% 1 3-6 8-9
op/fh.t 8 2 25.00% 6 8
op/flip.t 15 2 13.33% 13-14
op/getpid.t 255 65280 ?? ?? % ??
op/gv.t 48 4 8.33% 16 24 47-48
op/hashwarn.t 9 8 88.89% 1-8
op/join.t 14 2 14.29% 9-10
op/lex_assign.t 187 1 0.53% 105
op/local.t 75 2 2.67% 48 51
op/magic.t 52 5 9.62% 3-6 26
op/mkdir.t 13 9 69.23% 1 3-5 8-12
op/override.t 21 2 9.52% 20-21
op/pack.t 5849 3 0.05% 45 1532-1533
op/pat.t 996 10 1.00% 616-625
op/ref.t 63 1 1.59% 53
op/regmesg.t 36 7 19.44% 30-36
op/runlevel.t 21 2 9.52% 5 18
op/sprintf.t 243 53 21.81% 1-6 14-20 22-26 28-29 32-34 130
138 169 171-174 183-185 196
204-205 215-216 223-229 234
236-237 239-243
op/stat.t 73 1 1.37% 21
op/study.t 26 2 7.69% 25-26
op/substr.t 175 20 11.43% 4 11 24 30 32 44 46 48 50 85 87
89 91 93 95 97 99 113-114 118
op/taint.t 206 35 16.99% 13 15 18-20 29 31 40-42 53-54
89 93 101 118 120-121 123-124
126-127 129-130 132-133 135-136
138-139 141 145 153-155
op/time.t 7 1 14.29% 2
op/write.t 2 512 47 41 87.23% 7-47
run/fresh_perl.t 91 3 3.30% 47 54 82
run/switches.t 20 1 5.00% 17
run/switcht.t 11 3 27.27% 3 7 9
(8 subtests UNEXPECTEDLY SUCCEEDED), 19 tests and 347 subtests skipped.
--- ./Makefile.micro-premic Thu Feb 27 23:47:20 2003
+++ ./Makefile.micro Tue Apr 1 13:10:48 2003
@@ -1,9 +1,11 @@
LD = $(CC)
-DEFINES = -DPERL_CORE -DPERL_MICRO
+# HAS_RENAME disables link() in doio.c, which has much larger probability to miss
+DEFINES = -DPERL_CORE -DPERL_MICRO -DSTANDARD_C -DI_STDLIB -DHAS_RENAME
OPTIMIZE =
CFLAGS = $(DEFINES) $(OPTIMIZE)
LIBS = -lm
_O = .o
+ENV = env
all: microperl
@@ -15,7 +17,7 @@ O = uav$(_O) udeb$(_O) udoio$(_O) udoop$
uregcomp$(_O) uregexec$(_O) urun$(_O) \
uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \
unumeric$(_O) ulocale$(_O) \
- uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O)
+ uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) uxsutils$(_O)
microperl: $(O)
$(LD) -o $@ $(O) $(LIBS)
@@ -37,7 +39,7 @@ distclean: clean
# The microconfiguration.
uconfig.h: uconfig.sh config_h.SH
- CONFIG_SH=uconfig.sh CONFIG_H=uconfig.h sh ./config_h.SH
+ $(ENV) CONFIG_SH=uconfig.sh CONFIG_H=uconfig.h sh ./config_h.SH
# Do not regenerate perly.c and perly.h.
@@ -80,7 +82,7 @@ uperlmain$(_O): $(HE) miniperlmain.c
$(CC) -c -o $@ $(CFLAGS) miniperlmain.c
uop$(_O): $(HE) op.c keywords.h
- $(CC) -c -o $@ $(CFLAGS) op.c
+ $(CC) -c -o $@ $(CFLAGS) -DPERL_EXTERNAL_GLOB op.c
ureentr$(_O): $(HE) reentr.c
$(CC) -c -o $@ $(CFLAGS) reentr.c
@@ -154,4 +156,5 @@ uutil$(_O): $(HE) util.c
uperlapi$(_O): $(HE) perlapi.c perlapi.h
$(CC) -c -o $@ $(CFLAGS) perlapi.c
-
+uxsutils$(_O): $(HE) xsutils.c regcomp.h regnodes.h
+ $(CC) -c -o $@ $(CFLAGS) xsutils.c
--- ./perl.c-premic Fri Mar 14 04:04:04 2003
+++ ./perl.c Tue Apr 1 13:12:32 2003
@@ -1114,6 +1114,45 @@ S_parse_body(pTHX_ char **env, XSINIT_t
SAVEFREESV(sv);
init_main_stash();
+#ifdef PERL_MICRO
+ { /* Microperl has no support for opendir... */
+ char s[] = /* Should fit one line */
+ "BEGIN {"
+ " my $f='0000pdir.lst';"
+ " *CORE::GLOBAL::opendir = sub (*$) {"
+ " my $dir = $_[1];"
+ /* Double-quotes are most portable... */
+ " my $r = eval {open $_[0], qq(ls \"$dir\" |)};"
+ " return $r if $r;"
+ " system qq(ls \"$dir\" > $f) and die 'system() failed';"
+ " open $_[0], $f};"
+ " *CORE::GLOBAL::readdir = sub (*) {"
+ " my($h) = @_; if (wantarray) {"
+ " my @in = <$h>;"
+ " chop @in;"
+ " return @in"
+ " } else {"
+ " my $in = <$h>;"
+ " chop $in;"
+ " $in"
+ " }};"
+ " *CORE::GLOBAL::closedir = sub (*) {"
+ " my($h) = @_;"
+ " my $res = close $h;"
+ " unlink $f;"
+ " $res};"
+ " *CORE::GLOBAL::times = sub () {"
+ " (0,0,0,0)};"
+ "}"
+ ;
+
+ if (!PL_preambleav)
+ PL_preambleav = newAV();
+ av_push(PL_preambleav, newSVpv(s,0));
+/* eval_pv(s, TRUE); */
+ }
+#endif
+
for (argc--,argv++; argc > 0; argc--,argv++) {
if (argv[0][0] != '-' || !argv[0][1])
break;
@@ -1452,9 +1491,7 @@ print \" \\@INC:\\n @INC\\n\";");
boot_core_PerlIO();
boot_core_UNIVERSAL();
-#ifndef PERL_MICRO
boot_core_xsutils();
-#endif
if (xsinit)
(*xsinit)(aTHX); /* in case linked C routines want magical variables */
@@ -2831,6 +2868,8 @@ S_open_script(pTHX_ char *scriptname, bo
SV *cpp = newSVpvn("",0);
SV *cmd = NEWSV(0,0);
+ if (cpp_cfg[0] == 0) /* PERL_MICRO? */
+ Perl_croak(aTHX_ "Can't run with -P with CPPSTDIN not defined");
if (strEQ(cpp_cfg, "cppstdin"))
Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
sv_catpv(cpp, cpp_cfg);
--- ./perl.h-premic Mon Mar 17 12:25:16 2003
+++ ./perl.h Mon Mar 31 22:47:30 2003
@@ -288,7 +288,7 @@ register struct op *Perl_op asm(stringif
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(__EMX__) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE)
# define DONT_DECLARE_STD 1
#endif
--- ./pp_sys.c-premic Thu Mar 13 13:22:36 2003
+++ ./pp_sys.c Tue Apr 1 13:13:58 2003
@@ -4109,6 +4109,8 @@ PP(pp_system)
PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+#else
+ PerlLIO_close(pp[1]); /* Do as best as we can: pretend success */
#endif
}
if (PL_op->op_flags & OPf_STACKED) {
--- ./uconfig.h-premic Mon Jan 20 11:05:38 2003
+++ ./uconfig.h Mon Mar 31 23:41:06 2003
@@ -3769,7 +3769,7 @@
* /bin/pdksh, /bin/ash, /bin/bash, or even something such as
* D:/bin/sh.exe.
*/
-#define SH_PATH "" /**/
+#define SH_PATH "sh" /**/
/* USE_CROSS_COMPILE:
* This symbol, if defined, indicates that Perl is being cross-compiled.
--- ./util.c-premic Sun Mar 9 07:13:12 2003
+++ ./util.c Tue Apr 1 12:27:52 2003
@@ -1819,6 +1819,8 @@ Perl_my_popen_list(pTHX_ char *mode, int
#if defined(HAS_FCNTL) && defined(F_SETFD)
/* Close error pipe automatically if exec works */
fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+#else
+ PerlLIO_close(pp[1]); /* Do as best as we can: pretend success */
#endif
}
/* Now dup our end of _the_ pipe to right position */
@@ -1958,6 +1960,8 @@ Perl_my_popen(pTHX_ char *cmd, char *mod
PerlLIO_close(pp[0]);
#if defined(HAS_FCNTL) && defined(F_SETFD)
fcntl(pp[1], F_SETFD, FD_CLOEXEC);
+#else
+ PerlLIO_close(pp[1]); /* Do as best as we can: pretend success */
#endif
}
if (p[THIS] != (*mode == 'r')) {
@@ -2113,6 +2117,20 @@ Perl_my_fork(void)
{
#if defined(HAS_FORK)
Pid_t pid;
+#ifdef PERL_MICRO
+ /* Emulate $| = 1 */
+ {
+ IO *io = GvIOp(PL_defoutgv);
+ if(!io)
+ goto pipe_done;
+ if (!(IoFLAGS(io) & IOf_FLUSH)) {
+ PerlIO *ofp = IoOFP(io);
+ if (ofp)
+ (void)PerlIO_flush(ofp);
+ }
+ }
+ pipe_done:
+#endif
#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) && !defined(HAS_PTHREAD_ATFORK)
atfork_lock();
pid = fork();
--- ./lib/Cwd.pm-premic Sun Nov 3 22:34:38 2002
+++ ./lib/Cwd.pm Mon Mar 31 23:20:28 2003
@@ -253,7 +253,7 @@ sub getcwd
sub fastcwd {
my($odev, $oino, $cdev, $cino, $tdev, $tino);
my(@path, $path);
- local(*DIR);
+ my $DIR;
my($orig_cdev, $orig_cino) = stat('.');
($cdev, $cino) = ($orig_cdev, $orig_cino);
@@ -263,9 +263,9 @@ sub fastcwd {
CORE::chdir('..') || return undef;
($cdev, $cino) = stat('.');
last if $odev == $cdev && $oino == $cino;
- opendir(DIR, '.') || return undef;
+ opendir($DIR, '.') || return undef;
for (;;) {
- $direntry = readdir(DIR);
+ $direntry = readdir($DIR);
last unless defined $direntry;
next if $direntry eq '.';
next if $direntry eq '..';
@@ -273,7 +273,7 @@ sub fastcwd {
($tdev, $tino) = lstat($direntry);
last unless $tdev != $odev || $tino != $oino;
}
- closedir(DIR);
+ closedir($DIR);
return undef unless defined $direntry; # should never happen
unshift(@path, $direntry);
}
@@ -375,11 +375,12 @@ sub _perl_abs_path
}
$cwd = '';
$dotdots = $start;
+ my $PARENT;
do
{
$dotdots .= '/..';
@pst = @cst;
- unless (opendir(PARENT, $dotdots))
+ unless (opendir($PARENT, $dotdots))
{
carp "opendir($dotdots): $!";
return '';
@@ -387,7 +388,7 @@ sub _perl_abs_path
unless (@cst = stat($dotdots))
{
carp "stat($dotdots): $!";
- closedir(PARENT);
+ closedir($PARENT);
return '';
}
if ($pst[0] == $cst[0] && $pst[1] == $cst[1])
@@ -398,10 +399,10 @@ sub _perl_abs_path
{
do
{
- unless (defined ($dir = readdir(PARENT)))
+ unless (defined ($dir = readdir($PARENT)))
{
carp "readdir($dotdots): $!";
- closedir(PARENT);
+ closedir($PARENT);
return '';
}
$tst[0] = $pst[0]+1 unless (@tst = lstat("$dotdots/$dir"))
@@ -410,7 +411,7 @@ sub _perl_abs_path
$tst[1] != $pst[1]);
}
$cwd = (defined $dir ? "$dir" : "" ) . "/$cwd" ;
- closedir(PARENT);
+ closedir($PARENT);
} while (defined $dir);
chop($cwd) unless $cwd eq '/'; # drop the trailing /
$cwd;
Thread Next
-
[PATCH 5.8.1 @19053] microperl
by Ilya Zakharevich