Subject: [tap] TAP as a Parse::RecDescent grammar

From: Michael G Schwern <[email-masked]>
Date: Thu, 22 Jan 2009 20:52:23 -0800

I took a stab at converting TAP to a Parse::RecDescent grammar.  It is
attached, along with the ABNF to RecDescent converter.  I don't really know
RecDescent so someone could please try to parse a TAP document with it and
correct any mistakes.

-- 
Ahh email, my old friend.  Do you know that revenge is a dish that is best
served cold?  And it is very cold on the Internet!

; Overall structure
Stream          = Header (Plan Body / Body Plan) Footer
Header          = [Comments] [Version]
Footer          = [Comments]
Body            = *(Comment / TAP-Line)
TAP-Line        = Test-Result / Bail-Out / Unknown
Unknown         = *(%x01-FF) EOL

; TAP version
Version         = "TAP version" SP Version-Number EOL ; ie. "TAP version 13"
Version-Number  = Positive-Integer

; Plan
Plan            = ( Plan-Simple / Plan-Todo / Plan-Skip-All ) EOL
Plan-Simple     = "1.." Number-Of-Tests
Plan-Todo       = Plan-Simple "todo" 1*(SP Test-Number) ";"  ; Obsolete
Plan-Skip-All   = "1..0" SP "skip" SP Reason
Reason          = String
Number-Of-Tests = 1*DIGIT               ; The number of tests contained in this stream
Test-Number     = Positive-Integer      ; The sequence of a test result

; Test result
Test-Result     = Status [SP Test-Number] [SP Description]
                   [SP "#" SP Directive [SP Reason]] EOL
Status          = "ok" / "not ok"       ; Whether the test succeeded or failed
Description     = Safe-String           ; A description of this test.
Directive       = "SKIP" / "TODO"

; Bail out
Bail-Out        = "Bail out!" [SP Reason] EOL

; Comments
Comment         = "#" String EOL
Comments        = 1*Comment

; Values
EOL              = LF / CRLF             ; Specific to the system producing the stream
Safe-String      = 1*(%x01-09 %x0B-0C %x0E-22 %x24-FF)  ; UTF8 without EOL or "#"
String           = 1*(Safe-String / "#")                ; UTF8 without EOL
Positive-Integer = ("1" / "2" / "3" / "4" / "5" / "6" / "7" / "8" / "9") *DIGIT
SP               = " "
DIGIT            = "0" / "1" / "2" / "3" / "4" / "5" / "6"/ "7" / "8" / "9"

; Overall structure
Passing-Stream  = Header
                  (Plan-With-Tests Passing-Body / Passing-Body Plan-With-Tests / Plan-Skip-All)
                  Footer
Passing-Body    = [Comments] 1*Passing-Line *(Passing-Line / Comment) [Comments]
Passing-Line    = (Simple-OK / Passing-TODO / Failing-TODO / Passing-SKIP) EOL
Failing-Line    = (Simple-Fail / Failing-SKIP) EOL

; Plans that must have tests
Plan-With-Tests = ( Plan-Simple / Plan-Todo )

