Changeset 9671

Timestamp:

12/13/09 07:02:10 (2 years ago)

Author:

szabgab

Message:

add another test printing to STDOUT and STDERR

Location:

trunk/Debug-Client/t

Files:

• 09-io.t (added)
• eg/02-sub.pl (modified) (1 diff)
• eg/05-io.pl (added)
• lib/Debugger.pm (modified) (4 diffs)

trunk/Debug-Client/t/eg/02-sub.pl

@@ -10 +10 @@
 
 
+
 sub f {
    my ($q, $w) = @_;

trunk/Debug-Client/t/lib/Debugger.pm

@@ -10 +10 @@
 @ISA = ('Exporter');
 
-@EXPORT = qw(start_script start_debugger);
+@EXPORT = qw(start_script start_debugger slurp);
 
 my $host = 'localhost';
@@ -17 +17 @@
 sub start_script {
     my ($file) = @_;
+    my $dir = tempdir(CLEANUP => 0);
+    my $path = $dir;
+    if ($^O =~ /Win32/i) {
+        require Win32;
+        $path = Win32::GetLongPathName($path);
+    }
+    
     my $pid = fork();
-    my $dir = tempdir(CLEANUP => 1);
-
     die if not defined $pid;
 
@@ -25 +30 @@
         local $ENV{PERLDB_OPTS} = "RemotePort=$host:$port";
         sleep 1;
-        exec "$^X -d $file > $dir/out 2> $dir/err";
+        #warn "path '$path'";
+        exec qq($^X -d $file > "$path/out" 2> "$path/err");
         exit 0;
     }
@@ -39 +45 @@
 }
 
+sub slurp {
+    my ($file) = @_;
 
+    open my $fh, '<', $file or die "Could not open '$file' $!";
+    local $/ = undef;
+    return <$fh>;
+}
 1;