Re: confusing string error

[agent@drrob1.com]

On Fri, 14 Feb 2014 14:03:24 +0100, Jacob Sparre Andersen
<jacob@jacob-sparre.dk> wrote:

>agent@drrob1.com writes:
>
>> Code fragment:
>>
>
>You haven't provided enough information to compile and evaluate your
>example.
>
>Greetings,
>
>Jacob

I was trying not to bomb the newsgroup.  But it seems you want it.  So
here we go.  Assume that a valid spec file exists.  I included the
relevent types I define in it in my comments, as it is in my actual
code.

Package body tokenizea is
      TKNMAXSIZ : constant := 80;
      DGTMAXSIZ : constant := 9;
      OPMAXSIZ  : constant := 2;
      POUNDSIGN : constant Character := '#';  -- (* 35 *)
      PLUSSIGN  : constant Character := '+';  -- (* 43 *)
      COMMA     : constant Character := ',';  -- (* 44 *)
      MINUSSIGN : constant Character := '-';  -- (* 45 *)
      SEMCOL    : constant Character := ';';  -- (* 59 *)
      LTSIGN    : constant Character := '<';  -- (* 60 *)
      EQUALSIGN : constant Character := '=';  -- (* 61 *)
      GTSIGN    : constant Character := '>';  -- (* 62 *)
      MULTSIGN  : constant Character := '*';
      DIVSIGN   : constant Character := '/';
      ASCZERO   : constant :=  Character'Pos('0'); -- 48, 30H.
      SQUOTE    : constant Character := ''';  -- Character'Val(39)
      DQUOTE    : constant Character := '"';  -- Character'Val(34);
      NullChar  : constant Character :=  Character'Val(0);
      CharDgt0  : constant Character := '0';
      CharDgt9  : constant Character := '9';

-- Now declared in package spec file
--  TYPE FSATYP is (DELIM, OP, DGT, ALLELSE);
--  Type TokenType is Record
--    uStr: Unbound_String;
--    State : FSATYP;
--    delimCH : Character;
--    DelimState: FSATYP;
--    Sum : Integer;
--  END Record;
--  Type CharType is Record
--    ch : Character;
--    State : FSATYP;
--  END Record;

--  These variables are declared here to make the variable static so
-- to maintain
--  their values between procedure calls.
  CURPOSN,HOLDCURPOSN,PREVPOSN : Natural;
  TKNBUF,HOLDTKNBUF : Unbounded_String;
  FSAARRAY  : ARRAY (Character) OF FSATYP;
  out_of_range, token_too_long : EXCEPTION  ;

PROCEDURE InitFSAArray is
BEGIN
  FSAARRAY := (others => AllElse) ;
  FOR C in CharDgt0 .. CharDgt9 Loop
    FSAARRAY(C) := DGT;
  END Loop;
  FSAARRAY(NullChar) := DELIM;
  FSAARRAY(' ') := DELIM;
  FSAARRAY(',') := DELIM;
  FSAARRAY(';') := DELIM; -- (* semcol *)
  FSAARRAY('#') := OP;    -- (* poundsign *)
  FSAARRAY('*') := OP;    -- (* multsign *)
  FSAARRAY('+') := OP;    -- (* plussign *)
  FSAARRAY('-') := OP;    -- (* minussign *)
  FSAARRAY('/') := OP;    -- (* divsign *)
  FSAARRAY('<') := OP;    -- (* LTSIGN *)
  FSAARRAY('=') := OP;    -- (* EQUAL *)
  FSAARRAY('>') := OP;    -- (* GTSIGN *)
END InitFSAArray;

PROCEDURE INI1TKN(Str : String) is
-- *************************** INI1TKN 
--INITIALIZE TOKEN.
BEGIN
    CURPOSN  := 1;
    TKNBUF   := To_Unbounded_String(Str);
    PREVPOSN := 0;
    InitFSAArray;
END INI1TKN;

PROCEDURE PeekCHR(Char: OUT CharType; EOL : Out BOOLEAN) is
BEGIN
  IF CURPOSN > LENGTH(TKNBUF) THEN
    EOL := TRUE;
    Char.ch := NullChar;
    Char.State := DELIM;
    RETURN;
  ELSE
    EOL := FALSE;
  END IF;
  Char.CH := CAP(Element(TKNBUF,CURPOSN));
  Char.State := FSAARRAY(Char.CH);
END PeekCHR;

Procedure NextChr is
BEGIN
  CURPOSN := CurPosn + 1;
End NextChr;

PROCEDURE GETCHR(Char: OUT CharType; EOL : Out BOOLEAN) is
BEGIN
	PeekChr(Char, EOL);
	NextChr;
END GETCHR;

PROCEDURE UNGETCHR is
-- ********************************* UNGETCHR 
BEGIN
  IF (CURPOSN < 1) OR (CURPOSN > LENGTH(TKNBUF)+1) THEN
    RAISE out_of_range;
  END IF;
  CURPOSN := CurPosn - 1;
END UNGETCHR;

Function GETOPCODE(TOKEN : TokenType) RETURN Natural is
-- *************************** GETOPCODE 
-- GET OPCODE.
-- THIS ROUTINE RECEIVES A TOKEN OF FSATYP OP (MEANING IT IS AN
-- OPERATOR)
-- AND ANALYZES IT TO DETERMINE AN OPCODE, WHICH IS A 
-- Number FROM  1..15.
-- THE OPCODE ASSIGNMENTS FOR THE OP TOKENS ARE:
--  < is 1                  <= is 2
--  > is 3                  >= is 4
--  = is 5   == is 5        <> is 6    # is 7
--  + is 8                  += is 9
--  - is 10                 -= is 11
--  * is 12                 *= is 13
--  / is 14                 /= is 15
--
    CH1,CH2 : CHARacter;
    OpCode : Natural;
BEGIN
  OPCODE := 0;
  IF (LENGTH(Token.uStr) < 1) OR (LENGTH(Token.uStr) > 2) THEN
    RAISE token_too_long;
    RETURN OpCode;
  END IF;
  CH1 := Element(Token.uStr,1);
  CH2 := Element(Token.uStr,2);
  CASE CH1 is
    WHEN  LTSIGN => OPCODE := 1;
    WHEN  GTSIGN => OPCODE := 3;
    WHEN  EQUALSIGN => OPCODE := 5;
    WHEN  PLUSSIGN  => OPCODE := 8;
    WHEN  MINUSSIGN => OPCODE := 10;
    WHEN  POUNDSIGN => OPCODE := 7;
    WHEN  MULTSIGN  => OPCODE := 12;
    WHEN  DIVSIGN   => OPCODE := 14;
    WHEN OTHERS =>
      RETURN OpCode;
  END CASE;
  IF LENGTH(Token.uStr) = 1 THEN
    RETURN OpCode;
  ELSIF (CH2 = EQUALSIGN) AND (CH1 /= EQUALSIGN) AND 
      (CH1 /= POUNDSIGN) THEN
    OPCODE := OpCode + 1;
  ELSIF (CH1 = LTSIGN) AND (CH2 = GTSIGN) THEN
    OPCODE := 6;
  END IF;
  Return OpCode;
END GETOPCODE;

PROCEDURE GETTKN(TOKEN : Out TokenType; EOL : Out BOOLEAN) is
--*************************** GETTKN 
--
    NEGATV         : BOOLEAN;
    ORDCH,Len      : Natural;
    CHAR           : CHARType;
    QUOCHR         : CHARacter; --  (* Holds the active quote char *)
    QUOFLG         : BOOLEAN;
BEGIN
  QUOCHR := NullChar;
  QUOFLG := FALSE;
  PREVPOSN := CURPOSN;
  ToKeN.STATE := DELIM;
  Token.SUM := 0;
  Token.uStr := Null_Unbounded_String;
  NEGATV := FALSE;

  LOOP
    GETCHR(CHAR,EOL);
    IF EOL THEN
--  NO NEXT CHAR.  IF TKNSTATE IS DELIM, THEN GETTKN WAS CALLED WHEN
-- THERE WERE
--  NO MORE TOKENS ON LINE.  OTHERWISE IT MEANS THAT WE HAVE FETCHED
-- THE LAST
--  TOKEN ON THIS LINE.
      IF Token.STATE = DELIM THEN EOL := TRUE; END IF;
      EXIT;
    END IF;
    ORDCH := Character'Pos(Char.Ch);
    IF QUOFLG AND (Char.CH /= NullChar) THEN CHaR.STATE := ALLELSE;
END IF;
    CASE ToKeN.STATE is
      WHEN DELIM =>  -- token.state
        CASE CHaR.STATE is
          WHEN DELIM => 
-- NULL char is a special delimiter because it will
-- immediately cause a return even if there is no token yet,
-- i.e., the token is only delimiters.  This is because of
-- the NULL char is the string terminater for general strings
-- and especially for environment strings, for which this
-- TOKENIZE module was originally written. *)
                   IF CHAR.CH = NullChar THEN EXIT; END IF;
          WHEN OP => 
                     ToKeN.STATE := OP;
                     Token.uStr := Token.uStr & Char.Ch;
                     IF LENGTH(Token.uStr) > TKNMAXSIZ THEN
                       RAISE token_too_long;
                     END IF;
          WHEN DGT => 
                     Token.uStr := Token.uStr & Char.Ch;
                     ToKeN.STATE := DGT;
                     TOKEN.SUM := ORDCH - ASCZERO;
          WHEN ALLELSE => 
                     Token.uStr := Token.uStr & Char.Ch;
                     ToKeN.STATE := ALLELSE;
                     QUOFLG := (Char.CH = SQUOTE) OR (Char.CH =
DQUOTE);
                     IF QUOFLG THEN
                       QUOCHR := Char.CH;
                     ELSE
                       IF LENGTH(Token.uStr) > TKNMAXSIZ THEN
                         RAISE token_too_long;
                       END IF; -- if token too long
                       Token.SUM := ORDCH;
                     END IF; -- QUOFLG
        END CASE; -- Of Char.State
      WHEN OP => -- token.state
        CASE CHaR.STATE is
          WHEN DELIM =>
                       EXIT;
          WHEN OP =>
                    IF LENGTH(Token.uStr) > OPMAXSIZ THEN
                      RAISE token_too_long;
                    END IF;
                    Token.uStr := Token.uStr & Char.CH;
          WHEN DGT =>
                   IF (Element(Token.uStr,LENGTH(Token.uStr)) = '+')
OR
                     (Element(Token.uStr,LENGTH(Token.uStr)) = '-')
THEN
                     IF LENGTH(Token.uStr) = 1 THEN
                       IF ELEMENT(Token.uStr,1) = '-' THEN NEGATV :=
TRUE; END IF;
                       ToKeN.STATE := DGT;
-- OVERWRITE ARITHMETIC SIGN CHARACTER
                       Token.uStr := Null_Unbounded_String;
                       Token.uStr := Token.uStr & Char.CH;
                       Token.SUM := ORDCH - ASCZERO;
                     ELSE  -- TOKEN length > 1 SO MUST FIRST RETURN OP
                       UNGETCHR; -- (* UNGET THIS DIGIT CHAR *)
                       UNGETCHR; -- (* UNGET THE ARITH SIGN CHAR *)
                       Len := LENGTH(Token.uStr);
-- SO DELIMCH CORRECTLY RETURNS THE ARITH SIGN CHAR
                       Char.CH := Element(Token.uStr,Len); 
-- del last char of the token which is the sign character
                       Token.uStr := Delete(Token.uStr,Len,Len); 
                       EXIT;
                     END IF; -- if length of the token = 1
                   ELSE -- IF have a sign character
                     UNGETCHR;
                     EXIT;
                   END IF; -- If have a sign character
          WHEN ALLELSE =>
                   UNGETCHR;
                   EXIT;
        END CASE; -- Char.State
      WHEN DGT => -- tokenstate
        CASE CHaR.STATE is
          WHEN DELIM => EXIT;
          WHEN OP =>
                    UNGETCHR;
                    EXIT;
          WHEN DGT =>
                    Token.uStr := Token.uStr & Char.CH;
                    Token.SUM := 10*Token.SUM + ORDCH - ASCZERO;
          WHEN ALLELSE => 
                         UNGETCHR;
                         EXIT;
        END CASE; -- Char.State
      WHEN ALLELSE => -- tokenstate
        CASE CHaR.STATE is
          WHEN DELIM =>
--  Always exit if get a NULL char as a delim.  A quoted string can
-- only get here if CH is NULL.
                       EXIT;
          WHEN OP =>
                    UNGETCHR;
                    EXIT;
          WHEN DGT =>
                     IF LENGTH(Token.uStr) > TKNMAXSIZ THEN
                       RAISE token_too_long;
                     END IF; -- if token too long
                     Token.uStr := Token.uStr & Char.CH;
                     Token.SUM := Token.SUM + ORDCH;
          WHEN ALLELSE =>
                     IF Char.CH = QUOCHR THEN
                       QUOFLG := FALSE;
                       CHaR.STATE := DELIM; 
                       EXIT;
                     ELSE
                       IF LENGTH(Token.uStr) > TKNMAXSIZ THEN
                         RAISE token_too_long;
                       END IF; -- if token too long
                       Token.uStr := Token.uStr & Char.CH;
                       Token.SUM := Token.SUM + ORDCH;
                     END IF; -- if char is a quote char
        END CASE; --  Char.State
    END CASE; -- of Token.State
  END LOOP; -- to process characters
  Token.DELIMCH    := Char.CH;
  Token.DELIMSTATE := CHaR.STATE;
  IF (ToKeN.STATE = DGT) AND NEGATV THEN Token.SUM := -Token.SUM; END
IF;
--  For OP tokens, must return the opcode as the sum value.  Do this
--  by calling GETOPCODE.
  IF ToKeN.STATE = OP THEN
    Token.SUM := GetOpCode(Token);
  END IF;
END GETTKN;

BEGIN  -- main package body routine.
  HOLDCURPOSN := 0;  -- probably not needed in Ada.
  HOLDTKNBUF := Null_unbounded_string; -- looks like Ada automatically
init's all declarations to either 0 or null, as suits the data type
  InitFSAArray;
END tokenizea;



with tokenizea; use tokenizea;
Procedure testtokenizea is

  subType Str255Type is String(1..256);

  INBUF,s : Str255type;
  Token   : TokenType;
  Char    : CharType;
  I,J     : INTEGER;
  Last    : Natural;
  L       : LONG_INTeger;
  CH      : CHARacter;
  EOL     : Boolean;

BEGIN
    Put(" Input line : ");
    Get_Line(s,Last);
    New_line;
    I := s'last;
    Put(" Number of characters read is "); Put(Last);
    Put(".  Value of s'last is "); Put(I);
    INI1TKN(s(1..Last));
    LOOP
      GETTKN(TOKEN,EOL);
      Put(To_String(TOKEN.uStr));
      put(", token.state = ");
      Put(FSATyp'Image(ToKeN.STATE));
      Put(", sum=");
      Put(Token.Sum);
      Put(", DELIMCH= ");
      Put(Token.DELIMCH);
      Put(", DELIMSTATE= ");
      Put(FSATyp'Image(Token.DELIMSTATE));
      New_Line;
      EXIT When EOL;
    END LOOP; -- getting subsequent tokens on same line
END testtokenizea;



Thanks in advance

--Rob