Add the basis for an automated native testsuite...
... including a set of basic tests for the VFS engine.
This commit is contained in:
Pierre-Marie de Rodat
parent
521e131c60
commit
13e17bd3d4
|
|
@ -0,0 +1,2 @@
|
|||
obj
|
||||
bin
|
||||
|
|
@ -0,0 +1,34 @@
|
|||
Ada_Drivers_Library testsuite
|
||||
=============================
|
||||
|
||||
Without nice emulator support, testing bare-board code is hard. The goal of
|
||||
this testsuite is to leverage the native support packages in this repository to
|
||||
test services and components that rely on native implementations for HAL
|
||||
interfaces.
|
||||
|
||||
|
||||
How to run the testsuite
|
||||
------------------------
|
||||
|
||||
First, make sure you have a Python 3 interpreter available, and then run:
|
||||
|
||||
./run.py
|
||||
|
||||
The standard output report should be obvious to read. In order to restrict the
|
||||
set of executed tests, run instead:
|
||||
|
||||
./run.py foo bar
|
||||
|
||||
This will execute all tests that have either ``foo`` or ``bar`` in their name
|
||||
|
||||
|
||||
How to write testcases
|
||||
----------------------
|
||||
|
||||
Every subdirectory in ``tests/`` that contains a ``tc.gpr`` file is a testcase.
|
||||
Each testcase embeds one or more test drivers (i.e. Ada programs) that run test
|
||||
code and write to their standard output to demonstrate that some feature is
|
||||
correctly implemented. For each test driver X, the project file must build an
|
||||
executable as ``bin/X`` and there must be a ``X.out`` file next to the
|
||||
``tc.gpr`` project file that states what the test driver output should be for
|
||||
the test to pass.
|
||||
|
|
@ -0,0 +1,146 @@
|
|||
#! /usr/bin/env python3
|
||||
|
||||
import argparse
|
||||
import difflib
|
||||
import os
|
||||
import os.path
|
||||
import subprocess
|
||||
|
||||
|
||||
ROOT_DIR = os.path.abspath(os.path.join(os.path.dirname(__file__), '..'))
|
||||
TESTS_DIR = os.path.join(ROOT_DIR, 'testsuite', 'tests')
|
||||
|
||||
|
||||
def run_program(*argv):
|
||||
p = subprocess.Popen(
|
||||
argv,
|
||||
stdout=subprocess.PIPE,
|
||||
stderr=subprocess.PIPE
|
||||
)
|
||||
stdout, stderr = p.communicate()
|
||||
|
||||
try:
|
||||
stdout = stdout.decode('ascii')
|
||||
except UnicodeError:
|
||||
return 'stdout is not ASCII'
|
||||
|
||||
try:
|
||||
stderr = stderr.decode('ascii')
|
||||
except UnicodeError:
|
||||
return 'stderr is not ASCII'
|
||||
|
||||
return (p.returncode, stdout, stderr)
|
||||
|
||||
|
||||
class Testcase:
|
||||
def __init__(self, dirname):
|
||||
self.name = dirname
|
||||
self.dirname = os.path.join(TESTS_DIR, dirname)
|
||||
self.project_file = os.path.join(dirname, 'tc.gpr')
|
||||
|
||||
@property
|
||||
def expected_outputs(self):
|
||||
"""
|
||||
Yield the basename for all expected output files in this testcase.
|
||||
"""
|
||||
for fn in os.listdir(self.dirname):
|
||||
if fn.endswith('.out'):
|
||||
yield fn
|
||||
|
||||
@property
|
||||
def drivers(self):
|
||||
"""
|
||||
Return a couple (program full path, expected output full path) for all
|
||||
test drivers in this testcase.
|
||||
"""
|
||||
return [(os.path.join(self.dirname, 'bin', fn[:-4]),
|
||||
os.path.join(self.dirname, fn))
|
||||
for fn in self.expected_outputs]
|
||||
|
||||
def run(self):
|
||||
"""
|
||||
Build and run the test drivers for this testcase, then check their
|
||||
output. Return a string as an error message if there is an error.
|
||||
Return None if test is successful.
|
||||
"""
|
||||
|
||||
# Build test drivers
|
||||
returncode, stdout, stderr = run_program(
|
||||
'gprbuild', '-j0', '-p', '-q', '-P', self.project_file,
|
||||
)
|
||||
if returncode:
|
||||
return 'Build error (gprbuild returned {}):\n{}'.format(
|
||||
returncode, stderr
|
||||
)
|
||||
|
||||
# Run individual testcases
|
||||
errors = []
|
||||
for program, expected_output_fn in self.drivers:
|
||||
error = self._run_single(program, expected_output_fn)
|
||||
if error:
|
||||
errors.append('{}:\n{}\n'.format(
|
||||
os.path.basename(program),
|
||||
error
|
||||
))
|
||||
|
||||
return '\n'.join(errors) if errors else None
|
||||
|
||||
def _run_single(self, program, expected_output_fn):
|
||||
"""
|
||||
Helper for run, execute a single test driver.
|
||||
"""
|
||||
# Run the program, get its output
|
||||
returncode, stdout, stderr = run_program(program)
|
||||
if returncode or stderr:
|
||||
return 'Program returned {}:\n{}'.format(returncode, stderr)
|
||||
|
||||
stdout = stdout.splitlines()
|
||||
|
||||
# Compare the actual output and the expected one
|
||||
with open(expected_output_fn, 'r') as f:
|
||||
expected_output = f.read().splitlines()
|
||||
if expected_output != stdout:
|
||||
return 'Output mismatch:\n{}'.format(''.join(
|
||||
difflib.unified_diff(
|
||||
expected_output,
|
||||
stdout,
|
||||
fromfile=expected_output_fn,
|
||||
tofile='<stdout>'
|
||||
)
|
||||
))
|
||||
|
||||
|
||||
|
||||
def find_testcases():
|
||||
"""
|
||||
Yield Testcase instances for all testcases found in TESTS_DIR.
|
||||
"""
|
||||
for dirpath, dirnames, filenames in os.walk(TESTS_DIR):
|
||||
if 'tc.gpr' in filenames:
|
||||
yield Testcase(dirpath)
|
||||
|
||||
|
||||
parser = argparse.ArgumentParser('Run the testsuite')
|
||||
|
||||
parser.add_argument(
|
||||
'pattern', nargs='*',
|
||||
help='List of pattern to filter the set of testcases to run'
|
||||
)
|
||||
|
||||
|
||||
def main(args):
|
||||
for tc in find_testcases():
|
||||
|
||||
# Don't run the testcase if we have filters and none of them matches it
|
||||
if args.pattern and not any(pat in tc.name for pat in args.pattern):
|
||||
continue
|
||||
|
||||
error = tc.run()
|
||||
if error:
|
||||
print('\x1b[31mFAIL\x1b[0m {}:\n{}'.format(tc.name, error))
|
||||
else:
|
||||
print('\x1b[32mOK\x1b[0m {}'.format(tc.name))
|
||||
|
||||
|
||||
if __name__ == '__main__':
|
||||
main(parser.parse_args())
|
||||
|
|
@ -0,0 +1 @@
|
|||
HELLO
|
||||
|
|
@ -0,0 +1 @@
|
|||
HELLO
|
||||
|
|
@ -0,0 +1 @@
|
|||
SUBFILE
|
||||
|
|
@ -0,0 +1 @@
|
|||
WORLD
|
||||
|
|
@ -0,0 +1,175 @@
|
|||
with Ada.Command_Line;
|
||||
with Ada.Directories;
|
||||
with Ada.Strings.Unbounded;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
package body Helpers is
|
||||
|
||||
Program_Abspath : constant Pathname := Native.Filesystem.Join
|
||||
(Ada.Directories.Current_Directory, Ada.Command_Line.Command_Name, False);
|
||||
Test_Dir : constant Pathname := Ada.Directories.Containing_Directory
|
||||
(Ada.Directories.Containing_Directory (Program_Abspath));
|
||||
Material_Dir : constant Pathname :=
|
||||
Ada.Directories.Compose (Test_Dir, "material");
|
||||
|
||||
----------
|
||||
-- Test --
|
||||
----------
|
||||
|
||||
procedure Test (Status : Status_Kind) is
|
||||
begin
|
||||
if Status /= Status_Ok then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
end Test;
|
||||
|
||||
------------
|
||||
-- Create --
|
||||
------------
|
||||
|
||||
function Create
|
||||
(Root_Dir : Pathname;
|
||||
Create_If_Missing : Boolean := False)
|
||||
return Native.Filesystem.Native_FS_Driver_Ref
|
||||
is
|
||||
use Native.Filesystem;
|
||||
Abs_Root_Dir : constant Pathname := Ada.Directories.Compose
|
||||
(Material_Dir, Root_Dir);
|
||||
Result : constant Native_FS_Driver_Ref := new Native_FS_Driver;
|
||||
begin
|
||||
if Create_If_Missing
|
||||
and then not Ada.Directories.Exists (Abs_Root_Dir)
|
||||
then
|
||||
Ada.Directories.Create_Directory (Abs_Root_Dir);
|
||||
end if;
|
||||
Test (Create (Result.all, Abs_Root_Dir));
|
||||
return Result;
|
||||
end Create;
|
||||
|
||||
---------------
|
||||
-- Read_File --
|
||||
---------------
|
||||
|
||||
function Read_File (File : in out File_Handle'Class) return Byte_Array is
|
||||
type Byte_Array_Access is access Byte_Array;
|
||||
procedure Destroy is new Ada.Unchecked_Deallocation
|
||||
(Byte_Array, Byte_Array_Access);
|
||||
|
||||
Buffer : Byte_Array_Access := new Byte_Array (1 .. 1024);
|
||||
Last : Natural := 0;
|
||||
begin
|
||||
loop
|
||||
-- If the buffer is full, reallocate it twice bigger
|
||||
|
||||
if Last >= Buffer'Last then
|
||||
declare
|
||||
New_Buffer : constant Byte_Array_Access :=
|
||||
new Byte_Array (1 .. 2 * Buffer'Length);
|
||||
begin
|
||||
New_Buffer (1 .. Buffer'Length) := Buffer.all;
|
||||
Destroy (Buffer);
|
||||
Buffer := New_Buffer;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- As File_Handle.Read does not tell us how many bytes it could read
|
||||
-- when it cannot fill the buffer, read byte by byte...
|
||||
|
||||
case File.Read (Buffer (Last + 1 .. Last + 1)) is
|
||||
when Status_Ok =>
|
||||
null;
|
||||
when Input_Output_Error =>
|
||||
exit;
|
||||
when others =>
|
||||
raise Program_Error;
|
||||
end case;
|
||||
Last := Last + 1;
|
||||
end loop;
|
||||
|
||||
declare
|
||||
Result : constant Byte_Array := Buffer (1 .. Last);
|
||||
begin
|
||||
Destroy (Buffer);
|
||||
return Result;
|
||||
end;
|
||||
end Read_File;
|
||||
|
||||
-----------------
|
||||
-- Quote_Bytes --
|
||||
-----------------
|
||||
|
||||
function Quote_Bytes (Bytes : Byte_Array) return String is
|
||||
use Ada.Strings.Unbounded;
|
||||
use type HAL.Byte;
|
||||
Result : Unbounded_String;
|
||||
|
||||
Hex_Digits : constant array (Byte range 0 .. 15) of Character :=
|
||||
"0123456789abcdef";
|
||||
begin
|
||||
for B of Bytes loop
|
||||
declare
|
||||
C : constant Character := Character'Val (B);
|
||||
begin
|
||||
if C = '\' then
|
||||
Append (Result, "\\");
|
||||
elsif C in ' ' .. '~' then
|
||||
Append (Result, C);
|
||||
else
|
||||
Append
|
||||
(Result, "\x" & Hex_Digits (B / 16) & Hex_Digits (B mod 16));
|
||||
end if;
|
||||
end;
|
||||
end loop;
|
||||
return To_String (Result);
|
||||
end Quote_Bytes;
|
||||
|
||||
----------
|
||||
-- Dump --
|
||||
----------
|
||||
|
||||
procedure Dump (FS : in out FS_Driver'Class; Dir : Pathname) is
|
||||
DH : Directory_Handle_Ref;
|
||||
DE : Directory_Entry;
|
||||
I : Positive := 1;
|
||||
Status : Status_Kind;
|
||||
begin
|
||||
Put_Line ("Entering " & Dir);
|
||||
Test (FS.Open_Directory (Dir, DH));
|
||||
|
||||
loop
|
||||
Status := DH.Read_Entry (I, DE);
|
||||
exit when Status = No_Such_File_Or_Directory;
|
||||
Test (Status);
|
||||
|
||||
declare
|
||||
Name : constant Pathname :=
|
||||
Native.Filesystem.Join (Dir, DH.Entry_Name (I), True);
|
||||
begin
|
||||
case DE.Entry_Type is
|
||||
when Regular_File =>
|
||||
Put_Line (" File: " & Name);
|
||||
declare
|
||||
File : File_Handle_Ref;
|
||||
begin
|
||||
Test (FS.Open (Name, Read_Only, File));
|
||||
declare
|
||||
Content : constant Byte_Array := Read_File (File.all);
|
||||
begin
|
||||
Put_Line (" Contents: " & Quote_Bytes (Content));
|
||||
end;
|
||||
Test (File.Close);
|
||||
end;
|
||||
|
||||
when Directory =>
|
||||
Dump (FS, Name);
|
||||
end case;
|
||||
end;
|
||||
|
||||
I := I + 1;
|
||||
end loop;
|
||||
|
||||
Put_Line ("Leaving " & Dir);
|
||||
Test (DH.Close);
|
||||
end Dump;
|
||||
|
||||
end Helpers;
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
with HAL; use HAL;
|
||||
with HAL.Filesystem; use HAL.Filesystem;
|
||||
with Native.Filesystem;
|
||||
with Virtual_File_System; use Virtual_File_System;
|
||||
|
||||
-- Helpers for Virtual_File_System testcases
|
||||
|
||||
package Helpers is
|
||||
|
||||
procedure Test (Status : Status_Kind);
|
||||
-- Check that status is Status_Ok
|
||||
|
||||
function Create
|
||||
(Root_Dir : Pathname;
|
||||
Create_If_Missing : Boolean := False)
|
||||
return Native.Filesystem.Native_FS_Driver_Ref;
|
||||
-- Create a native FS driver rooted at Root_Dir, in the Material_Name
|
||||
-- material directory.
|
||||
|
||||
function Read_File (File : in out File_Handle'Class) return Byte_Array;
|
||||
-- Read the whole content of File and return it. Raise a Program_Error if
|
||||
-- anything goes wrong.
|
||||
|
||||
function Quote_Bytes (Bytes : Byte_Array) return String;
|
||||
-- Return a human-readable representation of Bytes, considered as ASCII
|
||||
|
||||
procedure Dump (FS : in out FS_Driver'Class; Dir : Pathname);
|
||||
-- Dump the content of the Dir directory in FS to the standard output
|
||||
|
||||
procedure Destroy is new Ada.Unchecked_Deallocation
|
||||
(FS_Driver'Class, FS_Driver_Ref);
|
||||
procedure Destroy is new Ada.Unchecked_Deallocation
|
||||
(Virtual_File_System.VFS'Class, Virtual_File_System.VFS_Ref);
|
||||
|
||||
end Helpers;
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
with Virtual_File_System; use Virtual_File_System;
|
||||
|
||||
with Helpers; use Helpers;
|
||||
|
||||
procedure TC_Empty_VFS is
|
||||
VFS : Virtual_File_System.VFS;
|
||||
begin
|
||||
Put_Line ("Dumping the root directory of an empty VFS:");
|
||||
Dump (VFS, "/");
|
||||
Put_Line ("Done.");
|
||||
end TC_Empty_VFS;
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
with Native.Filesystem; use Native.Filesystem;
|
||||
with Virtual_File_System; use Virtual_File_System;
|
||||
|
||||
with Helpers; use Helpers;
|
||||
|
||||
procedure TC_Nested_Mount is
|
||||
Strict_Mode : constant Boolean := False;
|
||||
-- Debug switch to enable strict mode. Currently, non-strict mode avoids
|
||||
-- calls that are more or less expected to fail.
|
||||
|
||||
Root_VFS : Virtual_File_System.VFS;
|
||||
Child_VFS : Virtual_File_System.VFS_Ref := new Virtual_File_System.VFS;
|
||||
Empty_FS : Native_FS_Driver_Ref :=
|
||||
Create ("empty", Create_If_Missing => True);
|
||||
Subdirs_FS : Native_FS_Driver_Ref := Create ("subdirs");
|
||||
begin
|
||||
Test (Root_VFS.Mount ("empty", Empty_FS.all'Access));
|
||||
Test (Root_VFS.Mount ("child_vfs", Child_VFS.all'Access));
|
||||
Test (Child_VFS.Mount ("subdirs", Subdirs_FS.all'Access));
|
||||
Dump (Root_VFS, "/");
|
||||
|
||||
-- Unmounting is not implemented yet
|
||||
|
||||
if Strict_Mode then
|
||||
Test (Root_VFS.Umount ("empty"));
|
||||
Test (Root_VFS.Umount ("child_vfs"));
|
||||
Test (Child_VFS.Umount ("subdirs"));
|
||||
end if;
|
||||
|
||||
Destroy (Child_VFS);
|
||||
Destroy (Empty_FS);
|
||||
Destroy (Subdirs_FS);
|
||||
Put_Line ("Done.");
|
||||
end TC_Nested_Mount;
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
with Native.Filesystem; use Native.Filesystem;
|
||||
with Virtual_File_System; use Virtual_File_System;
|
||||
|
||||
with Helpers; use Helpers;
|
||||
|
||||
procedure TC_Simple_Mount is
|
||||
Strict_Mode : constant Boolean := False;
|
||||
-- Debug switch to enable strict mode. Currently, non-strict mode avoids
|
||||
-- calls that are more or less expected to fail.
|
||||
|
||||
VFS : Virtual_File_System.VFS;
|
||||
HFS : Native_FS_Driver_Ref := Create ("one_file");
|
||||
begin
|
||||
Put_Line ("Dumping the ""one_file"" mounted as /one_file:");
|
||||
Test (VFS.Mount ("one_file", HFS.all'Access));
|
||||
Dump (VFS, "/");
|
||||
|
||||
-- Unmounting is not implemented yet
|
||||
|
||||
if Strict_Mode then
|
||||
Test (VFS.Umount ("one_file"));
|
||||
end if;
|
||||
|
||||
Destroy (HFS);
|
||||
Put_Line ("Done.");
|
||||
end TC_Simple_Mount;
|
||||
|
|
@ -0,0 +1,18 @@
|
|||
with "../../../boards/native";
|
||||
with "../../../boards/native/config";
|
||||
|
||||
project TC is
|
||||
|
||||
for Languages use ("Ada");
|
||||
for Source_Dirs use ("src");
|
||||
for Main use
|
||||
("tc_empty_vfs.adb",
|
||||
"tc_simple_mount.adb",
|
||||
"tc_nested_mount.adb");
|
||||
for Object_Dir use "obj";
|
||||
for Exec_Dir use "bin";
|
||||
|
||||
package Compiler renames Config.Compiler;
|
||||
package Builder renames Config.Builder;
|
||||
|
||||
end TC;
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
Dumping the root directory of an empty VFS:
|
||||
Entering /
|
||||
Leaving /
|
||||
Done.
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
Entering /
|
||||
Entering /child_vfs
|
||||
Entering /child_vfs/subdirs
|
||||
File: /child_vfs/subdirs/hello.txt
|
||||
Contents: HELLO\x0a
|
||||
Entering /child_vfs/subdirs/subdir1
|
||||
Entering /child_vfs/subdirs/subdir1/subdir2
|
||||
File: /child_vfs/subdirs/subdir1/subdir2/subfile.txt
|
||||
Contents: SUBFILE\x0a
|
||||
Leaving /child_vfs/subdirs/subdir1/subdir2
|
||||
File: /child_vfs/subdirs/subdir1/world.txt
|
||||
Contents: WORLD\x0a
|
||||
Leaving /child_vfs/subdirs/subdir1
|
||||
Leaving /child_vfs/subdirs
|
||||
Leaving /child_vfs
|
||||
Entering /empty
|
||||
Leaving /empty
|
||||
Leaving /
|
||||
Done.
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
Dumping the "one_file" mounted as /one_file:
|
||||
Entering /
|
||||
Entering /one_file
|
||||
File: /one_file/hello.txt
|
||||
Contents: HELLO\x0a
|
||||
Leaving /one_file
|
||||
Leaving /
|
||||
Done.
|
||||
Loading…
Reference in New Issue