home *** CD-ROM | disk | FTP | other *** search
/ Chip 1995 March / CHIP3.mdf / programm / prog4 / trystak.ada < prev    next >
Encoding:
Text File  |  1991-07-01  |  1.5 KB  |  72 lines
  1.                                        -- Chapter 31 - Program 8
  2. with Text_IO;
  3. use Text_IO;
  4. with GenStack;
  5.  
  6. procedure TryStak is
  7.  
  8.    package Int_IO is new Text_IO.Integer_IO(INTEGER);
  9.    use Int_IO;
  10.    package Char_Stack is new GenStack(CHARACTER);
  11.    use Char_Stack;
  12.  
  13.    Example : constant STRING := "This is the first test.";
  14.    Another : constant STRING :=
  15.                   "This is another test and this should not fit.";
  16.  
  17.    procedure Fill_The_Stack(Input_Line : STRING) is
  18.    begin
  19.       Clear_Stack;
  20.       for Index in 1..Input_Line'LAST loop
  21.          if Is_Full then
  22.             Put_Line("The stack is full, no more added.");
  23.             exit;
  24.          else
  25.             Push(Input_Line(Index));
  26.          end if;
  27.       end loop;
  28.    end Fill_The_Stack;
  29.  
  30.    procedure Empty_The_Stack is
  31.    Char : CHARACTER;
  32.    begin
  33.       loop
  34.          if Is_Empty then
  35.             New_Line;
  36.             Put_Line("The stack is empty.");
  37.             exit;
  38.          else
  39.             Pop(Char);
  40.             Put(Char);
  41.          end if;
  42.       end loop;
  43.    end Empty_The_Stack;
  44.  
  45. begin
  46.  
  47.    Put_Line(Example);
  48.    Fill_The_Stack(Example);
  49.    Empty_The_Stack;
  50.  
  51.    New_Line;
  52.    Put_Line(Another);
  53.    Fill_The_Stack(Another);
  54.    Empty_The_Stack;
  55.  
  56. end TryStak;
  57.  
  58.  
  59.  
  60.  
  61. -- Result of execution
  62.  
  63. -- This is the first test.
  64. -- .tset tsrif eht si sihT
  65. -- The stack is empty.
  66. --
  67. -- This is another test and should not fit.
  68. -- The stack is full, no more added.
  69. --  dna tset rehtona si sihT
  70. -- The stack is empty.
  71.  
  72.