Question

Is there a TAP (Test Anything Protocol) implementation for VHDL? It would be nice because then I could use prove to check my results automatically. There are also nice formatting swuites such as smolder that can process it output. You might ask why not use assertions. Partly TAP gives me some good reporting such as number of files and number of tests. I’m looking for a minimal implentation with number of tests at the beginning and end and the ok, diag and fail functions. is() would really nice, but not necessary. I could write this, but why reinvent the wheel.

This is the question as in this question but for VHDL instead of Verilog.

Answer 1

I wrote one that I’ve used a lot, but I’ve never distributed it. Here it is (the not-included base_pkg mostly has to_string() implementations for everything).

-- Copyright © 2010 Wesley J. Landaker <[e-mail]>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.

-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

-- Output is standard TAP (Test Anything Protocol) version 13

package test_pkg is

  procedure test_redirect(filename : string);
  procedure test_plan(tests : natural; directive : string := "");
  procedure test_abort(reason : string);
  procedure test_finished(directive : string := "");
  procedure test_comment (message : string);
  procedure test_pass (description : string := ""; directive : string := "");
  procedure test_fail (description : string := ""; directive : string := "");
  procedure test_ok   (result : boolean; description : string := ""; directive : string := "");
  procedure test_equal(actual, expected : integer; description : string := ""; directive : string := "");
  procedure test_equal(actual, expected : real; description : string := ""; directive : string := "");
  procedure test_equal(actual, expected : time; description : string := ""; directive : string := "");
  procedure test_equal(actual, expected : string; description : string := ""; directive : string := "");
  procedure test_equal(actual, expected : bit_vector; description : string := ""; directive : string := "");
  procedure test_approx_absolute(actual, expected, absolute_error : real; description : string := ""; directive : string := "");
  procedure test_approx_relative(actual, expected, relative_error : real; description : string := ""; directive : string := "");

end package;

use std.textio.all;
use work.base_pkg.all;

package body test_pkg is

  file test_output : text;
  shared variable initialized : boolean := false;
  shared variable have_plan : boolean := false;
  shared variable last_test_number : natural := 0;

  function remove_eol(s : string) return string is
    variable s_no_eol : string(s'range);
  begin
    for i in s'range loop
      case s(i) is
        when LF | CR => s_no_eol(i) := '_';
        when others  => s_no_eol(i) := s(i);
      end case;
    end loop;
    return s_no_eol;
  end function;

  function make_safe (s : string) return string is
    variable s_no_hash : string(s'range);
  begin
    for i in s'range loop
      case s(i) is
        when '#'    => s_no_hash(i) := '_';
        when others => s_no_hash(i) := s(i);
      end case;
    end loop;
    return remove_eol(s_no_hash);
  end function;

  procedure init is
    variable l : line;
  begin
    if initialized then
      return;
    end if;
    initialized := true;
    file_open(test_output, "STD_OUTPUT", write_mode);
    write(l, string'("TAP version 13"));
    writeline(test_output, l);
  end procedure;

  procedure test_redirect(filename : string) is
  begin
    init;
    file_close(test_output);
    file_open(test_output, filename, write_mode);
  end procedure;

  procedure test_plan(tests : natural; directive : string := "") is
    variable l : line;
  begin
    init;
    have_plan := true;
    write(l, string'("1.."));
    write(l, tests);
    if directive'length > 0 then
      write(l, " # " & remove_eol(directive));
    end if;
    writeline(test_output, l);
  end procedure;

  procedure test_abort(reason : string) is
    variable l : line;
  begin
    init;
    write(l, "Bail out! " & remove_eol(reason));
    writeline(test_output, l);
    assert false
      report "abort called"
      severity failure;
  end procedure;

  procedure test_finished (directive : string := "") is
  begin
    if not have_plan then
      test_plan(last_test_number, directive);
    elsif directive'length > 0 then
      test_comment("1.." & integer'image(last_test_number) & " # " & directive);
    else
      test_comment("1.." & integer'image(last_test_number));
    end if;
  end procedure;

  procedure test_comment (message : string) is
    variable l : line;
  begin
    init;
    write(l, '#');
    if message'length > 0 then
      write(l, " " & remove_eol(message));
    end if;
    writeline(test_output, l);
  end procedure;

  procedure result (status : string; description : string; directive : string) is
    variable l : line;
  begin
    init;
    last_test_number := last_test_number + 1;
    write(l, status & " ");
    write(l, last_test_number);
    if description'length > 0 then
      write(l, " " & make_safe(description));
    end if;
    if directive'length > 0 then
      write(l, " # " & remove_eol(directive));
    end if;
    writeline(test_output, l);
  end procedure;

  procedure test_pass (description : string := ""; directive : string := "") is
  begin
    result("ok", description, directive);
  end procedure;

  procedure test_fail (description : string := ""; directive : string := "") is
  begin
    result("not ok", description, directive);
  end procedure;

  procedure test_ok (result : boolean; description : string := ""; directive : string := "") is
  begin
    if result then
      test_pass(description, directive);
    else
      test_fail(description, directive);
    end if;
  end procedure;

  procedure test_equal(actual, expected : integer; description : string := ""; directive : string := "") is
    variable ok : boolean := actual = expected;
  begin
    test_ok(ok, description, directive);
    if not ok then
      test_comment("actual = " & integer'image(actual) & ", expected = " & integer'image(expected));
    end if;
  end procedure;

  procedure test_equal(actual, expected : real; description : string := ""; directive : string := "") is
    variable ok : boolean := actual = expected;
  begin
    test_ok(ok, description, directive);
    if not ok then
      test_comment("actual = " & real'image(actual) & ", expected = " & real'image(expected));
    end if;
  end procedure;

  procedure test_equal(actual, expected : time; description : string := ""; directive : string := "") is
    variable ok : boolean := actual = expected;
  begin
    test_ok(ok, description, directive);
    if not ok then
      test_comment("actual = " & time'image(actual) & ", expected = " & time'image(expected));
    end if;
  end procedure;

  procedure test_equal(actual, expected : string; description : string := ""; directive : string := "") is
    variable ok : boolean := actual = expected;
  begin
    test_ok(ok, description, directive);
    if not ok then
      test_comment("actual = " & actual & ", expected = " & expected);
    end if;
  end procedure;

  procedure test_equal(actual, expected : bit_vector; description : string := ""; directive : string := "") is
    variable ok : boolean := actual = expected;
  begin
    test_ok(ok, description, directive);
    if not ok then
      test_comment("actual = " & to_string(actual) & ", expected = " & to_string(expected));
    end if;
  end procedure;

  procedure test_approx_absolute(actual, expected, absolute_error : real; description : string := ""; directive : string := "") is
    variable err : real := abs(actual - expected);
    variable ok : boolean := err <= absolute_error;
  begin
    test_ok(ok, description, directive);
    if not ok then
      test_comment("actual = " & to_string(actual) & ", expected = " & to_string(expected) & ", absolute error = " & to_string(err));
    end if;
  end procedure;

  procedure test_approx_relative(actual, expected, relative_error : real; description : string := ""; directive : string := "") is
    variable err : real := abs(actual - expected)/abs(expected);
    variable ok : boolean := err <= relative_error;
  begin
    test_ok(ok, description, directive);
    if not ok then
      test_comment("actual = " & to_string(actual) & ", expected = " & to_string(expected) & ", relative error = " & to_string(err));
    end if;
  end procedure;

end package body;