home *** CD-ROM | disk | FTP | other *** search
/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / misc / dstr3.tst < prev    next >
Encoding:
Text File  |  1988-05-03  |  7.1 KB  |  268 lines
  1. with DYN;
  2. use  DYN;
  3. with TEXT_IO;
  4. use  TEXT_IO;
  5. procedure DYNTEST is
  6.   ------------------------------------------------------------------------
  7.   -- This is a test program for the package DYN.  It is intended to be  --
  8.   -- "fairly" exhaustive but not laborious.                             --
  9.   ------------------------------------------------------------------------
  10.   -- 10 Feb 86 - Initial preparation.  R.G. Cleaveland  Telesoft 1.5    --
  11.   -- 12 Feb 86 - Ported to Verdix VAX ULTRIX version 5.1                --
  12.   --                                                                    --
  13.   --                                                                    --
  14.   --                                                                    --
  15.   ------------------------------------------------------------------------
  16.     S           : STRING(1..MAX_D_STRING_LENGTH);
  17.     D1,D2,D3    : DYN_STRING;
  18.     IS_AN_ERROR : BOOLEAN;
  19.   procedure FAILURE(N: in natural) is
  20.     begin
  21.       NEW_LINE;
  22.       PUT("Failure of test ");
  23.       PUT(INTEGER'IMAGE(N));
  24.       NEW_LINE;
  25.       PUT("D1:");
  26.       PUT_LINE(STR(D1));
  27.       PUT("D2:");
  28.       PUT_LINE(STR(D2));
  29.       PUT("D3:");
  30.       PUT_LINE(STR(D3));
  31.     end FAILURE;
  32.   begin
  33.     -- preparations
  34.     for I in 1..MAX_D_STRING_LENGTH loop
  35.       S(I) := 'X';
  36.     end loop;
  37.     CLEAR(D1);
  38.     CLEAR(D2);
  39.     CLEAR(D3);
  40.      --  Conversions between Ada strings and DYN_STRING:
  41.     if STR(D_STRING("Short")) /= "Short" then
  42.       FAILURE(1);
  43.     else
  44.       PUT("< 1>");
  45.     end if;
  46.     if STR(D_STRING("")) /= "" then
  47.       FAILURE(2);
  48.     else
  49.       PUT("< 2>");
  50.     end if;
  51.     if STR(D_STRING(S)) /= S then
  52.       FAILURE(3);
  53.     else
  54.       PUT("< 3>");
  55.     end if;
  56.     D1 := D_STRING("Test");
  57.     CLEAR(D1);
  58.     if STR(D1) /= "" then
  59.       FAILURE(4);
  60.     else
  61.       PUT("< 4>");
  62.     end if;
  63.     -- tests LENGTH
  64.     D1 := D_STRING("TEN..BYTES");
  65.     if LENGTH(D1) /= 10 then
  66.       FAILURE(5);
  67.     else
  68.       PUT("< 5>");
  69.     end if;
  70.     -- tests CONCATENATIOPN
  71.     D2 := D1;
  72.     D2 := D1 & D2;
  73.     if STR(D2) /= "TEN..BYTESTEN..BYTES" then
  74.       FAILURE(6);
  75.     else
  76.       PUT("< 6>");
  77.     end if;
  78.     D1 := D1 & D2;
  79.     if LENGTH(D1) /= 30
  80.     or LENGTH(D2) /= 20 then
  81.       FAILURE(7);
  82.     else
  83.       PUT("< 7>");
  84.     end if;
  85.     CLEAR(D1);
  86.     CLEAR(D2);
  87.     D2 := D1 & D2;
  88.     if LENGTH(D1) /= 0
  89.     or LENGTH(D2) /= 0 then
  90.       FAILURE(8);
  91.     else
  92.       PUT("< 8>");
  93.     end if;
  94.     IS_AN_ERROR := true;
  95.     D1 := D_STRING(S);
  96.     begin
  97.       D1 := D1 & D_STRING('X');
  98.     exception
  99.       when CONSTRAINT_ERROR => IS_AN_ERROR := false;
  100.       when others           => null;
  101.     end;
  102.     if IS_AN_ERROR then
  103.       FAILURE(9);
  104.     else
  105.       PUT("< 9>");
  106.     end if;
  107.  
  108.     -- Making strings from integers
  109.     D1 := D_STRING(0);
  110.     D2 := D_STRING(INTEGER'LAST);
  111.     D3 := D_STRING(INTEGER'FIRST);
  112.     if STR(D1) /= " 0"
  113.     or STR(D2) /= INTEGER'IMAGE(INTEGER'LAST)
  114.     or STR(D3) /= INTEGER'IMAGE(INTEGER'FIRST) then
  115.       FAILURE(10);
  116.       PUT_LINE(INTEGER'image(INTEGER'last));
  117.       PUT_LINE(INTEGER'image(INTEGER'first));
  118.     else
  119.       PUT("<10>");
  120.     end if;
  121.     D1 := D_STRING(1,12,'*');
  122.     D2 := D_STRING(-1,12,'*');
  123.     if STR(D1) /= " **********1"
  124.     or STR(D2) /= "-**********1" then
  125.       FAILURE(11);
  126.     else
  127.       PUT("<11>");
  128.     end if;
  129.     IS_AN_ERROR := true;
  130.     D1 := D_STRING("XXX");
  131.     begin
  132.       D2 := D_STRING(10,2);
  133.     exception
  134.       when STRING_TOO_SHORT => IS_AN_ERROR := false;
  135.       when others           => null;
  136.     end;
  137.     if IS_AN_ERROR then
  138.       FAILURE(12);
  139.     else
  140.       PUT("<12>");
  141.     end if;
  142.     -- Making strings from FLOAT types.  This is a very casual test, and
  143.     -- invites rigorous expansion.
  144.     D1 := D_STRING(2.0, 2);
  145.     if STR(D1) /= " 2.00" then
  146.       FAILURE(13);
  147.     else
  148.       PUT("<13>");
  149.     end if;
  150.     -- testing INT
  151.     if INT(D_STRING(INTEGER'last))  /= INTEGER'last
  152.     or INT(D_STRING(INTEGER'first+1)) /= INTEGER'first+1  then
  153. ----------- above line modified to pass verdix 5.1 compiler-------
  154.       FAILURE(14);
  155.     else
  156.       PUT("<14>");
  157.     end if;
  158.     -- testing FLT
  159.     if FLT(D_STRING(2.0, 2)) /= 2.0 then
  160.       FAILURE(15);
  161.     else
  162.       PUT("<15>");
  163.     end if;
  164.     -- Testing SUBSTITUTE
  165.     D1 := D_STRING("123");
  166.     SUBSTITUTE(D1,1,'X');
  167.     SUBSTITUTE(D1,2,'Y');
  168.     SUBSTITUTE(D1,3,'Z');
  169.     SUBSTITUTE(D1,4,'%');
  170.     if STR(D1) /= "XYZ%" then
  171.       FAILURE(16);
  172.     else
  173.       PUT("<16>");
  174.     end if;
  175.     IS_AN_ERROR := true;
  176.     begin
  177.       SUBSTITUTE(D1,MAX_D_STRING_LENGTH+1,'X');
  178.     exception
  179.       when CONSTRAINT_ERROR => IS_AN_ERROR := false;
  180.       when others           => null;
  181.     end;
  182.     if IS_AN_ERROR then
  183.       FAILURE(17);
  184.     else
  185.       PUT("<17>");
  186.     end if;
  187.     -- test equality
  188.     D2 := D_STRING(S);
  189.     D1 := D_STRING("abc");
  190.     D2 := SUBSTRING(D1,1,3);
  191.     if EQUALS(D1, D2) then
  192.       PUT("<18>");
  193.     else
  194.       FAILURE(18);
  195.     end if;
  196.     -- test inequality
  197.     D2 := D_STRING("abd");
  198.     if D2 <= D1 then
  199.       FAILURE(19);
  200.     else
  201.       PUT("<19>");
  202.     end if;
  203.     -- test INDEX
  204.     D1 := D_STRING("ABAAABCAAABC");
  205.     if INDEX(D1,D_STRING("0"), 1) /= 0
  206.     or INDEX(D1,D_STRING("A"), 1) /= 1
  207.     or INDEX(D1,D_STRING("B"), 1) /= 2
  208.     or INDEX(D1,D_STRING("A"), 2) /= 3
  209.     or INDEX(D1,D_STRING("BC"), 1) /= 6
  210.     or INDEX(D1,D_STRING("BC"), 6) /= 6
  211.     or INDEX(D1,D_STRING("BC"), 7) /= 11
  212.     or INDEX(D1,D_STRING("ABC"), 1) /= 5
  213.     or INDEX(D1,D_STRING("ABAAABCAAABCA"), 1) /= -1 then
  214.       FAILURE(20);
  215.     else
  216.       PUT("<20>");
  217.     end if;
  218.     -- test RINDEX
  219.     D1 := D_STRING("ABAAABCAAABC");
  220.     if RINDEX(D1,D_STRING("0"), 12) /= 0
  221.     or RINDEX(D1,D_STRING("A"),  2) /= 1
  222.     or RINDEX(D1,D_STRING("B"), 12) /= 11
  223.     or RINDEX(D1,D_STRING("A"), 11) /= 10
  224.     or RINDEX(D1,D_STRING("BC"), 11) /= 11
  225.     or RINDEX(D1,D_STRING("BC"), 10) /= 6
  226.     or RINDEX(D1,D_STRING("BC"),  5) /= 0
  227.     or RINDEX(D1,D_STRING("BA"),12) /= -1
  228.     or RINDEX(D1,D_STRING("ABAAABCAAABCA"),12) /= -1 then
  229.       FAILURE(21);
  230.     else
  231.       PUT("<21>");
  232.     end if;
  233.     -- test of UPPERCASE and CHAR
  234.     if STR (UPPERCASE(D_STRING("ABC")))     /= "ABC"
  235.     or STR (UPPERCASE(D_STRING("abc")))     /= "ABC"
  236.     or CHAR(UPPERCASE(D_STRING(ASCII.NUL))) /= ASCII.NUL
  237.     or CHAR(UPPERCASE(D_STRING(ASCII.DEL))) /= ASCII.DEL
  238.     or STR (UPPERCASE(D_STRING(""   )))     /= ""
  239.     or STR (UPPERCASE(D_STRING(S    )))     /= S
  240.     or STR (UPPERCASE(D_STRING(" z~")))     /= " Z~"       then
  241.       FAILURE(22);
  242.     else
  243.       PUT("<22>");
  244.     end if;
  245.     -- test of RIGHT
  246.     D1 := D_STRING("ABC");
  247.     D2 := RIGHT(D1, 2);
  248.     if STR(D2) /= "BC" then
  249.       FAILURE(23);
  250.     else
  251.       PUT("<23>");
  252.     end if;
  253.     IS_AN_ERROR := true;
  254.     begin
  255.       D1 := RIGHT(D_STRING("ABC"),4);
  256.     exception
  257.       when CONSTRAINT_ERROR => IS_AN_ERROR := false;
  258.       when others           => null;
  259.     end;
  260.     if IS_AN_ERROR then
  261.       FAILURE(24);
  262.     else
  263.       PUT("<24>");
  264.     end if;
  265.     NEW_LINE;
  266.     PUT_LINE("Test completed.");
  267. end DYNTEST;
  268.