🚀 go-pugleaf

Bug when executing GCC
System:PC Cyrix P166+ under W 95
Error detected at "es_texte.adb", line 175:5
Email: ALGOHIER@msn.com or e6433@iut-orsay.fr
------------------------------------------------------------------------------
------------------------------------------------------------------------------
package ES_MOT is

  subtype T_LONGUEUR is NATURAL RANGE 1..40;

  type T_MOT (LG:T_LONGUEUR:=1) is
    record
      STR:STRING(1..LG);
    end record;
------------------------------------------------------------------------------
  procedure GET (MOT:out T_MOT);
  procedure PUT (MOT:in T_MOT);
  procedure TRANS_MINUSCULE (MOT:in out T_MOT);
  procedure TRANS_MAJUSCULE (MOT:in out T_MOT);

end ES_MOT;
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with TEXT_IO,ADA.CHARACTERS.HANDLING;
use TEXT_IO,ADA.CHARACTERS.HANDLING;

package body ES_MOT is

  package ES_LONGUEUR is new TEXT_IO.INTEGER_IO(T_LONGUEUR);
------------------------------------------------------------------------------
  procedure GET (MOT:out T_MOT) is

  LG:POSITIVE;
  STR:STRING(T_LONGUEUR);

  begin
    get_line(STR,LG);
    MOT:=(T_LONGUEUR(LG),STR(1..LG));
  end GET;
------------------------------------------------------------------------------
  procedure PUT (MOT:in T_MOT) is

  begin
    ES_LONGUEUR.put(MOT.LG);
    put(" ");
    put(MOT.STR);
  end PUT;
------------------------------------------------------------------------------
  procedure TRANS_MINUSCULE (MOT:in out T_MOT) is

  begin
    for I in MOT.STR'RANGE loop
      MOT.STR(I):=TO_LOWER(MOT.STR(I));
    end loop;
  end TRANS_MINUSCULE;
------------------------------------------------------------------------------
  procedure TRANS_MAJUSCULE (MOT:in out T_MOT) is

  begin
    for I in MOT.STR'RANGE loop
      MOT.STR(I):=TO_UPPER(MOT.STR(I));
    end loop;
  end TRANS_MAJUSCULE;
------------------------------------------------------------------------------
end ES_MOT;
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with TEXT_IO,ES_MOT;
use ES_MOT;

package ES_RESERV is

  type T_IND is (AUCUNE,GAUCHE,DROITE,GAUCHETDROITE);

  type T_RC is new BOOLEAN;

  type T_RESERV is
    record
      CHAMP_MOT:T_MOT;
      CHAMP_CLASS_RC:T_RC;
      CHAMP_CLASS_IND:T_IND;
    end record;

  type T_TAB is array (INTEGER range <>) of T_MOT;
------------------------------------------------------------------------------
  procedure RECUPERE_CHAMPS (MOT:in out T_MOT ; RESERV:out T_RESERV);

  function APPARTIENT (MOT:T_MOT;TAB:T_TAB) return BOOLEAN;

end ES_RESERV;
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with ES_MOT;
use ES_MOT;

package body ES_RESERV is

  N_RES:CONSTANT INTEGER:=66;
  N_RC:CONSTANT INTEGER:=11;
  N_ID:CONSTANT INTEGER:=12;
  N_IG:CONSTANT INTEGER:=3;
  MR:T_TAB(1..N_RES):=((5,"abort"),(3,"abs"),(8,"abstract"),(6,"accept"),
                    (7,"aliased"),(3,"all"),(3,"and"),(5,"array"),(2,"at"),
                    (5,"begin"),(4,"body"),(4,"case"),(8,"constant"),
                    (7,"declare"),(5,"delay"),(5,"delta"),(6,"digits"),
                    (2,"do"),(4,"else"),(5,"elsif"),(3,"end"),(5,"entry"),
                    (4,"exit"),(3,"for"),(8,"function"),(7,"generic"),
                    (4,"goto"),(2,"if"),(2,"in"),(2,"is"),(7,"limited"),
                    (4,"loop"),(3,"mod"),(3,"new"),(3,"not"),(4,"null"),
                    (2,"of"),(2,"or"),(6,"others"),(3,"out"),(7,"package"),
                    
(6,"pragma"),(7,"private"),(9,"procedure"),(9,"protected"),
                    (5,"raise"),(5,"range"),(6,"record"),(3,"rem"),
                    (7,"renames"),(7,"requeue"),(6,"return"),(7,"reverse"),
                    (6,"select"),(6,"tagged"),(4,"task"),(9,"terminate"),
                    (4,"then"),(4,"type"),(5,"until"),(3,"use"),(4,"when"),
                    (5,"while"),(4,"with"),(3,"xor"),(1,";"));

  RC:T_TAB(1..N_RC):=((1,";"),(5,"begin"),(7,"declare"),(9,"exception"),
                     (7,"generic"),(2,"is"),(4,"loop"),(7,"private"),
                     (6,"record"),(6,"select"),(4,"then"));

  ID:T_TAB(1..N_ID):=((5,"begin"),(4,"case"),(7,"declare"),(4,"else"),
                     (9,"exception"),(7,"generic"),(2,"is"),(4,"loop"),
                     (7,"private"),(6,"record"),(6,"select"),(4,"then"));
                    
  IG:T_TAB(1..N_IG):=((4,"else"),(5,"elsif"),(3,"end"));
