Project: Filelist Generator

#!/usr/bin/perl
# make_tree.pl -- build the SAMPLE project tree this chapter runs against.
# Usage: perl make_tree.pl DIR      (DIR must not exist yet)
# Every file below is written for this chapter. The design is small but real:
# Icarus Verilog compiles it from the generated filelist and the testbench
# prints PASSED. The junk files are the kinds a real tree accumulates.
use strict;
use warnings;
use File::Path qw(make_path);
use File::Basename qw(dirname);

my $dir = shift // die "usage: perl make_tree.pl DIR\n";
die "make_tree.pl: $dir already exists\n" if -e $dir;

my %file = (
  "rtl/include/widths.svh" => <<'SV',
`ifndef WIDTHS_SVH
`define WIDTHS_SVH
`define DATA_W 8
`endif
SV
  "rtl/core/chip_pkg.sv" => <<'SV',
package chip_pkg;
  localparam int COUNT_MAX = 12;
endpackage
SV
  "rtl/core/types_pkg.sv" => <<'SV',
package types_pkg;
  import chip_pkg::*;
  typedef enum logic [1:0] { OP_ADD, OP_SUB, OP_PASS } op_t;
endpackage
SV
  "rtl/core/alu.sv" => <<'SV',
`include "widths.svh"
module alu (input logic [1:0] op, input logic [`DATA_W-1:0] a, b,
            output logic [`DATA_W-1:0] y);
  import types_pkg::*;
  always_comb
    case (op_t'(op))
      OP_ADD:  y = a + b;
      OP_SUB:  y = a - b;
      default: y = a;
    endcase
endmodule
SV
  "rtl/core/counter.sv" => <<'SV',
`include "widths.svh"
module counter (input logic clk, rst_n, en, output logic [`DATA_W-1:0] count);
  import chip_pkg::*;
  // import debug_pkg::*;   removed with the debug hooks
  always_ff @(posedge clk or negedge rst_n)
    if (!rst_n)                       count <= '0;
    else if (en && count < COUNT_MAX) count <= count + 1'b1;
endmodule
SV
  "tb/tb_top.sv" => <<'SV',
`include "widths.svh"
module tb_top;
  logic clk = 0, rst_n = 0, en = 1;
  logic [`DATA_W-1:0] count, y;
  counter u_cnt (.clk(clk), .rst_n(rst_n), .en(en), .count(count));
  alu     u_alu (.op(2'd0), .a(8'd40), .b(8'd2), .y(y));
`ifdef ASSERT_ON
  count_checker u_chk (.clk(clk), .count(count));
`endif
  always #5 clk = ~clk;
  initial begin
    #12 rst_n = 1;
    repeat (20) @(posedge clk);
    #1;
    if (count == 12 && y == 42) $display("count=%0d y=%0d PASSED", count, y);
    else                        $display("count=%0d y=%0d FAILED", count, y);
    $finish;
  end
endmodule
SV
  "assert/count_checker.sv" => <<'SV',
`include "widths.svh"
module count_checker (input logic clk, input logic [`DATA_W-1:0] count);
  import chip_pkg::*;
  always @(posedge clk)
    if (count > COUNT_MAX) $display("CHECKER: count %0d above COUNT_MAX", count);
  initial $display("CHECKER: armed, limit %0d", COUNT_MAX);
endmodule
SV
  # --- what a real tree also contains, none of which belongs in a filelist
  "rtl/generated/regs_gen.sv"   => "module regs_gen; endmodule  // regenerated nightly\n",
  "rtl/core/counter.sv.bak"     => "module counter_old; endmodule\n",
  "rtl/core/.#alu.sv"           => "module stale; endmodule  // editor lock file\n",
  "third_party/vip/vip_pkg.sv"  => "package vip_pkg; endpackage\n",
  "filelist.cfg" => <<'CFG',
# One section per configuration. "src" may repeat; "inherit" copies a section.
skip = generated third_party backup .git

[rtl]
src    = rtl
src    = tb
define = SIM=1

[rtl_assert]
inherit = rtl
src     = assert
define  = ASSERT_ON=1
CFG
);

for my $rel (sort keys %file) {
    my $path = "$dir/$rel";
    make_path(dirname($path));
    open my $fh, ">", $path or die "make_tree.pl: $path: $!\n";
    print {$fh} $file{$rel};
    close $fh or die "make_tree.pl: $path: $!\n";
}

#!/usr/bin/perl
# gen_filelist.pl -- discover, filter, order and validate a simulation filelist.
use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use File::Find qw(find);
use File::Path qw(make_path);
use File::Basename qw(dirname basename);
use Cwd qw(abs_path);

use constant { OK => 0, MISSING => 1, EMPTY => 2, USAGE => 3 };

my $USAGE = <<'END';
usage: gen_filelist.pl --root DIR --config NAME --out FILE [--root-var VAR] [--cfg FILE]

  --root DIR      project root; every path in the config is relative to it
  --config NAME   which [section] of the config file to generate
  --out FILE      filelist to write (replaced atomically, removed on failure)
  --root-var VAR  write paths as ${VAR}/rel/path instead of absolute paths
  --cfg FILE      config file inside the root (default: filelist.cfg)

exit status:
  0  filelist written
  1  missing or ambiguous sources: an import nobody defines, an include
     that is not found or found twice, a module defined twice, a cycle,
     or a configured source directory that does not exist
  2  empty result: the configuration selected no source files
  3  usage or configuration error
END

my %opt = (cfg => "filelist.cfg");
GetOptions(\%opt, "root=s", "config=s", "out=s", "root-var=s", "cfg=s", "help")
    or fail(USAGE, "bad option (see --help)");
if ($opt{help}) { print $USAGE; exit OK }
for my $need (qw(root config out)) {
    fail(USAGE, "--$need is required (see --help)") unless defined $opt{$need};
}
fail(USAGE, "--root $opt{root} is not a directory") unless -d $opt{root};
my $root = abs_path($opt{root});

# ---- 1. the configuration: which directories, which defines
my ($skip, $cfg) = read_config("$root/$opt{cfg}", $opt{cfg});
my $c = $cfg->{ $opt{config} }
    or fail(USAGE, "no configuration '$opt{config}' in $opt{cfg}; have: "
                   . join(", ", sort keys %$cfg));
my %skip = map { $_ => 1 } @$skip;

# ---- 2. discover sources under each src directory, and every header anywhere
my (%seen, @sources, %header_dirs, @problems);
for my $src (@{ $c->{src} }) {
    unless (-d "$root/$src") { push @problems, "MISSING DIRECTORY: $src"; next }
    for my $rel (walk($src, qr/\.s?v\z/)) {
        push @sources, $rel unless $seen{$rel}++;
    }
}
for my $rel (walk(".", qr/\.(?:svh|vh)\z/)) {
    $header_dirs{ basename($rel) }{ dirname($rel) } = 1;
}
@sources = sort @sources;
if (!@sources && !@problems) {
    fail(EMPTY, "configuration '$opt{config}' selected no source files");
}

# ---- 3. read what each file defines, imports, includes and declares
my (%defines, %needs, %includes, %module_in);
for my $f (@sources) {
    my $text = slurp("$root/$f");
    $text =~ s{/\*.*?\*/}{ }gs;          # block comments
    $text =~ s{//[^\n]*}{}g;             # line comments
    $defines{$f}{$_}  = 1 for $text =~ /^\s*(?:package|interface)\s+(\w+)/mg;
    $needs{$f}{$_}    = 1 for $text =~ /\bimport\s+(\w+)\s*::/g;
    $includes{$f}{$_} = 1 for $text =~ /^\s*`include\s+"([^"]+)"/mg;
    push @{ $module_in{$_} }, $f for $text =~ /^\s*module\s+(\w+)/mg;
}

# ---- 4. resolve every name to exactly one file, every include to one dir
my %provider;
for my $f (@sources) {
    for my $name (sort keys %{ $defines{$f} || {} }) {
        if (my $other = $provider{$name}) {
            push @problems, "DEFINED TWICE: $name in $other and $f";
        }
        $provider{$name} //= $f;
    }
}
for my $f (@sources) {
    for my $name (sort keys %{ $needs{$f} || {} }) {
        push @problems, "UNRESOLVED IMPORT: $f imports $name, which no source defines"
            unless $provider{$name};
    }
}
my %incdir;
for my $f (@sources) {
    for my $h (sort keys %{ $includes{$f} || {} }) {
        my @dirs = sort keys %{ $header_dirs{$h} || {} };
        if    (@dirs == 0) { push @problems, "MISSING HEADER: $f includes $h, found nowhere" }
        elsif (@dirs > 1)  { push @problems, "AMBIGUOUS HEADER: $h is in " . join(" and ", @dirs) }
        else               { $incdir{ $dirs[0] } = 1 }
    }
}
for my $m (sort keys %module_in) {
    my @in = @{ $module_in{$m} };
    push @problems, "MODULE DEFINED TWICE: $m in " . join(" and ", @in) if @in > 1;
}

# ---- 5. order: a file comes after everything it imports; packages lead
my (%state, @order);
my $visit;
$visit = sub {
    my ($f, @path) = @_;
    my $st = $state{$f} // "";
    return if $st eq "done";
    if ($st eq "open") {
        my @loop = (@path, $f);
        shift @loop while $loop[0] ne $f;      # keep only the cycle itself
        push @problems, "IMPORT CYCLE: " . join(" -> ", @loop);
        return;
    }
    $state{$f} = "open";
    for my $name (sort keys %{ $needs{$f} || {} }) {
        my $dep = $provider{$name};
        $visit->($dep, @path, $f) if defined $dep && $dep ne $f;
    }
    $state{$f} = "done";
    push @order, $f;
};
$visit->($_) for @sources;
my @ordered = ((grep {  %{ $defines{$_} || {} } } @order),
               (grep { !%{ $defines{$_} || {} } } @order));

# ---- 6. refuse rather than write a list that is wrong
my %said;
@problems = grep { !$said{$_}++ } @problems;  # one line per distinct problem
if (@problems) {
    print STDERR "gen_filelist.pl: $_\n" for @problems;
    fail(MISSING, scalar(@problems) . " problem(s); $opt{out} not written");
}
for my $f (@ordered) {
    fail(MISSING, "not readable: $f") unless -f "$root/$f" && -r _;
}

# ---- 7. write it atomically: a reader sees the old file or the new one
my $prefix = defined $opt{"root-var"} ? "\${$opt{'root-var'}}" : $root;
my @lines = ("// generated by gen_filelist.pl --config $opt{config}; do not edit",
             (map { "+define+$_" } @{ $c->{define} }),
             (map { "+incdir+$prefix/$_" } sort keys %incdir),
             (map { "$prefix/$_" } @ordered));
make_path(dirname($opt{out}));
my $tmp = "$opt{out}.tmp.$$";
open my $fh, ">", $tmp or fail(USAGE, "cannot write $tmp: $!");
print {$fh} "$_\n" for @lines;
close $fh or fail(USAGE, "cannot write $tmp: $!");
rename $tmp, $opt{out} or fail(USAGE, "cannot rename $tmp to $opt{out}: $!");
printf "wrote %s: %d source(s), %d include dir(s), %d define(s)\n",
    $opt{out}, scalar @ordered, scalar(keys %incdir), scalar @{ $c->{define} };
exit OK;

# ---------------------------------------------------------------- helpers
# Every failure ends here, and every failure removes --out: after a run that
# did not succeed there is no filelist for the next stage to pick up.
sub fail {
    my ($code, $msg) = @_;
    unlink $opt{out} if defined $opt{out};
    print STDERR "gen_filelist.pl: $msg\n";
    exit $code;
}

sub slurp {
    my ($path) = @_;
    open my $fh, "<", $path or fail(MISSING, "cannot read $path: $!");
    local $/;
    return scalar <$fh>;
}

# Every file under $start (relative to the root) whose name matches $want,
# pruning skipped and hidden directories and ignoring hidden files.
sub walk {
    my ($start, $want) = @_;
    my @found;
    find({ no_chdir => 1, wanted => sub {
        my $name = basename($File::Find::name);
        if (-d $File::Find::name) {
            $File::Find::prune = 1
                if $File::Find::name ne "$root/$start" && ($skip{$name} || $name =~ /^\./);
            return;
        }
        return if $name =~ /^\./ || $name !~ $want;
        (my $rel = $File::Find::name) =~ s{^\Q$root\E/(?:\./)?}{};
        push @found, $rel;
    } }, "$root/$start");
    return sort @found;
}

sub read_config {
    my ($path, $shown) = @_;
    open my $fh, "<", $path or fail(USAGE, "cannot read config $shown: $!");
    my (@skip, %sec, $cur);
    while (my $line = <$fh>) {
        $line =~ s/#.*//;
        next unless $line =~ /\S/;
        if ($line =~ /^\s*\[(\w+)\]\s*$/) { $cur = $sec{$1} = { src => [], define => [] }; next }
        my ($k, $v) = $line =~ /^\s*(\w+)\s*=\s*(.*?)\s*$/
            or fail(USAGE, "$shown line $.: cannot read: $line");
        if (!$cur) {
            fail(USAGE, "$shown line $.: only 'skip' may appear before a section") unless $k eq "skip";
            push @skip, split ' ', $v;
        }
        elsif ($k eq "src" || $k eq "define") { push @{ $cur->{$k} }, $v }
        elsif ($k eq "inherit")               { $cur->{inherit} = $v }
        else  { fail(USAGE, "$shown line $.: unknown key '$k'") }
    }
    close $fh;
    my %done;
    my $resolve;
    $resolve = sub {
        my ($name, @path) = @_;
        return $done{$name} if $done{$name};
        fail(USAGE, "inherit cycle: " . join(" -> ", @path, $name)) if grep { $_ eq $name } @path;
        my $s = $sec{$name} or fail(USAGE, "section '$path[-1]' inherits unknown '$name'");
        my %r = (src => [], define => []);
        if (my $p = $s->{inherit}) {
            my $base = $resolve->($p, @path, $name);
            %r = (src => [ @{ $base->{src} } ], define => [ @{ $base->{define} } ]);
        }
        push @{ $r{src} },    @{ $s->{src} };
        push @{ $r{define} }, @{ $s->{define} };
        return $done{$name} = \%r;
    };
    $resolve->($_) for sort keys %sec;
    return (\@skip, \%done);
}

    $text =~ s{/\*.*?\*/}{ }gs;          # block comments
    $text =~ s{//[^\n]*}{}g;             # line comments
    $defines{$f}{$_}  = 1 for $text =~ /^\s*(?:package|interface)\s+(\w+)/mg;
    $needs{$f}{$_}    = 1 for $text =~ /\bimport\s+(\w+)\s*::/g;

my @ordered = ((grep {  %{ $defines{$_} || {} } } @order),
               (grep { !%{ $defines{$_} || {} } } @order));

sub fail {
    my ($code, $msg) = @_;
    unlink $opt{out} if defined $opt{out};
    print STDERR "gen_filelist.pl: $msg\n";
    exit $code;
}

#!/bin/bash
# demo.sh -- build the sample tree, generate the rtl filelist, then hand it
# to a real compiler and run the testbench it describes.
perl make_tree.pl proj || exit 1
cd proj
echo "the tree (12 files):"
find . -type f | sort | sed 's/^/  /'
echo
perl ../gen_filelist.pl --root . --config rtl --out build/rtl.f --root-var PROJ
echo "exit $?"
echo
cat build/rtl.f
echo
export PROJ=$PWD
iverilog -g2012 -o sim.vvp -c build/rtl.f
echo "iverilog exit $?"
vvp -n sim.vvp > sim.log
grep -v '\$finish called' sim.log

the tree (12 files):
  ./assert/count_checker.sv
  ./filelist.cfg
  ./rtl/core/.#alu.sv
  ./rtl/core/alu.sv
  ./rtl/core/chip_pkg.sv
  ./rtl/core/counter.sv
  ./rtl/core/counter.sv.bak
  ./rtl/core/types_pkg.sv
  ./rtl/generated/regs_gen.sv
  ./rtl/include/widths.svh
  ./tb/tb_top.sv
  ./third_party/vip/vip_pkg.sv

wrote build/rtl.f: 5 source(s), 1 include dir(s), 1 define(s)
exit 0

// generated by gen_filelist.pl --config rtl; do not edit
+define+SIM=1
+incdir+${PROJ}/rtl/include
${PROJ}/rtl/core/chip_pkg.sv
${PROJ}/rtl/core/types_pkg.sv
${PROJ}/rtl/core/alu.sv
${PROJ}/rtl/core/counter.sv
${PROJ}/tb/tb_top.sv

iverilog exit 0
count=12 y=42 PASSED

#!/bin/bash
# failures.sh -- one fresh tree per case, one deliberate defect per tree.
tool=$PWD/gen_filelist.pl
base=$(mktemp -d)
trap 'rm -rf "$base"' EXIT
err=$base/err.txt
n=0
try() {   # LABEL CONFIG DAMAGE-COMMAND
    local label=$1 config=$2 damage=$3
    n=$((n + 1))
    t=$base/$n/proj
    perl make_tree.pl "$t" > /dev/null
    eval "$damage"
    ( cd "$t" && perl "$tool" --root . --config "$config" \
          --out build/out.f --root-var PROJ > /dev/null 2> "$err" )
    local rc=$?
    printf '== %s  (--config %s)\n   exit %d, filelist written: %s\n' \
        "$label" "$config" "$rc" "$([ -e "$t/build/out.f" ] && echo yes || echo no)"
    sed 's/^/   /' "$err"
}

try "the untouched tree"            rtl ':'
try "a package file deleted"        rtl 'rm "$t/rtl/core/types_pkg.sv"'
try "the include header deleted"    rtl 'rm "$t/rtl/include/widths.svh"'
try "a second widths.svh added"     rtl 'mkdir "$t/rtl/common"; cp "$t/rtl/include/widths.svh" "$t/rtl/common/"'
try "a copy of a module kept"       rtl 'cp "$t/rtl/core/counter.sv" "$t/rtl/core/counter_old.sv"'
try "two packages import each other" rtl \
    'printf "package chip_pkg;\n  import types_pkg::*;\nendpackage\n" > "$t/rtl/core/chip_pkg.sv"'
try "a configured directory missing" rtl_assert 'rm -r "$t/assert"'
try "a config with no sources in it" docs \
    'mkdir "$t/docs"; echo "notes" > "$t/docs/README"; printf "[docs]\nsrc = docs\n" >> "$t/filelist.cfg"'
try "a configuration that does not exist" gate ':'
try "a typo in the config file"     rtl 'sed -i.orig "s/^define/defines/" "$t/filelist.cfg"'

== the untouched tree  (--config rtl)
   exit 0, filelist written: yes
== a package file deleted  (--config rtl)
   exit 1, filelist written: no
   gen_filelist.pl: UNRESOLVED IMPORT: rtl/core/alu.sv imports types_pkg, which no source defines
   gen_filelist.pl: 1 problem(s); build/out.f not written
== the include header deleted  (--config rtl)
   exit 1, filelist written: no
   gen_filelist.pl: MISSING HEADER: rtl/core/alu.sv includes widths.svh, found nowhere
   gen_filelist.pl: MISSING HEADER: rtl/core/counter.sv includes widths.svh, found nowhere
   gen_filelist.pl: MISSING HEADER: tb/tb_top.sv includes widths.svh, found nowhere
   gen_filelist.pl: 3 problem(s); build/out.f not written
== a second widths.svh added  (--config rtl)
   exit 1, filelist written: no
   gen_filelist.pl: AMBIGUOUS HEADER: widths.svh is in rtl/common and rtl/include
   gen_filelist.pl: 1 problem(s); build/out.f not written
== a copy of a module kept  (--config rtl)
   exit 1, filelist written: no
   gen_filelist.pl: MODULE DEFINED TWICE: counter in rtl/core/counter.sv and rtl/core/counter_old.sv
   gen_filelist.pl: 1 problem(s); build/out.f not written
== two packages import each other  (--config rtl)
   exit 1, filelist written: no
   gen_filelist.pl: IMPORT CYCLE: rtl/core/types_pkg.sv -> rtl/core/chip_pkg.sv -> rtl/core/types_pkg.sv
   gen_filelist.pl: 1 problem(s); build/out.f not written
== a configured directory missing  (--config rtl_assert)
   exit 1, filelist written: no
   gen_filelist.pl: MISSING DIRECTORY: assert
   gen_filelist.pl: 1 problem(s); build/out.f not written
== a config with no sources in it  (--config docs)
   exit 2, filelist written: no
   gen_filelist.pl: configuration 'docs' selected no source files
== a configuration that does not exist  (--config gate)
   exit 3, filelist written: no
   gen_filelist.pl: no configuration 'gate' in filelist.cfg; have: rtl, rtl_assert
== a typo in the config file  (--config rtl)
   exit 3, filelist written: no
   gen_filelist.pl: filelist.cfg line 7: unknown key 'defines'

#!/bin/bash
# stale.sh -- what happens to the NEXT stage when generation is refused.
# The flow below is the common two-line wrapper that never checks $?.
run_flow() {
    perl "$1" --root . --config rtl --out build/rtl.f --root-var PROJ > /dev/null 2>&1
    echo "   generator exit $?"
    if iverilog -g2012 -o sim.vvp -c build/rtl.f > cc.log 2>&1; then
        echo "   compile: ok -- $(vvp -n sim.vvp | grep -E 'PASSED|FAILED')"
    else
        echo "   compile: FAILED -- $(head -1 cc.log)"
    fi
}
here=$PWD
perl -pe 's/^\s*unlink \$opt\{out\} if defined.*//' gen_filelist.pl > no_unlink.pl
for tool in gen_filelist.pl no_unlink.pl; do
    work=$(mktemp -d)
    perl make_tree.pl "$work/proj"
    cd "$work/proj"
    export PROJ=$PWD
    echo "== $tool"
    echo " day 1, clean tree:"
    run_flow "$here/$tool"
    # day 2: someone adds a 16-bit copy of the header next to the original
    mkdir rtl/common
    sed 's/DATA_W 8/DATA_W 16/' rtl/include/widths.svh > rtl/common/widths.svh
    echo " day 2, a second widths.svh with DATA_W 16:"
    run_flow "$here/$tool"
    cd "$here"
    rm -rf "$work"
done
rm -f no_unlink.pl

== gen_filelist.pl
 day 1, clean tree:
   generator exit 0
   compile: ok -- count=12 y=42 PASSED
 day 2, a second widths.svh with DATA_W 16:
   generator exit 1
   compile: FAILED -- iverilog: cannot open command file build/rtl.f for reading.
== no_unlink.pl
 day 1, clean tree:
   generator exit 0
   compile: ok -- count=12 y=42 PASSED
 day 2, a second widths.svh with DATA_W 16:
   generator exit 1
   compile: ok -- count=12 y=42 PASSED

#!/usr/bin/perl
# t/gen_filelist.t -- black-box tests: build a fresh sample tree, run the
# tool the way a flow would, and check the exit status and the file.
use strict;
use warnings;
use Test::More;
use File::Temp qw(tempdir);
use FindBin qw($Bin);

my $TOOL = "$Bin/../gen_filelist.pl";
my $MAKE = "$Bin/../make_tree.pl";

sub fresh_tree {
    my $dir = tempdir(CLEANUP => 1);
    system($^X, $MAKE, "$dir/proj") == 0 or die "make_tree.pl failed\n";
    return "$dir/proj";
}

sub slurp { open my $fh, "<", $_[0] or return ""; local $/; return scalar <$fh> }

# Run the tool; return (exit status, STDERR text, filelist lines or undef).
sub run_tool {
    my ($root, $config) = @_;
    my $err = "$root/stderr.txt";
    my $pid = fork // die "fork: $!";
    if ($pid == 0) {                       # child: quiet STDOUT, keep STDERR
        open STDOUT, ">", "/dev/null" or die;
        open STDERR, ">", $err        or die;
        exec $^X, $TOOL, "--root", $root, "--config", $config,
                  "--out", "$root/build/out.f", "--root-var", "PROJ";
        die "exec: $!";
    }
    waitpid $pid, 0;
    my $status = $? >> 8;
    my $out = "$root/build/out.f";
    my @lines = -e $out ? split /\n/, slurp($out) : ();
    return ($status, slurp($err), (-e $out ? \@lines : undef));
}

sub sources { return map { s{^\$\{PROJ\}/}{}r } grep { m{^\$\{PROJ\}/} } @{ $_[0] } }

# ---- the sample tree, as delivered
my $root = fresh_tree();
my ($rc, $err, $list) = run_tool($root, "rtl");
is($rc, 0, "rtl: exit 0 on the sample tree");
ok($list, "rtl: the filelist was written");
my @src = sources($list);
is(scalar @src, 5, "rtl: exactly the five real sources");
ok(!(grep { m{generated/|third_party/|\.bak\z|/\.} } @src),
   "rtl: nothing generated, third-party, backup or hidden");
is_deeply([ grep { /^\+incdir\+/ } @$list ], ['+incdir+${PROJ}/rtl/include'],
   "rtl: one include directory, the one that holds widths.svh");

# every import must be satisfied by a file listed EARLIER -- checked by
# reading the listed files again here, not by trusting the tool's tables
my %pos;
@pos{@src} = (0 .. $#src);
my (%provides, @late);
for my $f (@src) {
    my $text = slurp("$root/$f");
    $provides{$_} = $f for $text =~ /^\s*package\s+(\w+)/mg;
}
for my $f (@src) {
    (my $code = slurp("$root/$f")) =~ s{//[^\n]*}{}g;   # a commented import is not one
    for my $pkg ($code =~ /\bimport\s+(\w+)::/g) {
        push @late, "$f needs $pkg" if $pos{ $provides{$pkg} } > $pos{$f};
    }
}
is_deeply(\@late, [], "rtl: every package is listed before the files that import it");

my ($rc2, undef, $again) = run_tool($root, "rtl");
is_deeply($again, $list, "rtl: a second run writes the identical file");

# ---- the second configuration builds on the first
my (undef, undef, $assert) = run_tool($root, "rtl_assert");
my @asrc = sources($assert);
is(scalar @asrc, 6, "rtl_assert: the five sources plus the checker");
is_deeply([ grep { /^\+define\+/ } @$assert ], ["+define+SIM=1", "+define+ASSERT_ON=1"],
   "rtl_assert: the inherited define, then its own");

# ---- order must come from the imports, not from the file names
$root = fresh_tree();
rename "$root/rtl/core/chip_pkg.sv", "$root/rtl/core/zz_chip_pkg.sv" or die;
($rc, $err, $list) = run_tool($root, "rtl");
my @renamed = sources($list);
my ($zz)  = grep { $renamed[$_] =~ /zz_chip_pkg/ } 0 .. $#renamed;
my ($typ) = grep { $renamed[$_] =~ /types_pkg/ }   0 .. $#renamed;
ok($rc == 0 && $zz < $typ, "renaming chip_pkg.sv to sort last does not change its place");

# ---- every refusal: the right status, a message that names the cause,
# ---- and no filelist left behind for the next stage to pick up
$root = fresh_tree();
run_tool($root, "rtl");                          # leave a good list in place
unlink "$root/rtl/core/types_pkg.sv" or die;
($rc, $err, $list) = run_tool($root, "rtl");
is($rc, 1, "missing package: exit 1");
like($err, qr/UNRESOLVED IMPORT: .*types_pkg/, "missing package: the message names it");
ok(!defined $list, "missing package: the earlier filelist was removed");

# a file with TWO imports, the missing one first: both must be checked
$root = fresh_tree();
my $cnt = slurp("$root/rtl/core/counter.sv");
$cnt =~ s/^(\s*)import chip_pkg/$1import gone_pkg::*;\n$1import chip_pkg/m or die;
open my $w, ">", "$root/rtl/core/counter.sv" or die;
print {$w} $cnt;
close $w;
($rc, $err) = run_tool($root, "rtl");
is($rc, 1, "two imports in one file: the missing first one is still found");
like($err, qr/gone_pkg/, "two imports in one file: the message names it");

$root = fresh_tree();
mkdir "$root/docs" or die;
open my $cfg, ">>", "$root/filelist.cfg" or die;
print {$cfg} "[docs]\nsrc = docs\n";
close $cfg;
($rc) = run_tool($root, "docs");
is($rc, 2, "a configuration with no sources: exit 2");

($rc, $err) = run_tool($root, "gate");
is($rc, 3, "an unknown configuration: exit 3");
like($err, qr/have: .*rtl/, "an unknown configuration: the message lists the real ones");

# ---- the strongest check: the list builds a design that works
SKIP: {
    skip "iverilog is not installed", 1 unless grep { -x "$_/iverilog" } split /:/, $ENV{PATH};
    $root = fresh_tree();
    run_tool($root, "rtl");
    local $ENV{PROJ} = $root;
    my $sim = `iverilog -g2012 -o $root/sim.vvp -c $root/build/out.f 2>&1 && vvp -n $root/sim.vvp`;
    like($sim, qr/count=12 y=42 PASSED/, "the generated list compiles and the testbench passes");
}

done_testing();

#!/bin/bash
# tests.sh -- run the suite through prove, keeping prove's own exit status.
prove -v t/ > prove.log 2>&1
status=$?
grep -v 'wallclock' prove.log
echo "prove exit $status"

t/gen_filelist.t .. 
ok 1 - rtl: exit 0 on the sample tree
ok 2 - rtl: the filelist was written
ok 3 - rtl: exactly the five real sources
ok 4 - rtl: nothing generated, third-party, backup or hidden
ok 5 - rtl: one include directory, the one that holds widths.svh
ok 6 - rtl: every package is listed before the files that import it
ok 7 - rtl: a second run writes the identical file
ok 8 - rtl_assert: the five sources plus the checker
ok 9 - rtl_assert: the inherited define, then its own
ok 10 - renaming chip_pkg.sv to sort last does not change its place
ok 11 - missing package: exit 1
ok 12 - missing package: the message names it
ok 13 - missing package: the earlier filelist was removed
ok 14 - two imports in one file: the missing first one is still found
ok 15 - two imports in one file: the message names it
ok 16 - a configuration with no sources: exit 2
ok 17 - an unknown configuration: exit 3
ok 18 - an unknown configuration: the message lists the real ones
ok 19 - the generated list compiles and the testbench passes
1..19
ok
All tests successful.
Result: PASS
prove exit 0

#!/bin/bash
# mutate.sh -- plant one defect at a time in a COPY of the tool and ask
# whether the test suite notices. A suite that never fails proves nothing.
mutant() {   # LABEL PERL-SUBSTITUTION
    local label=$1 edit=$2 d
    d=$(mktemp -d)
    mkdir "$d/t"
    cp make_tree.pl t/gen_filelist.t "$d/" && mv "$d/gen_filelist.t" "$d/t/"
    perl -pe "$edit" gen_filelist.pl > "$d/gen_filelist.pl"
    if cmp -s gen_filelist.pl "$d/gen_filelist.pl"; then
        printf '%-46s NOT PLANTED (edit matched nothing)\n' "$label"
    elif ! perl -c "$d/gen_filelist.pl" > /dev/null 2>&1; then
        printf '%-46s INVALID (the mutant does not compile)\n' "$label"
    else
        prove "$d/t" > "$d/log" 2>&1
        local rc=$?
        local failed=$(grep -c '^not ok' <(perl "$d/t/gen_filelist.t" 2>/dev/null))
        printf '%-46s %s (%s failing test(s))\n' "$label" \
            "$([ $rc -ne 0 ] && echo CAUGHT || echo SURVIVED)" "$failed"
    fi
    rm -rf "$d"
}
mutant "1 do not prune skipped directories"  's/\$skip\{\$name\} \|\| //'
mutant "2 alphabetical order, not imports"   's/^my \@ordered = \(/my \@ordered = (sort \@sources); my \@unused = (/'
mutant "3 leave a stale list on failure"     's/^\s*unlink \$opt\{out\} if defined.*//'
mutant "4 report missing sources as success" 's/MISSING => 1/MISSING => 0/'
mutant "5 ignore // comments"                's{^\s*\$text =~ s\{//.*}{}'
mutant "6 forget the inherited defines"      's/\@\{ \$base->\{define\} \}/()/'
mutant "7 \$1 instead of \$_ in the import loop"  's/\$needs\{\$f\}\{\$_\}/\$needs{\$f}{\$1}/'

1 do not prune skipped directories             CAUGHT (3 failing test(s))
2 alphabetical order, not imports              CAUGHT (3 failing test(s))
3 leave a stale list on failure                CAUGHT (1 failing test(s))
4 report missing sources as success            CAUGHT (2 failing test(s))
5 ignore // comments                           CAUGHT (9 failing test(s))
6 forget the inherited defines                 CAUGHT (1 failing test(s))
7 $1 instead of $_ in the import loop          CAUGHT (2 failing test(s))

#!/bin/bash
# probe.sh -- the same loop, written with $1 and with $_.
perl -e '
    use strict; use warnings;
    my $text = "import a::*;\nimport b::*;\nimport c::*;\n";
    my (%with_1, %with_it);
    $with_1{$1}  = 1 for $text =~ /import\s+(\w+)::/g;
    $with_it{$_} = 1 for $text =~ /import\s+(\w+)::/g;
    print "with \$1: ", join(",", sort keys %with_1),  "\n";
    print "with \$_: ", join(",", sort keys %with_it), "\n";
'
echo "exit $?"

with $1: c
with $_: a,b,c
exit 0