#!/usr/bin/perl use strict; use warnings; my $numtests; BEGIN { $numtests = 12; } use Test::More tests => $numtests; BEGIN { use_ok('GRID::Machine', 'is_operative') }; my $test_exception_installed; BEGIN { $test_exception_installed = 1; eval { require Test::Exception }; $test_exception_installed = 0 if $@; } sub e2r { local $_ = shift; s/\s+//g; $_ = quotemeta; $_ = qr{$_}; } my $debug = @ARGV ? 1234 : 0; my $host = $ENV{GRID_REMOTE_MACHINE} || ''; SKIP: { skip "Remote not operative or Test::Exception not installed", $numtests-1 unless $test_exception_installed and $host && is_operative('ssh', $host); my $machine; Test::Exception::lives_ok { $machine = GRID::Machine->new( host => $host, #prefix => "/tmp/perl5lib$$", startdir => '/tmp', log => '/tmp/rperl$$.log', err => '/tmp/rperl$$.err', debug => $debug, cleanup => 1, sendstdout => 1 ); } 'No fatals creating a GRID::Machine object'; my $p = { name => 'Peter', familyname => [ 'Smith', 'Garcia'] }; { # test error messages: line number for EVAL my $r = $machine->eval( q{ $q = shift; $q->{familyname} }, $p); my $expected = qr{ Error\s+while\s+compiling\s+eval\s+'.q\s+=\s+shift;\s+.q->.fam...'\s+ Global\s+symbol\s+".q"\s+requires\s+explicit\s+package\s+name\s+at\s+t/19syntaxerr.t\s+line\s+52, }xs; my $err = $r->errmsg; like($err, $expected, q{Error line is pointed in eval accurately}); is($r->stdout, '', q{nothing in stdout}); is($r->errcode, 0, q{errcode is 0}); is($r->stderr, '', q{stderr is ''}); is($r->type, 'DIED', q{type is 'DIED'}); } { # test error messages: line number for SUB my $r = $machine->sub(chuchu => q{ $q = shift; $q->{familyname} }); # do not move this line. Must be line 72!!!!! my $expected = qr{ Error\s+while\s+compiling\s+'chuchu'.\s+Global\s+symbol\s+".q"\s+requires\s+explicit\s+package\s+name\s+at\s+t/19syntaxerr.t\s+line\s+73,\s+\s+line\s+\d+.\s+ Global\s+symbol\s+".q"\s+requires\s+explicit\s+package\s+name\s+at\s+t/19syntaxerr.t\s+line\s+73,\s+\s+line\s+\d+ }xs; my $err = $r->errmsg; like($err, $expected, q{Error line is pointed in sub accurately}); is($r->stdout, '', q{nothing in stdout}); is($r->errcode, 0, q{errcode is 0}); is($r->stderr, '', q{stderr is ''}); is($r->type, 'DIED', q{type is 'DIED'}); } } # END SKIP