view release on metacpan or  search on metacpan

t/55-board-fixtures.t  view on Meta::CPAN

        return $fixture->('cpuinfo-tail')               if $cmd =~ m{cpuinfo \| tail};
        return $fixture->('df-out')                     if $cmd eq 'df';
        return $fixture->($cfg->{net_tool} eq 'ifconfig' ? 'ifconfig' : 'ip-addr')
            if $cmd eq $cfg->{net_tool};

        if ($cmd =~ /^(pinctrl|raspi-gpio) get (.*)$/){
            my ($base, $pins) = ($1, $2);
            my $kind = $pins eq '2,4,6,8' ? 'multi' : $pins eq '2' ? 'pin2' : 'all';
            return $fixture->("$base-$kind");
        }

        die "unmapped _run command for $board: [$cmd]";
    };

    # --- file seam -----------------------------------------------------------

    local *RPi::SysInfo::_slurp = sub {
        my ($file) = @_;
        return $fixture->('cpuinfo') if $file =~ m{/proc/cpuinfo};
        return $fixture->('model')   if $file =~ m{devicetree/base/model};
        return $fixture->('swaps')   if $file =~ m{/proc/swaps};
        return $fixture->('thermal') if $file =~ m{thermal_zone0/temp};
        die "unmapped _slurp file for $board: [$file]";
    };

    # --- pin the tool selections for this board ------------------------------

    local *RPi::SysInfo::_gpio_tool   = sub { $cfg->{gpio_tool} };
    local *RPi::SysInfo::_net_tool    = sub { $cfg->{net_tool} };
    local *RPi::SysInfo::_camera_tool = sub { $cfg->{camera_tool} };
    local *RPi::SysInfo::_config_file = sub { '/boot/firmware/config.txt' };

    # --- pi_model / board decode ---------------------------------------------

    is pi_model(), $cfg->{model}, "[$board] pi_model() = $cfg->{model}";

    my $summary = RPi::SysInfo::_board_summary();
    like $summary, qr/\Q$cfg->{soc}\E/, "[$board] board summary names the SoC ($cfg->{soc})";
    like $summary, qr/\Q$cfg->{mem}\E/, "[$board] board summary names the RAM ($cfg->{mem})";

    if ($cfg->{rp1}){
        like   $summary, qr/RP1/, "[$board] board summary flags RP1";
    }
    else {
        unlike $summary, qr/RP1/, "[$board] board summary does not flag RP1";
    }

    # --- pi_details ----------------------------------------------------------

    my $details = pi_details();
    like $details, qr/\QRaspberry Pi\E/,          "[$board] pi_details has the model name";
    like $details, qr/Throttled flag\s*:/,        "[$board] pi_details has the throttled flag";
    like $details, qr/Board\s*:\s*\Q$cfg->{model}\E/, "[$board] pi_details Board line = pi_model";
    like $details, qr/\Q$cfg->{soc}\E/,           "[$board] pi_details includes decoded SoC";
    like $details, $cfg->{camera_re},             "[$board] pi_details camera status ($cfg->{camera_re})";

    # --- raspi_config --------------------------------------------------------

    my $config = raspi_config();
    like   $config, qr/arm_freq/,            "[$board] raspi_config has vcgencmd config";
    like   $config, qr/^dt(?:param|overlay)=/m, "[$board] raspi_config appends config.txt directives";
    unlike $config, qr/^\s*#/m,              "[$board] raspi_config strips comment lines";

    # --- network_info --------------------------------------------------------

    like network_info(), qr/inet\b/, "[$board] network_info has inet data (via $cfg->{net_tool})";

    # --- file_system ---------------------------------------------------------

    my $fs = file_system();
    like $fs, qr/Filesystem .* Mounted on/, "[$board] file_system has df header";
    like $fs, qr{^\S+ \s+ \d+ \s+ \d+ \s+ \d+ \s+ \d+% \s+ /\s*$}xm, "[$board] file_system has root mount";
    like $fs, qr/Filename\s+Type\s+Size/,    "[$board] file_system has swaps header";

    # --- core_temp -----------------------------------------------------------

    like core_temp(),    qr/^\d+\.\d+$/, "[$board] core_temp Celsius";
    like core_temp('f'), qr/^\d+\.\d+$/, "[$board] core_temp Fahrenheit";
    cmp_ok core_temp('f'), '>', core_temp(), "[$board] Fahrenheit > Celsius";

    # --- gpio_info (format differs by tool) ----------------------------------

    my $multi = gpio_info([2, 4, 6, 8]);
    like $multi, $cfg->{gpio_re}, "[$board] gpio_info multi matches $cfg->{gpio_tool} format";
    is scalar(split /\n/, $multi), 4, "[$board] gpio_info multi returns four lines";

    my @single = split /\n/, gpio_info([2]);
    is scalar(@single), 1, "[$board] gpio_info single pin returns one line";
}

done_testing();