I have a problem with prosedeur supression() when inserting an etudent (more than one) and deleted by suprrision Procedure and make a search about that item I delete the program and I guess the problem is in ? prosedur supression()`. Look at it first.
I wish that clear thank u guys now
declartion to types student and moudle and note
Program liste_des_etudiants;
Type
date = Record
jour,mois,anee : Integer;
End;
ptr_etu = ^etudiant;
etudiant = Record
matricule : String;
nom,prenom,adress : String;
date_n : date;
suiv : ptr_etu;
End;
ptr_mod = ^module;
module = Record
code,libelle : String;
credit,coeff : Integer;
suiv : ptr_mod;
End;
ptr_note = ^note;
note = Record
matricule : String;
code : String;
note : Integer;
suiv : ptr_note;
End;
Var
choix : String;
liste_etudiant : ptr_etu ;
liste_note : ptr_note;
liste_module : ptr_mod;
Procedure supression etudent
Procedure supression(Var etu:ptr_etu;module:ptr_mod;note:ptr_note );
var
choix,matr,code : String;
current,prvious,Next: ptr_etu;
current_note,privous_note :ptr_note;
privous_code,current_code: ptr_mod;
begin
Repeat
Repeat
Writeln('pour supression un etudiant tapez 1');
Writeln('pour supression un note tapez 2');
Writeln('pour supression un module tapez 3');
Writeln('pour sortir tapez e ');
Readln(choix);
Until ((choix='1') Or (choix='2') Or (choix='3') Or (choix='e') Or (choix='E'));
If (choix='1') Then
Begin
// I guess the porblem is here but i don't know is it
// initcation de node
current := etu ;
Writeln('donner son matricule') ;
Readln(matr);
// traitement to the if the node we wanna delet is the
// first one
While((etu<>Nil) And(etu^.matricule=matr))Do
etu:= etu^.suiv;
While ((current<>Nil) and (current^.suiv<>nil)) Do
Begin
next:=etu^.suiv;
if (next^.matricule=matr) then
begin
current^.suiv:=next^.suiv;
end
Else
current:=current^.suiv;
end;
if (current =nil) then
writeln('l ''''etudiant n''''est pas trouvee');
Until ((choix='e') Or(choix='E'));
end;
Main
Begin
Repeat
Repeat
Writeln('tapez:');
Writeln('1):pour insertion');
Writeln('2):pour modification');
Writeln('3):pour supression');
Writeln('4):pour recherche');
Writeln('(e)pour sortir');
Readln(choix);
Until ((choix='1') Or (choix='2') Or (choix='3') Or (choix='4') Or (choix='e'));
If (choix='1') Then
insertion(liste_etudiant, liste_module,liste_note)
Else If (choix='2') Then
modification(liste_etudiant, liste_module,liste_note)
Else If (choix='3') Then
supression(liste_etudiant,liste_module,liste_note)
Else if (choix='4') Then
recherche(liste_etudiant, liste_module,liste_note)
Until ((choix='e') Or (choix='E'));
End.
Related
I am trying to make a program that allow me to read a text file and then print it in the terminal.
I just put the simplified parts below so that you see how I think it should work.
My problem is that if for example I open the file a.txt then b.txt it works.
But when I want to open a.txt again, the program stops with an error 217. Same if I want to open another file name c.txt for example. I've spent days on this problem but I do not know where it comes from. I looked on the internet and erorr 217 seems to be related to a non-existing file ? but it is not the case for me...
The error seems to occur on the 'assign' function.
To clarify :
'key' is a Char,
'map' is a two dimension dynamic array of a Record Type.
Repeat
readln(key);
name := key +'.txt';
fileLoading(name, map, maxX, maxY);
Until key = 'l';
...
procedure fileLoading (name : String; var map : PPObjet; var maxX,maxY : Integer);
var
fichier : Text;
i, j : Integer;
chaine : String;
begin
if (FileExists(name)) then
begin
assign(fichier, name);
reset(fichier);
read(fichier,maxX);
readln(fichier,maxY);
if (maxX < 1) or (maxX > MAX) or (maxY < 1) or (maxY > MAX) then
begin
writeln('Tailles invalides');
halt();
end;
allocationTab(maxX, maxY, map);
while (not eof(fichier)) do
begin
for j := 1 to maxY do
begin
readln(fichier,chaine);
for i := 1 to maxX do
begin
case chaine[i] of
'0' : begin
map[j][i].solide := false;
map[j][i].nature := 'v';
map[j][i].valeur := chaine[i];
end;
'1' : begin
map[j][i].solide := true;
map[j][i].nature := 'm';
map[j][i].valeur := chaine[i];
end;
'2'..'9' : begin
map[j][i].solide := false;
map[j][i].nature := 's';
map[j][i].valeur := chaine[i];
end;
end;
end;
end;
end;
end
else
begin
writeln('Erreur le fichier n''existe pas');
halt();
end;
close(fichier);
end;
...
This is the first time I ask a question on stack overflow and I'm not really familiar with it, so I hope my problem is clear enough, as well as my english.
Thanks in advance for all the help you may bring.
try setting
filemode:=0;
before your assign/reset
I'm kinda a Delphi-newbie and I don't get how the Sort method of a TList of Records is called in order to sort the records by ascending integer value.
I have a record like the following:
type
TMyRecord = record
str1: string;
str2: string;
intVal: integer;
end;
And a generic list of such records:
TListMyRecord = TList<TMyRecord>;
Have tried to find a code-example in the help files and found this one:
MyList.Sort(#CompareNames);
Which I can't use, since it uses classes. So I tried to write my own compare function with a little different parameters:
function CompareIntVal(i1, i2: TMyRecord): Integer;
begin
Result := i1.intVal - i2.intVal;
end;
But the compiler always throws a 'not enough parameters' - error when I call it with open.Sort(CompareIntVal);, which seems obvious; so I tried to stay closer to the help file:
function SortKB(Item1, Item2: Pointer): Integer;
begin
Result:=PMyRecord(Item1)^.intVal - PMyRecord(Item2)^.intVal;
end;
with PMyRecord as PMyRecord = ^TMyRecord;
I have tried different ways of calling a function, always getting some error...
The Sort overload you should be using is this one:
procedure Sort(const AComparer: IComparer<TMyRecord>);
Now, you can create an IComparer<TMyRecord> by calling TComparer<TMyRecord>.Construct. Like this:
var
Comparison: TComparison<TMyRecord>;
....
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal-Right.intVal;
end;
List.Sort(TComparer<TMyRecord>.Construct(Comparison));
I've written the Comparison function as an anonymous method, but you could also use a plain old style non-OOP function, or a method of an object.
One potential problem with your comparison function is that you may suffer from integer overflow. So you could instead use the default integer comparer.
Comparison :=
function(const Left, Right: TMyRecord): Integer
begin
Result := TComparer<Integer>.Default.Compare(Left.intVal, Right.intVal);
end;
It might be expensive to call TComparer<Integer>.Default repeatedly so you could store it away in a global variable:
var
IntegerComparer: IComparer<Integer>;
....
initialization
IntegerComparer := TComparer<Integer>.Default;
Another option to consider is to pass in the comparer when you create the list. If you only ever sort the list using this ordering then that's more convenient.
List := TList<TMyRecord>.Create(TComparer<TMyRecord>.Construct(Comparison));
And then you can sort the list with
List.Sort;
The concise answer:
uses
.. System.Generics.Defaults // Contains TComparer
myList.Sort(
TComparer<TMyRecord>.Construct(
function(const Left, Right: TMyRecord): Integer
begin
Result := Left.intVal - Right.intVal;
end
)
);
I want to share my solution (based on the input I have gathered here).
It's a standard setup. A filedata class that holds data of a single file in a generic TObjectList. The list has the two private attributes fCurrentSortedColumn and fCurrentSortAscending to control the sort order. The AsString-method is the path and filename combined.
function TFileList.SortByColumn(aColumn: TSortByColums): boolean;
var
Comparison: TComparison<TFileData>;
begin
result := false;
Comparison := nil;
case aColumn of
sbcUnsorted : ;
sbcPathAndName: begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcSize : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<int64>.Default.Compare(Left.Size,Right.Size);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcDate : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TDateTime>.Default.Compare(Left.Date,Right.Date);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
sbcState : begin
Comparison := function(const Left, Right: TFileData): integer
begin
Result := TComparer<TFileDataTestResults>.Default.Compare(Left.FileDataResult,Right.FileDataResult);
if Result = 0 then
Result := TComparer<string>.Default.Compare(Left.AsString,Right.AsString);
end;
end;
end;
if assigned(Comparison) then
begin
Sort(TComparer<TFileData>.Construct(Comparison));
// Control the sort order
if fCurrentSortedColumn = aColumn then
fCurrentSortAscending := not fCurrentSortAscending
else begin
fCurrentSortedColumn := aColumn;
fCurrentSortAscending := true;
end;
if not fCurrentSortAscending then
Reverse;
result := true;
end;
end;
I found a much simpler modified sort function to alphabetize a TList of records or nonstandard list of items.
Example
PList = ^TContact;
TContact = record //Record for database of user contact records
firstname1 : string[20];
lastname1 : string[20];
phonemobile : Integer; //Fields in the database for contact info
phonehome : Integer;
street1 : string;
street2 : string;
type
TListSortCompare = function (Item1,
Item2: TContact): Integer;
var
Form1: TForm1;
Contact : PList; //declare record database for contacts
arecord : TContact;
Contacts : TList; //List for the Array of Contacts
function CompareNames(i1, i2: TContact): Integer;
begin
Result := CompareText(i1.lastname1, i2.lastname1) ;
end;
and the function to call to sort your list
Contacts.Sort(#CompareNames);
I've a programming project in my college.
Using a File type for storing data is allowed, and I did exactly like this one: pascal-programming
And, here's what I achieved so far:
I tried to write the Records data into Untyped files instead and it worked
I want to override a function with dynamic parameter (e.g: I can switch which Record I want to process, in this case there's 2 different "Records").
Open(var f: File; var data)
data = represent can receive "anything". cmiiw
The reason why I did this, I don't think it's a good idea to recreate the same function over and over, e.g: when using 3 or more different "Records"
I also encountered a problem that the files can't store or backup the actual binary files to the temporary "Records" variable, it always give the 0 values.
go to my github source code
my solution here doesn't provide any generic related procedures (check the last sentences):
program test_untyped;
{ A crude database recording }
uses crt;
type
Temployee = record
name : string[20];
address : string[40];
phone : string[15];
age : byte;
salary : longint;
end;
arr_employee = array[1..100] of Temployee;
var
F : File;
c : char;
// r : Temployee;
r, realR : arr_employee;
s : string;
i, j, n : integer;
procedure fRead;
begin
seek(F, 0);
i := 0;
repeat
clrscr;
inc(i);
writeln('increment: ', i); readln;
writeln('File position : ',filepos(F));
blockRead(F, r[i], sizeOf(Temployee));
writeln('Name = ', r[i].name); { Input data }
writeln('Address = ', r[i].address);
writeln('Phone = ', r[i].phone);
writeln('Age = ', r[i].age);
writeln('Salary = ', r[i].salary);
write('Show data again (Y/N) ?');
repeat
c:=upcase(readkey); { Ask user : Input again or not }
until c in ['Y','N'];
writeln(c);
// realR[i] := r[i]; // backup, to show later
until c='N';
end; // end fRead
procedure fWrite;
begin
seek(F, filesize(F));
repeat
clrscr;
inc(i);
writeln('berapa nilai i: ', i);
writeln('File position : ',filepos(F));
write('Name = '); readln(r[i].name); { Input data }
write('Address = '); readln(r[i].address);
write('Phone = '); readln(r[i].phone);
write('Age = '); readln(r[i].age);
write('Salary = '); readln(r[i].salary);
blockWrite(F, r[i], sizeOf(Temployee)); { Write data to file }
write('Input data again (Y/N) ?');
repeat
c:=upcase(readkey); { Ask user : Input again or not }
until c in ['Y','N'];
writeln(c);
until c='N';
end;
// procedure fDelete;
// var
// nama: string;
// delElement: integer;
// tempR: Temployee;
// begin
// seek(F, 0);
// write('search your data by name: '); readln(nama);
// while not eof(F) do
// begin
// writeln('file position: ', filePos(F));
// blockRead(F, tempR, sizeOf(Temployee));
// if (nama = tempR.name) then
// begin
// delElement := filePos(F);
// end else
// begin
// // seek(F, )
// blockWrite(F, tempR, sizeOf(Temployee));
// end;
// end;
// end; // end fDelete
procedure fDisplay;
begin
writeln('nilai i saat ini: ', i); readln;
for j := 1 to i do
begin
clrscr;
writeln('Name = ', r[j].name); { Input data }
writeln('Address = ', r[j].address);
writeln('Phone = ', r[j].phone);
writeln('Age = ', r[j].age);
writeln('Salary = ', r[j].salary);
readln;
end;
end;
begin
clrscr;
// write('Input file name to record databases : '); readln(s);
s := 'coba1.dat';
assign(F,s); { Associate it }
{$I-}
reset(F, sizeOf(Temployee)); { First, open it }
{$I+}
n:=IOResult;
if n<>0 then { If it's doesn't exist then }
begin
{$I-}
rewrite(F, sizeOf(Temployee)); { Create it }
{$I+}
n:=IOResult;
if n<>0 then
begin
writeln('Error creating file !'); halt;
end;
end
else
begin { If it exists then }
n:=filesize(F); { Calculate total record }
// seek(F,n); { Move file pointer PAST the last record }
end;
fileMode := 2;
reset(F, sizeOf(Temployee));
fRead;
fWrite;
// fDelete;
fDisplay;
close(F);
end.
I'm wondering is the Pascal can be any good to use a generic programming? at least for this semester using Pascal in my college XD
Thank you and Best Regards,
EDIT:
Pascal still doesn't support Generic Programming 'till the day I posted this question. So sad, really.
You might wanna consider read this references instead.
I don't understand the main issue here, but would suggest using a typed file instead of an untyped one.
An untyped file is much harder to maintain, and provides (in my eyes) no benefits.
Consider the code:
type
Temployee = record
name : string[20];
address : string[40];
phone : string[15];
age : byte;
salary : longint;
end;
VAR
fEmployee : File Of Temployee;
Employees : ARRAY[0..100] Of Temployee;
Employee : Temployee;
PROCEDURE OpenEmployeeFile(CONST TheFileName:AnsiString);
BEGIN
AssignFile(fEmployee,TheFileName);
IF FileExistsUTF8(TheFileName) { *Converted from FileExists* }
THEN Reset(fEmployee)
ELSE Rewrite(fEmployee);
END;
PROCEDURE CloseEmployeeFile;
BEGIN
Close(fEmployee);
END;
FUNCTION ReadEmployee(Position:WORD): Temployee;
BEGIN
Seek(fEmployee,Position);
Read(fEmployee,Result);
END;
PROCEDURE WriteEmployee(CONST Employee:Temployee; Position:WORD);
BEGIN
Seek(fEmployee,Position);
Write(fEmployee,Employee);
END;
Error handling not implemented.
Code samples as a guideline, not complete.
It provides a basic skeleton for opening and closing the employee-file, as well as reading and writing at specific positions (specific records) in the file.
Open file.
Write all the records you want.
Close file.
Or.
Open file.
Read all the records you want.
Close file.
I learning to make a program that gets data from a txt file and places it in arrays.
the following are its types :
type
ekspedisi = record
nmeksp : string; // Nama Ekspedisi
jlp : string; // Jenis layanan pengiriman
biaya : integer; // Biaya pengiriman per kg
lp : integer; // per hari
end;
ekspedisiku = record
nom : array [1..100] of ekspedisi;
end;
and a simple algorithm
procedure getDaftarEkspedisi(var kirim : ekspedisiku);
var
i,j,k : integer;
eksp : text;
init : string;
garis : array [1..100] of integer;
mark : string;
jeks : integer;
count : integer;
begin
assign(eksp,'ekspedisi.txt');
reset(eksp);
i := 0;
k := 1;
j := 1;
mark := '|';
jeks := 10;
writeln('Loading ekspedisi.. ');
while(not(eof(eksp))) do
begin
readln(eksp,init);
i := i + 1;
for j := 1 to length(init) do
begin
if init[j] = mark then
begin
garis[k] := j;
k := k + 1;
end;
end;
for i := 1 to jeks do
begin
count := ((i-1)*5);
kirim.nom[i].nmeksp := copy(init,garis[1+count] + 2,garis[2+count]-garis[1+count]-2);
kirim.nom[i].jlp := copy(init,garis[2+count] + 2,garis[3+count]-garis[2+count]-2);
val(copy(init,garis[3+count] + 2,garis[4+count]-garis[3+count]-2),kirim.nom[i].biaya);
val(copy(init,garis[4+count] + 2,garis[5+count]-garis[4+count]-2),kirim.nom[i].lp);
end;
close(kirim);
writeln('loading sukses.');
end;
end;
from that code, i get the following error
<166,13>Error: Call by var for arg no.1 has to match exactly : got "ekspedisiku" expected "Text"
curiously, line 166 is only
close(kirim);
any help is appreciated.
You need to pass the file handle to close, so:
close(kirim);
should be:
close(eksp);
It also looks like you're closing the file at the wrong place in your function. It should most likely be after the while loop, so you need to change:
close(kirim);
writeln('loading sukses.');
end;
end;
to:
end;
close(kirim);
writeln('loading sukses.');
end;
Note that this mistake probably happened because your identation is messed up - if you're careful with formatting your code properly then you won't be so likely to make this kind of error.
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.
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 <wjl#icecavern.net>
--
-- 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;
From my limited quick reading up on TAP - unlikely... because most HDL designers are not that well-connected with the world of software testing (even though they've been doing unit-testing since well before it was called that :) I like to feel I am an HDL designer who is reasonably well-connected to the world of software testing, and I've never come across TAP before. I've stuck to Python's own unittest functionality (and dabbled with pytest). And my own concoction for working with VHDL and its asserts.
It looks like a fairly simple package to write though... do let us know if you decide to write one yourself!