use Text_Io;
with Ada.Unchecked_Deallocation;
procedure Liste_Tp is
package Iio is new Integer_Io(Integer);
use Iio;
type Element;
type Ptr is access Element;
type Element is
record
Suivant : Ptr := null;
Util : Integer;
end record;
subtype Liste is Ptr;
L1 : Liste := null;
P_P : Ptr;
Erreur : Boolean;
I : Integer;
procedure Liberer is
new Ada.Unchecked_Deallocation(Element,Ptr);
function Liste_Vide (
L : in Liste )
return Boolean is
begin
return L=null;
end;
procedure Afficher (
L : in Liste ) is
C : Character;
P : Ptr := L;
begin
if L= null then
Put_Line(" liste vide tete=null") ;
else
while P/=null loop
Put(P.Util);
New_Line;
P:=P.Suivant;
end loop;
end if;
Put_Line (" fin liste pour continuer frapper une touche");
Get(C);
Put_Line("************************************************************"
);
end;
procedure Ins_Tete (
L : in out Liste;
Val : in Integer ) is
P : Ptr :=
new Element; -- acquisition du nouvel element
begin
P.Util:=Val;
if L = null then -- la liste est vide
L:=P;
else
P.Suivant:=L;
L:=P;
end if;
end;
function Chercher (
L : in Liste;
Val : in Integer )
return Ptr is
-- cette fonction identifie l'adresse de l'élémént
-- dont la valeur est passée par val
P : Ptr := L;
Fin : Boolean := False;
begin
--
while not Fin and P.Util/= Val loop
if P.Suivant/=null then
P:=P.Suivant;
else
Fin:=True; -- nous sommes à la fin de la liste
end if;
end loop;
if P.Util = Val then
return P;
else
return null;
end if;
end;
procedure Inserer (
L : in out Liste;
P : in Ptr;
Val : in Integer ) is
-- insere apres l'élément pointé par P
New_P : Ptr := null;
begin
if P=null then
Ins_Tete(L,Val);
else
New_P:=new Element;
New_P.Util:=Val;
New_P.Suivant:=P.Suivant;
P.Suivant:=New_P;
--
end if;
end;
procedure Ret_Tete (
L : in out Liste;
Val : out Integer;
Err : out Boolean ) is
P : Ptr := L;
begin
Err:=False;
if L = null then -- la liste est vide
Err:=True;
else -- supprimer le premier element
Val:= L.Util;
-- L.Suivant.Precedent:=null;
L:=L.Suivant;
Liberer(P);
end if;
end;
procedure Retrait (
L : in out Liste;
P1 : in Ptr;
Val : out Integer;
Err : out Boolean ) is
P : Ptr := P1;
begin
Err:=False;
if L = null or P1=null then -- la liste est vide ou P1 n'existe pas
Err:=True;
elsif
L=P then -- supprimer tete
Ret_Tete(L,Val,Err);
-- elsif L.Queue=P then -- supprimer queue
-- Ret_Queue(L,Val,Err);
else
-- rechercher élément précédent de P1
P:= L;
while P.Suivant/=null and P.Suivant/= P loop
P:=P.Suivant;
end loop;
if P.Suivant= null
then
Err:=True;
else
Val:=P1.Util; -- supprimer l element pointe par P
P.Suivant:=P1.Suivant;
Liberer(P);
end if;
end if;
end;
begin
Put_Line ( "test de liste_vide");
if Liste_Vide ( L1) then
Put_Line ("L1 est vide");
else
Put_Line ("L1 n est pas vide");
end if;
Put_Line("test de inserer en tete");
Ins_Tete(L1,-100);
Afficher(L1);
if Liste_Vide ( L1) then
Put_Line ("L1 est vide");
else
Put_Line ("L1 n est pas vide");
end if;
Ins_Tete(L1,-200);
Afficher(L1);
Ins_Tete(L1,-300);
Afficher(L1);
Put_Line("test de chercher : liste de reference");
Afficher(L1);
P_P:=Chercher(L1,-200);
Put(-200);
if P_P = null then
Put_Line ("non trouve");
else
Put(P_P.Util);
New_Line;
end if;
P_P:=Chercher(L1,-300);
Put(-300);
if P_P = null then
Put_Line ("en tete");
else
Put(P_P.Util);
New_Line;
end if;
P_P:=Chercher(L1,550);
Put(550);
if P_P = null then
Put_Line (" non trouve ");
else
Put(P_P.Util);
New_Line;
end if;
Put_Line(" test de inserer");
Inserer(L1,Chercher(L1,200),150);
Afficher(L1);
Inserer(L1,Chercher(L1,-200),150);
Afficher(L1);
Put_Line(" test de retrait du premier element ");
Ret_Tete(L1,I,Erreur);
if Erreur then
Put_Line("liste vide");
else
Put("valeur retiree: ");
Put(I);
New_Line;
Afficher(L1);
end if;
Put_Line(" test de retrait d'un element(300) ");
Retrait(L1,Chercher(L1,300),I,Erreur);
if Erreur then
Put_Line("erreur");
else
Put("valeur retiree: ");
Put(I);
New_Line;
Afficher(L1);
end if;
Put_Line(" test de retrait d'un element(-300) ");
Retrait(L1,Chercher(L1,-300),I,Erreur);
if Erreur then
Put_Line("erreur");
else
Put("valeur retiree: ");
Put(I);
New_Line;
Afficher(L1);
end if;
end;
Completer le programme de test
Bon courage