------------------------------------------------------------------------------
  procedure RECUPERE_CHAMPS (MOT:in out T_MOT ; RESERV:out T_RESERV) is

    begin
      TRANS_MINUSCULE(MOT);
      if NOT APPARTIENT(MOT,MR)
        then begin
                TRANS_MAJUSCULE(MOT);
                RESERV:=(MOT,FALSE,AUCUNE);
              end;
        else
          if APPARTIENT(MOT,RC)
            then
              if APPARTIENT(MOT,ID)
                then RESERV:=(MOT,TRUE,DROITE);
                else RESERV:=(MOT,TRUE,AUCUNE);
              end if;
            else
              if APPARTIENT(MOT,IG)
                then
                  if APPARTIENT(MOT,ID)
                    then RESERV:=(MOT,FALSE,GAUCHETDROITE);
                    else RESERV:=(MOT,FALSE,GAUCHE);
                  end if;
                else RESERV:=(MOT,FALSE,AUCUNE);
              end if;
          end if;
      end if;
  end RECUPERE_CHAMPS;
------------------------------------------------------------------------------
  function APPARTIENT (MOT:T_MOT;TAB:T_TAB) return BOOLEAN is

    RESULTAT:BOOLEAN:=FALSE;

    begin
      for I in TAB'RANGE loop
        if MOT.LG=TAB(I).LG
          then
            if MOT.STR=TAB(I).STR
              then RESULTAT:=TRUE;
            end if;
        end if;
        exit when RESULTAT;
      end loop;
      return RESULTAT;
    end APPARTIENT;
------------------------------------------------------------------------------
end ES_RESERV;
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with ES_MOT,ES_RESERV;
use ES_MOT,ES_RESERV;

package ES_TEXTE is

  subtype T_LGLIGNE is POSITIVE RANGE 1..80;

  type T_LIGNE (LG:T_LGLIGNE:=1) is
    record
      STR:STRING(1..LG);
    end record;

  type T_TEXTE is array (INTEGER RANGE <>) of T_LIGNE;
------------------------------------------------------------------------------
  procedure GET (LIGNE:out T_LIGNE);

  procedure PUT (LIGNE:in T_LIGNE);

  procedure GET (TEXTE:out T_TEXTE ; NBR:in out INTEGER);

  procedure PUT (TEXTE:in T_TEXTE ; NBR:in INTEGER);

  procedure CHARGE_TEXTE (TEXTE:out T_TEXTE);

  procedure REFORMATE_TEXTE (TEXTE:in out T_TEXTE ; NBR:in out INTEGER);

end ES_TEXTE;
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with TEXT_IO,ES_MOT,ES_RESERV,ADA.CHARACTERS.HANDLING;
use TEXT_IO,ES_MOT,ES_RESERV,ADA.CHARACTERS.HANDLING;


package body ES_TEXTE is

  package ES_LIGNE is new INTEGER_IO(T_LGLIGNE);
  package ES_INT is new INTEGER_IO(INTEGER);
