Un fichier en ada permettant la gestion de listes génériques
generic maxl : integer; type t_element is private; with function cmp(e1 : t_element; e2 : t_element) return boolean; package gestion_liste is type vecteur is array(1..maxl) of t_element; type t_liste is record table : vecteur; fin : integer; max : integer; end record; E_PLEINE : exception; E_VIDE : exception; procedure init(liste : in out t_liste); function identique (liste1 : t_liste; liste2 : t_liste)return boolean; function vide(liste : t_liste)return boolean; function pleine(liste : t_liste)return boolean; procedure ajouter(liste : in out t_liste; valeur : in t_element); procedure supprimer(liste : in out t_liste); function chercher(liste : t_liste; valeur : t_element)return boolean; end gestion_liste;
with gnat.Io; use gnat.Io; with gestion_liste; package body gestion_liste is procedure init(liste : in out t_liste) is -- preconditions : { - } -- postconditions : {la liste est initialisée} begin liste.fin := 0; liste.max := maxl; end; function identique(liste1 : t_liste; liste2 : t_liste) return boolean is -- preconditions : { - } -- postconditions : {renvoie vrai si les listes sont identiques et false sinon} i : integer := 1; pareil : boolean := true; begin if liste1.fin = liste2.fin then while i <= liste1.fin and pareil loop pareil := cmp(liste1.table(i), liste2.table(i)); i := i + 1; end loop; return pareil; else return false; end if; end; function vide(liste : t_liste)return boolean is -- preconditions : { - } -- postconditions : {renvoie vrai si la liste est vide et false sinon} begin if liste.fin = 0 then return true; else return false; end if; end; function pleine(liste : t_liste)return boolean is -- preconditions : { - } -- postconditions : {renvoie vrai si la liste est pleine et false sinon} begin if liste.fin = liste.max then return true; else return false; end if; end; procedure ajouter(liste : in out t_liste; valeur : in t_element) is begin if pleine(liste) then raise E_PLEINE; -- On retourne une exception si l'utilisateur tente d'ajouter un élément à une liste pleine else liste.table(liste.fin+1):=valeur; liste.fin := liste.fin + 1; end if; end; procedure supprimer(liste : in out t_liste) is begin if vide(liste) then raise E_VIDE; -- On retourne une exception si l'utilisateur tente de supprimer un élément à une liste vide else liste.fin := liste.fin - 1; end if; end; function chercher(liste : t_liste; valeur : t_element)return boolean is bool : boolean := false; i : integer := 1; begin for i in 1..liste.fin loop if cmp(liste.table(i), valeur) then bool := true; end if; end loop; return bool; end; end gestion_liste;
with Ada.Text_Io; use Ada.Text_Io; with Ada.Integer_text_Io; use Ada.Integer_Text_Io; with gestion_liste; procedure fichiers_td1 is package liste_entier is new gestion_liste (30,integer,"="); use liste_entier; liste1 : t_liste; liste2 : t_liste; i : integer; begin put("JEUX D'ESSAI"); new_line; -- TEST de la procedure "supprimer" -- axiomes : -- (1) supprimer(init(L))=E -- (2) supprimer(ajouter(L,e))=L --init(liste1); --new_line; -> SOULEVE L'EXCEPTION E_VIDE init(liste1); ajouter(liste1, 4); supprimer(liste1); if vide(liste1) then put("supprimer (2) : ok"); else put("supprimer (2) : ER"); end if; new_line; -- TEST de la fonction "vide" : on initialise une liste, et on vérifie si elle est bien vide init(liste1); if vide(liste1) then put("vide : ok"); else put("vide : ER"); end if; new_line; -- TEST de la fonction "pleine" : on met le maximum d'éléments dans une liste, et on vérifie si elle est bien pleine i:=0; while i<30 loop ajouter(liste1,i); i:=i+1; end loop; if pleine(liste1) then put("pleine : ok"); else put("pleine : ER"); end if; new_line; -- TEST de la fonction "identique" : on créé deux listes identique et on teste la fonction -- axiomes de la fonction "identique" : -- (1) identique (init (L1), init (L2)) = true -- (2) identique (init (l1), ajouter (l2, e)) = false -- (3) identique (ajouter (l1, e), init (L2)) = false -- (4) identique (ajouter (L1, e), ajouter(L2,e)) = true init(liste1); init(liste2); if identique(liste1, liste2) = true then put("identique (1) : ok"); else put("identique (1) : ERR"); end if; new_line; ajouter(liste1,3); if identique(liste1, liste2) = false then put("identique (2) : ok"); else put("identique (2) : ERR"); end if; new_line; init(liste1); init(liste2); ajouter(liste2,3); if identique(liste1, liste2) = false then put("identique (3) : ok"); else put("identique (3) : ERR"); end if; new_line; init(liste1); init(liste2); ajouter(liste1,3); ajouter(liste2,3); if identique(liste1, liste2) = true then put("identique (4) : ok"); else put("identique (4) : ERR"); end if; new_line; -- TEST de la fonction "chercher" : on garde la liste crée ci dessus et on cherche une valeur présente -- axiomes : -- chercher(ajouter(liste, e),e) = true init(liste1); ajouter(liste1,5); if chercher(liste1, 5) then put("chercher : ok"); else put("chercher : ERR"); end if; exception when E_PLEINE => put("Impossible : la liste est pleine !"); when E_VIDE => put("Impossible : la liste est vide !"); end fichiers_td1;