Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Ada : index check failed

When attempting to run my program, i get the error : raised CONSTRAINT_ERROR : tp3.adb:41 index check failed The line in question is : IF CaveF5.Infos(H).Nom = Nom_Bout (The cave has a problem ?) Thanks for your help ! Here is the code :

--But : Gestion d'une cave à vin

   TYPE CouleurVin IS (Rose, Rouge, Blanc);
   PACKAGE CouleurIO IS NEW Enumeration_io(CouleurVin);
   USE CouleurIO;


   TYPE Bouteille IS RECORD
      Nom : Unbounded_String;
      Couleur : CouleurVin;
      Millesime : Integer;
      Quantite : Integer;
   END RECORD;


   N: CONSTANT Integer := 1000;
   TYPE Cave IS ARRAY (1..N) OF Bouteille;


   TYPE Cave_Bis IS RECORD
      Infos : Cave;
      Nbeff : Integer;
   END RECORD;
    


   PROCEDURE Recherche_Seq(Nom_Bout: IN Unbounded_String; CaveF5: IN Cave_Bis; PRESENT: OUT BOOLEAN; ICI: OUT Integer) IS

      H: Integer;
      
   BEGIN
      PRESENT:= False;
      H :=0;
      ICI := 0;
      WHILE NOT PRESENT AND H <= CaveF5.Nbeff LOOP
         IF CaveF5.Infos(H).Nom = Nom_Bout
         Then
            PRESENT := TRUE;
            ICI := H;
         ELSE
            H := H + 1;
         END IF;
      END LOOP;
      
   END Recherche_Seq;

PROCEDURE Ajouter(BOUF4 : In Bouteille; CaveF2: IN OUT Cave_Bis) IS

      Quant_B : Integer;
      Coul_B : CouleurVin;
      Year_B : Integer;
      J : Integer := 1;
      Present : Boolean;
      Ici: Integer;

      BEGIN
      
      IF CaveF2.NBeff<N
      THEN
         Put("Combien de bouteilles en ajoutez-vous?");
         New_Line;
         Get(Quant_B);
         Put("Rentrez la couleur de votre vin: ");
         New_Line;
         Get(Coul_B);
         Put("Quel est son millésime?");
         New_Line;
         GET(Year_B);
         
         WHILE CaveF2.Infos(J).nom<BOUF4.Nom AND J <= CaveF2.Nbeff LOOP
            J:=J+1;
         END LOOP;
         CaveF2.Nbeff := CaveF2.Nbeff + 1;
         FOR L IN REVERSE J+1..CaveF2.Nbeff LOOP
            CaveF2.Infos(L) := CaveF2.Infos(L-1);
         END LOOP;
         Recherche_Seq(BOUF4.Nom,CaveF2,Present,Ici);
         IF PRESENT THEN 
            CaveF2.Infos(ICI).NOM:=BOUF4.Nom;
            CaveF2.Infos(ICI).Couleur:=Coul_B;
            CaveF2.INFOS(ICI).Millesime:=Year_B;
            CaveF2.Infos(ICI).Quantite:=Quant_B;
         END IF;
         
      Else PUT("La cave est pleine ! ");
      END IF;
   END Ajouter; ```
like image 319
Madness Nel Avatar asked Oct 19 '20 20:10

Madness Nel


Video Answer


1 Answers

Well the only Index on that line is H.

Which is initialised to 0.

And the thing it's indexing has index range 1 .. N.

So...

Nope. Not gonna work.

But at least it tells you up front instead of letting you find out the hard way.

You have a decent type system : learn to use it.
I would recommend defining a SUBTYPE of Integer, range 1 .. 1000
subtype MyIndex is Natural range 1 .. 1000;
(eliminating N because it is now redundant : use MyIndex'Last if you need it)
And naming that subtype as the index type of Cave.
And declaring H of that subtype, not Integer.

Having done that, it's a bit harder to create that bug.
Every bounds violation or buffer overflow or Heartbleed is a simple type error.

like image 101
user_1818839 Avatar answered Oct 11 '22 23:10

user_1818839