with DYN;
use  DYN;
with TEXT_IO;
use  TEXT_IO;
procedure DYNTEST is
  ------------------------------------------------------------------------
  -- This is a test program for the package DYN.  It is intended to be  --
  -- "fairly" exhaustive but not laborious.                             --
  ------------------------------------------------------------------------
  -- 10 Feb 86 - Initial preparation.  R.G. Cleaveland  Telesoft 1.5    --
  -- 12 Feb 86 - Ported to Verdix VAX ULTRIX version 5.1                --
  --                                                                    --
  --                                                                    --
  --                                                                    --
  ------------------------------------------------------------------------
    S           : STRING(1..MAX_D_STRING_LENGTH);
    D1,D2,D3    : DYN_STRING;
    IS_AN_ERROR : BOOLEAN;
  procedure FAILURE(N: in natural) is
    begin
      NEW_LINE;
      PUT("Failure of test ");
      PUT(INTEGER'IMAGE(N));
      NEW_LINE;
      PUT("D1:");
      PUT_LINE(STR(D1));
      PUT("D2:");
      PUT_LINE(STR(D2));
      PUT("D3:");
      PUT_LINE(STR(D3));
    end FAILURE;
  begin
    -- preparations
    for I in 1..MAX_D_STRING_LENGTH loop
      S(I) := 'X';
    end loop;
    CLEAR(D1);
    CLEAR(D2);
    CLEAR(D3);
     --  Conversions between Ada strings and DYN_STRING:
    if STR(D_STRING("Short")) /= "Short" then
      FAILURE(1);
    else
      PUT("< 1>");
    end if;
    if STR(D_STRING("")) /= "" then
      FAILURE(2);
    else
      PUT("< 2>");
    end if;
    if STR(D_STRING(S)) /= S then
      FAILURE(3);
    else
      PUT("< 3>");
    end if;
    D1 := D_STRING("Test");
    CLEAR(D1);
    if STR(D1) /= "" then
      FAILURE(4);
    else
      PUT("< 4>");
    end if;
    -- tests LENGTH
    D1 := D_STRING("TEN..BYTES");
    if LENGTH(D1) /= 10 then
      FAILURE(5);
    else
      PUT("< 5>");
    end if;
    -- tests CONCATENATIOPN
    D2 := D1;
    D2 := D1 & D2;
    if STR(D2) /= "TEN..BYTESTEN..BYTES" then
      FAILURE(6);
    else
      PUT("< 6>");
    end if;
    D1 := D1 & D2;
    if LENGTH(D1) /= 30
    or LENGTH(D2) /= 20 then
      FAILURE(7);
    else
      PUT("< 7>");
    end if;
    CLEAR(D1);
    CLEAR(D2);
    D2 := D1 & D2;
    if LENGTH(D1) /= 0
    or LENGTH(D2) /= 0 then
      FAILURE(8);
    else
      PUT("< 8>");
    end if;
    IS_AN_ERROR := true;
    D1 := D_STRING(S);
    begin
      D1 := D1 & D_STRING('X');
    exception
      when CONSTRAINT_ERROR => IS_AN_ERROR := false;
      when others           => null;
    end;
    if IS_AN_ERROR then
      FAILURE(9);
    else
      PUT("< 9>");
    end if;

    -- Making strings from integers
    D1 := D_STRING(0);
    D2 := D_STRING(INTEGER'LAST);
    D3 := D_STRING(INTEGER'FIRST);
    if STR(D1) /= " 0"
    or STR(D2) /= INTEGER'IMAGE(INTEGER'LAST)
    or STR(D3) /= INTEGER'IMAGE(INTEGER'FIRST) then
      FAILURE(10);
      PUT_LINE(INTEGER'image(INTEGER'last));
      PUT_LINE(INTEGER'image(INTEGER'first));
    else
      PUT("<10>");
    end if;
    D1 := D_STRING(1,12,'*');
    D2 := D_STRING(-1,12,'*');
    if STR(D1) /= " **********1"
    or STR(D2) /= "-**********1" then
      FAILURE(11);
    else
      PUT("<11>");
    end if;
    IS_AN_ERROR := true;
    D1 := D_STRING("XXX");
    begin
      D2 := D_STRING(10,2);
    exception
      when STRING_TOO_SHORT => IS_AN_ERROR := false;
      when others           => null;
    end;
    if IS_AN_ERROR then
      FAILURE(12);
    else
      PUT("<12>");
    end if;
    -- Making strings from FLOAT types.  This is a very casual test, and
    -- invites rigorous expansion.
    D1 := D_STRING(2.0, 2);
    if STR(D1) /= " 2.00" then
      FAILURE(13);
    else
      PUT("<13>");
    end if;
    -- testing INT
    if INT(D_STRING(INTEGER'last))  /= INTEGER'last
    or INT(D_STRING(INTEGER'first+1)) /= INTEGER'first+1  then
----------- above line modified to pass verdix 5.1 compiler-------
      FAILURE(14);
    else
      PUT("<14>");
    end if;
    -- testing FLT
    if FLT(D_STRING(2.0, 2)) /= 2.0 then
      FAILURE(15);
    else
      PUT("<15>");
    end if;
    -- Testing SUBSTITUTE
    D1 := D_STRING("123");
    SUBSTITUTE(D1,1,'X');
    SUBSTITUTE(D1,2,'Y');
    SUBSTITUTE(D1,3,'Z');
    SUBSTITUTE(D1,4,'%');
    if STR(D1) /= "XYZ%" then
      FAILURE(16);
    else
      PUT("<16>");
    end if;
    IS_AN_ERROR := true;
    begin
      SUBSTITUTE(D1,MAX_D_STRING_LENGTH+1,'X');
    exception
      when CONSTRAINT_ERROR => IS_AN_ERROR := false;
      when others           => null;
    end;
    if IS_AN_ERROR then
      FAILURE(17);
    else
      PUT("<17>");
    end if;
    -- test equality
    D2 := D_STRING(S);
    D1 := D_STRING("abc");
    D2 := SUBSTRING(D1,1,3);
    if EQUALS(D1, D2) then
      PUT("<18>");
    else
      FAILURE(18);
    end if;
    -- test inequality
    D2 := D_STRING("abd");
    if D2 <= D1 then
      FAILURE(19);
    else
      PUT("<19>");
    end if;
    -- test INDEX
    D1 := D_STRING("ABAAABCAAABC");
    if INDEX(D1,D_STRING("0"), 1) /= 0
    or INDEX(D1,D_STRING("A"), 1) /= 1
    or INDEX(D1,D_STRING("B"), 1) /= 2
    or INDEX(D1,D_STRING("A"), 2) /= 3
    or INDEX(D1,D_STRING("BC"), 1) /= 6
    or INDEX(D1,D_STRING("BC"), 6) /= 6
    or INDEX(D1,D_STRING("BC"), 7) /= 11
    or INDEX(D1,D_STRING("ABC"), 1) /= 5
    or INDEX(D1,D_STRING("ABAAABCAAABCA"), 1) /= -1 then
      FAILURE(20);
    else
      PUT("<20>");
    end if;
    -- test RINDEX
    D1 := D_STRING("ABAAABCAAABC");
    if RINDEX(D1,D_STRING("0"), 12) /= 0
    or RINDEX(D1,D_STRING("A"),  2) /= 1
    or RINDEX(D1,D_STRING("B"), 12) /= 11
    or RINDEX(D1,D_STRING("A"), 11) /= 10
    or RINDEX(D1,D_STRING("BC"), 11) /= 11
    or RINDEX(D1,D_STRING("BC"), 10) /= 6
    or RINDEX(D1,D_STRING("BC"),  5) /= 0
    or RINDEX(D1,D_STRING("BA"),12) /= -1
    or RINDEX(D1,D_STRING("ABAAABCAAABCA"),12) /= -1 then
      FAILURE(21);
    else
      PUT("<21>");
    end if;
    -- test of UPPERCASE and CHAR
    if STR (UPPERCASE(D_STRING("ABC")))     /= "ABC"
    or STR (UPPERCASE(D_STRING("abc")))     /= "ABC"
    or CHAR(UPPERCASE(D_STRING(ASCII.NUL))) /= ASCII.NUL
    or CHAR(UPPERCASE(D_STRING(ASCII.DEL))) /= ASCII.DEL
    or STR (UPPERCASE(D_STRING(""   )))     /= ""
    or STR (UPPERCASE(D_STRING(S    )))     /= S
    or STR (UPPERCASE(D_STRING(" z~")))     /= " Z~"       then
      FAILURE(22);
    else
      PUT("<22>");
    end if;
    -- test of RIGHT
    D1 := D_STRING("ABC");
    D2 := RIGHT(D1, 2);
    if STR(D2) /= "BC" then
      FAILURE(23);
    else
      PUT("<23>");
    end if;
    IS_AN_ERROR := true;
    begin
      D1 := RIGHT(D_STRING("ABC"),4);
    exception
      when CONSTRAINT_ERROR => IS_AN_ERROR := false;
      when others           => null;
    end;
    if IS_AN_ERROR then
      FAILURE(24);
    else
      PUT("<24>");
    end if;
    NEW_LINE;
    PUT_LINE("Test completed.");
end DYNTEST;