------------------------------------------------------------------------------
  procedure GET (LIGNE:out T_LIGNE) is

    STR:STRING(T_LGLIGNE);
    LG:POSITIVE;

    begin
      PUT("> ");
      GET_LINE(STR,LG);
      LIGNE:=(T_LGLIGNE(LG),STR(1..LG));
    end GET;
------------------------------------------------------------------------------
  procedure PUT (LIGNE:in T_LIGNE) is

  begin
    PUT(LIGNE.STR);
  end PUT;
------------------------------------------------------------------------------
  procedure GET (TEXTE:out T_TEXTE ; NBR:in out INTEGER) is

    begin
      PUT_LINE("80 caract�res maximum pour une ligne.");
      PUT_LINE("Pour arr�ter, tapez: eof");
      NBR:=1;
      loop
        GET(TEXTE(NBR));
        exit when TEXTE(NBR).STR="eof";
        NBR:=NBR+1;
      end loop;
    end GET;
------------------------------------------------------------------------------
  procedure PUT (TEXTE:in T_TEXTE ; NBR:in INTEGER) is

  begin
    for I in TEXTE'FIRST..NBR loop
      ES_INT.PUT(I);
      PUT(": ");
      PUT(TEXTE(I));
      NEW_LINE;
    end loop;
  end PUT;
------------------------------------------------------------------------------
  procedure CHARGE_TEXTE (TEXTE:out T_TEXTE) is

    begin
      for I in TEXTE'RANGE loop
        for J in TEXTE(I).STR'RANGE loop
         TEXTE(I).STR(J):=TO_LOWER(TEXTE(I).STR(J));
        end loop;
      end loop;
    end CHARGE_TEXTE;
------------------------------------------------------------------------------
  procedure SUPPRIME_BLANCS_INUTILES (TEXTE:in out T_TEXTE) is

    begin
      PUT("Proc�dure SUPPRIME_BLANCS_INUTILES en construction...");
    end SUPPRIME_BLANCS_INUTILES;
------------------------------------------------------------------------------
  procedure SUPPRIME_LIGNES_INUTILES (TEXTE:in out T_TEXTE) is

    begin
      PUT_LINE("Proc�dure SUPPRIME_LIGNES_INUTILES en construction");
    end SUPPRIME_LIGNES_INUTILES;
------------------------------------------------------------------------------
  procedure TAB_DROITE (TEXTE:in out T_TEXTE ; 
                        POS:in INTEGER ;
                        TAILLE:in INTEGER) is

    begin
      for I in POS+1..TAILLE loop
        TEXTE(I):=(TEXTE(I).LG+4,"____" & TEXTE(I).STR);
      end loop;
    end TAB_DROITE;
------------------------------------------------------------------------------
  procedure TAB_GAUCHE (TEXTE:in out T_TEXTE ;
                        POS:in INTEGER ;
                        TAILLE:in INTEGER) is

    begin
      for I in POS..TAILLE loop
        TEXTE(I):=(TEXTE(I).LG-4,TEXTE(I).STR(5..TEXTE(I).LG));
      end loop;
    end TAB_GAUCHE;
------------------------------------------------------------------------------
  procedure TAB_GAUCHETDROITE (TEXTE:in out T_TEXTE ;
                              POS:in INTEGER ;
                              TAILLE:in INTEGER) is

    begin
      PUT_LINE("Proc�dure TAB_GAUCHETDROITE en construction");
    end TAB_GAUCHETDROITE;
