File Coverage

lib/Devel/Trepan/Condition.pm

Criterion	Covered	Total	%
statement	21	23	91.3
branch	4	6	66.6
condition			n/a
subroutine	5	5	100.0
pod	0	1	0.0
total	30	35	85.7

# -*- coding: utf-8 -*-
# Copyright (C) 2011 Rocky Bernstein <[e-mail]>
# NOTE: this does syntax checking and has problems on MS Windows.
# More specific context checking can be had in DB::Eval::eval_not_ok()
# and that is gnereally (I think) we will be using.
use strict; use warnings;
package Devel::Trepan::Condition;
use English qw( -no_match_vars );
use vars qw(@EXPORT @ISA);
@EXPORT    = qw( is_valid_condition );
@ISA = qw(Exporter);

sub is_valid_condition($) {
    my ($expr) = @_;
    return 1 if ($OSNAME eq 'MSWin32');
    my $pid = fork();
    if ($pid) {
        waitpid($pid, 0);
        return $CHILD_ERROR == 0;
    } else {
        close STDERR;
        if ($OSNAME eq 'MSWin32') {
            system ($EXECUTABLE_NAME, '-c', '-e', $expr);
            exit $?;
        } else {
            exec($EXECUTABLE_NAME, '-c', '-e', $expr);
        }
    }
}

# Demo code
unless (caller) {
    for my $expr ('$a=2', '1+', "join(', ', \@ARGV)", 'join(", ", @ARGV)') {
        my $ok = is_valid_condition($expr);
        printf("$expr is %sa valid_condition\n", $ok ? '' : 'not ');
    }
}

1;