develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About