------------------------------------------------------------------------------
  function EXTRAIRE_MOT (LIGNE:T_LIGNE ; POS:INTEGER) return T_MOT is

    MOT:T_MOT;
    LGMOT:T_LONGUEUR;
    STR:STRING(T_LONGUEUR);
    COMPTEUR,PLACE:INTEGER;
    N_SEP:CONSTANT INTEGER:=15;
    SEPARATEURS:T_TAB(1..N_SEP):=((1," "),(1,"."),(1,";"),(1,","),(1,":"),
                                  (1,"="),(1,"+"),(1,"*"),(1,"-"),(1,"/"),
                                  (1,"\"),(1,"<"),(1,">"),(1,"("),(1,")"));
    begin
      COMPTEUR:=0;
      if APPARTIENT ((1,LIGNE.STR(POS..POS)),SEPARATEURS)
        then begin
                STR(1..1):=LIGNE.STR(POS..POS);
                MOT:=(1,STR(1..1));
                return MOT;
              end;
      end if;
      for I in POS..LIGNE.LG loop
        if NOT APPARTIENT ((1,LIGNE.STR(I..I)),SEPARATEURS)
          then COMPTEUR:=COMPTEUR+1;
          else exit;
        end if;
        exit when COMPTEUR > T_LONGUEUR'LAST;
      end loop;
      LGMOT:=T_LONGUEUR(COMPTEUR);
      PLACE:=POS;
      for J in 1..COMPTEUR loop
        STR(J..J):=LIGNE.STR(PLACE..PLACE);
        PLACE:=PLACE+1;
      end loop;
      MOT:=(LGMOT,STR(1..LGMOT));
      return MOT;
    end EXTRAIRE_MOT;
------------------------------------------------------------------------------
  procedure ECRIRE_MOT (LIGNE:out T_LIGNE ; MOT:in T_MOT ; POS:in INTEGER) is

    PLACE:INTEGER;

    begin
      PLACE:=POS;
      for I in 1..MOT.LG loop
        LIGNE.STR(PLACE..PLACE):=MOT.STR(I..I);
        PLACE:=PLACE+1;
      end loop;
    end ECRIRE_MOT;
------------------------------------------------------------------------------
    procedure INSERER_LIGNE (TEXTE:in out T_TEXTE ;
                             NBR:in out INTEGER ;
                             NUM:in INTEGER ;
                             POS:in INTEGER) is

    INDICE:INTEGER:=1;
    TAILLE:INTEGER;

    begin
      TAILLE:=1+NBR;
      for I in reverse NUM+1..TAILLE loop
        TEXTE(I):=TEXTE(I-1);
      end loop;
      for J in POS..TEXTE(NUM).LG loop
        TEXTE(NUM+1).STR(INDICE..INDICE):=TEXTE(NUM).STR(J..J);
        TEXTE(NUM).STR(J..J):=" ";
        INDICE:=INDICE+1;
      end loop;
      for K in INDICE..TEXTE(NUM+1).LG loop
        TEXTE(NUM+1).STR(K..K):=" ";
      end loop;
    end INSERER_LIGNE;
------------------------------------------------------------------------------
    procedure REFORMATE_TEXTE (TEXTE:in out T_TEXTE ; NBR:in out INTEGER) is

    MOT:T_MOT;
    RESERV:T_RESERV;
    J,LGMOT:T_LONGUEUR;

    begin
      for I in TEXTE'RANGE loop
        J:=1;
        LGMOT:=1;
        while J < TEXTE(I).LG loop
          MOT:=EXTRAIRE_MOT(TEXTE(I),INTEGER(LGMOT));
          RECUPERE_CHAMPS(MOT,RESERV);
          ECRIRE_MOT(TEXTE(I),MOT,INTEGER(LGMOT));
          LGMOT:=LGMOT+MOT.LG;
          J:=LGMOT;
          if RESERV.CHAMP_CLASS_RC
            then begin
                    INSERER_LIGNE(TEXTE,NBR,I,J);
                    NBR:=NBR+1;
                 end;
          end if;
	
          case RESERV.CHAMP_CLASS_IND is
            when AUCUNE => exit;
            when DROITE => TAB_DROITE(TEXTE,I,NBR);
            when GAUCHE => TAB_GAUCHE(TEXTE,I,NBR);
            when GAUCHETDROITE => TAB_GAUCHETDROITE(TEXTE,I,NBR);
          end case; 

         end loop;
      end loop;
    end REFORMATE_TEXTE;
------------------------------------------------------------------------------
end ES_TEXTE;
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with TEXT_IO,ES_MOT,ES_RESERV,ES_TEXTE;
use TEXT_IO,ES_MOT,ES_RESERV,ES_TEXTE;
    
procedure TP2 is

  MAX:CONSTANT INTEGER:=100;
  TAILLE:INTEGER;
  TEXTE:T_TEXTE(1..MAX);
  MOT:T_MOT;

  begin
    GET(TEXTE,TAILLE);
    PUT(TEXTE,TAILLE);
    CHARGE_TEXTE(TEXTE);
    REFORMATE_TEXTE(TEXTE,TAILLE);
    PUT(TEXTE,TAILLE);
  end TP2;
------------------------------------------------------------------------------
------------------------------------------------------------------------------