cvsuser 04/02/26 00:33:28
Modified: classes env.pmc
imcc/t/syn file.t
t/pmc env.t
Log:
win98 fixes
imcc/t/syn/file.t: has a qx() use 2>&1, and later an (unnecessary) qx() using
single quotes, neither of which the windows 98 shell supports.
classes/env.pmc: used getenv() when it should use Parrot_getenv()
t/pmc/env.t: parrot can't change or delete the PARROT_TMP that this sets so
tests 3, 5, and 6 were failing - added a delete {'PARROT_TMP'} after test 2
Courtesy of Goplat
Revision Changes Path
1.13 +25 -23 parrot/classes/env.pmc
Index: env.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/env.pmc,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- env.pmc 22 Feb 2004 17:48:41 -0000 1.12
+++ env.pmc 26 Feb 2004 08:33:21 -0000 1.13
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: env.pmc,v 1.12 2004/02/22 17:48:41 mikescott Exp $
+$Id: env.pmc,v 1.13 2004/02/26 08:33:21 leo Exp $
=head1 NAME
@@ -120,10 +120,12 @@
void delete_keyed(PMC* key) {
char *keyname = string_to_cstring(interpreter,
VTABLE_get_string(interpreter, key));
+ int free_it;
if (keyname) {
- char *val = getenv(keyname);
+ char *val = Parrot_getenv(keyname, &free_it);
if (val) {
+ if (free_it) mem_sys_free(val);
Parrot_unsetenv(keyname);
}
string_cstring_free(keyname);
1.24 +22 -14 parrot/imcc/t/syn/file.t
Index: file.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/syn/file.t,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- file.t 17 Feb 2004 09:37:59 -0000 1.23
+++ file.t 26 Feb 2004 08:33:25 -0000 1.24
@@ -1,6 +1,6 @@
#!perl
-# $Id: file.t,v 1.23 2004/02/17 09:37:59 leo Exp $
+# $Id: file.t,v 1.24 2004/02/26 08:33:25 leo Exp $
=head1 NAME
@@ -8,7 +8,7 @@
=head1 SYNOPSIS
-A test script which is suppossed to be called by Test::Harness.
+A test script which is supposed to be called by Test::Harness.
=cut
@@ -23,7 +23,7 @@
my $PERL5 = $PConfig{perl};
##############################
-open FOO, ">temp.pasm" or die "Cant write temp.pasm\n";
+open FOO, ">temp.pasm" or die "Can't write temp.pasm\n";
print FOO <<'ENDF';
.constant BAR 42
ENDF
@@ -45,7 +45,7 @@
unlink "temp.pasm";
##############################
-open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO <<'ENDF';
.const int BAR = 42
ENDF
@@ -67,7 +67,7 @@
unlink "temp.imc";
##############################
-open FOO, ">temp.inc" or die "Cant write temp.inc\n";
+open FOO, ">temp.inc" or die "Can't write temp.inc\n";
print FOO <<'ENDF';
.const int BAR = 42
ENDF
@@ -148,7 +148,7 @@
# test load_bytecode branches and subs
# write sub2
-open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO <<'ENDF';
.pcc_sub _sub2 prototyped
print "sub2\n"
@@ -179,7 +179,7 @@
OUT
# write sub2
-open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO <<'ENDF';
.pcc_sub _sub2 prototyped
print "sub2\n"
@@ -214,7 +214,7 @@
OUT
# write sub2
-open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO <<'ENDF';
.pcc_sub _not_sub2 prototyped
print "not sub2\n"
@@ -250,7 +250,7 @@
OUT
# write sub2
-open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO <<'ENDF';
.pcc_sub _sub2 prototyped
print "sub2\n"
@@ -308,7 +308,7 @@
OUT
# write subs
-open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO <<'ENDF';
.pcc_sub _sub1 prototyped
print "sub1\n"
@@ -344,7 +344,7 @@
# include a non-existent file and catch the error message
my $err_msg;
{
- open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+ open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO << 'END_PIR';
# Including a non-existent file should produce an error
.include "non_existent.imc"
@@ -355,14 +355,22 @@
.end
END_PIR
close FOO;
- $err_msg = qx{$PARROT temp.imc 2>&1}
+ open OLDERR, ">&STDERR" or die "Can't save STDERR\n";
+ open STDERR, ">temp.out" or die "Can't write temp.out\n";
+ system "$PARROT temp.imc";
+ open FOO, "<temp.out" or die "Can't read temp.out\n";
+ { local $/; $err_msg = <FOO>; }
+ close FOO;
+ open STDERR, ">&OLDERR" or die "Can't restore STDERR\n";
+ unlink "temp.out";
}
# read a non-existent file and catch the error message
my $enoent_err_msg;
{
- my $ENOENT = qx{$PERL5 -e 'open FOO, "<non_existent.file"; print( \$! + 0 )'};
- open FOO, ">temp.imc" or die "Cant write temp.imc\n";
+ open FOO, "<non_existent.file";
+ my $ENOENT = $! + 0;
+ open FOO, ">temp.imc" or die "Can't write temp.imc\n";
print FOO << "END_PIR";
.sub _main
# run a OS command, and get the errmessge for the exit code
1.8 +3 -2 parrot/t/pmc/env.t
Index: env.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/env.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- env.t 22 Feb 2004 22:55:29 -0000 1.7
+++ env.t 26 Feb 2004 08:33:28 -0000 1.8
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: env.t,v 1.7 2004/02/22 22:55:29 mikescott Exp $
+# $Id: env.t,v 1.8 2004/02/26 08:33:28 leo Exp $
=head1 NAME
@@ -10,7 +10,7 @@
% perl t/pmc/env.t
-=head1 DECSRIPTION
+=head1 DESCRIPTION
Tests the C<Env> PMC.
@@ -42,6 +42,7 @@
/riding a ponie/i
OUT
+delete $ENV{"PARROT_TMP"};
output_like(<<'CODE', <<OUT, "setenv/getenv");
new P0, .Env
set P0["PARROT_TMP"], "hello polly"