; Passing and failing test lines
Simple-OK       = "ok" [SP Test-Number] [SP Description]        ; pass
Simple-Fail     = "not ok" [SP Test-Number] [SP Description]    ; fail
Passing-TODO    = Simple-OK   SP TODO-Directive                 ; pass (with warning)
Failing-TODO    = Simple-Fail SP TODO-Directive                 ; pass
Passing-SKIP    = Simple-OK   SP SKIP-Directive                 ; pass
Failing-SKIP    = Simple-Fail SP SKIP-Directive                 ; fail (with warning)
TODO-Directive  = "# TODO" [SP Reason]
SKIP-Directive  = "# SKIP" [SP Reason]
Stream:              (Header (Plan Body) | (Body Plan) Footer)
Header:              (Comments(0..1) Version(0..1))
Footer:              Comments(0..1)
Body:                Comment | TAP_Line(0..)
TAP_Line:            Test_Result | Bail_Out | Unknown
Unknown:             (/[\x01-\xFF]/(0..) EOL)
Version:             ('TAP version' SP Version_Number EOL)
Version_Number:      Positive_Integer
Plan:                (Plan_Simple | Plan_Todo | Plan_Skip_All EOL)
Plan_Simple:         ('1..' Number_Of_Tests)
Plan_Todo:           (Plan_Simple 'todo' (SP Test_Number)(1..) ';')
Plan_Skip_All:       ('1..0' SP 'skip' SP Reason)
Reason:              String
Number_Of_Tests:     DIGIT(1..)
Test_Number:         Positive_Integer
Test_Result:         (Status (SP Test_Number)(0..1) (SP Description)(0..1) (SP '#' SP Directive (SP Reason)(0..1))(0..1) EOL)
Status:              'ok' | 'not ok'
Description:         Safe_String
Directive:           'SKIP' | 'TODO'
Bail_Out:            ('Bail out!' (SP Reason)(0..1) EOL)
Comment:             ('#' String EOL)
Comments:            Comment(1..)
EOL:                 LF | CRLF
Safe_String:         (/[\x01-\x09]/ /[\x0B-\x0C]/ /[\x0E-\x22]/ /[\x24-\xFF]/)(1..)
String:              Safe_String | '#'(1..)
Positive_Integer:    ('1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' DIGIT(0..))
SP:                  ' '
DIGIT:               '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9'
Passing_Stream:      (Header (Plan_With_Tests Passing_Body) | (Passing_Body Plan_With_Tests) | Plan_Skip_All Footer)
Passing_Body:        (Comments(0..1) Passing_Line(1..) Passing_Line | Comment(0..) Comments(0..1))
Passing_Line:        (Simple_OK | Passing_TODO | Failing_TODO | Passing_SKIP EOL)
Failing_Line:        (Simple_Fail | Failing_SKIP EOL)
Plan_With_Tests:     Plan_Simple | Plan_Todo
Simple_OK:           ('ok' (SP Test_Number)(0..1) (SP Description)(0..1))
Simple_Fail:         ('not ok' (SP Test_Number)(0..1) (SP Description)(0..1))
Passing_TODO:        (Simple_OK SP TODO_Directive)
Failing_TODO:        (Simple_Fail SP TODO_Directive)
Passing_SKIP:        (Simple_OK SP SKIP_Directive)
Failing_SKIP:        (Simple_Fail SP SKIP_Directive)
TODO_Directive:      ('# TODO' (SP Reason)(0..1))
SKIP_Directive:      ('# SKIP' (SP Reason)(0..1))
#!/usr/bin/perl -w

use Parse::ABNF;
use Parse::RecDescent;

use strict;

my $rules = Parse::ABNF->new->parse(join "", <>);

# Not handled are..
# A /= B
my %ABNF2Rec = (
    Rule        => sub {
        my $rule = shift;

        my $name = fix_name($rule);
        return sprintf "%-20s %s\n", "$name:", value($rule);
    },

    Choice      => sub {
        my $rule = shift;
        return join " | ", value($rule);
    },

    Group       => sub {
        my $rule = shift;
        return sprintf "(%s)", join " ", value($rule);
    },

    Reference => sub {
        my $rule = shift;
        return fix_name($rule);
    },

    Repetition => sub {
        my $rule = shift;

        my($min, $max) = map { defined $_ ? $_ : '' } $rule->{min}, $rule->{max};
        return sprintf "%s(%s..%s)", value($rule), $min, $max;
    },

    Literal => sub {
        my $rule = shift;

        return sprintf qq['%s'], $rule->{value};
    },

    ProseValue => sub {
        my $rule = shift;

        return value($rule);
    },

    String => sub {
        my $rule = shift;

        return sprintf q["%s"], join "", to_hexchars($rule->{type}, $rule->{value});
    },

    Range => sub {
        my $rule = shift;

        return sprintf q{/[%s-%s]/}, to_hexchars($rule->{type}, [$rule->{min}, $rule->{max}]);
    }
);

sub to_hexchars {
    my($type, $values) = @_;

    my $converter = $type eq 'hex'          ? sub { hex $_[0] }         :
                    $type eq 'binary'       ? sub { oct "0b$_[0]" }     :
                    $type eq 'decimal'      ? sub { $_[0] }             :
                                              die "Unknown type: $type" ;

    return map { sprintf '\x%02X', $converter->($_) } @$values;
}

sub value {
    my $rule = shift;
    my @values = ref $rule->{value} eq 'ARRAY' ? @{$rule->{value}} : $rule->{value};

    return map { ref $_ ? convert($_) : $_ } @values;
}

sub convert {
    my $rule = shift;

    return $ABNF2Rec{$rule->{class}}->($rule);
}

# RecDescent only allows /[A-Za-z]\w*/ as rule names.
sub fix_name {
    my $rule = shift;
    my $name = $rule->{name};
    $name =~ s{[^A-Za-z\w*]}{_}g;
    return $name;
}

my $recdescent = join '', map { convert($_) } @$rules;
#my $parser = Parse::RecDescent->new($recdescent);
print $recdescent;

_______________________________________________
tap mailing list
[email-masked]
https://www.ietf.org/mailman/listinfo/tap