home *** CD-ROM | disk | FTP | other *** search
/ Chip 1995 March / CHIP3.mdf / programm / prog4 / answers / ch28_1.ada < prev    next >
Encoding:
Text File  |  1991-07-01  |  1.7 KB  |  81 lines

  1.                       -- Chapter 28 - Programming exercise 1
  2.    generic
  3.       type ITEM is range <>;   -- integer class only
  4.    procedure Exchange_Data(X,Y : in out ITEM);
  5.  
  6.    procedure Exchange_Data(X,Y : in out ITEM) is
  7.    Temp : ITEM;
  8.    begin
  9.       Temp := X;
  10.       X := Y;
  11.       Y := Temp;
  12.    end Exchange_Data;
  13.  
  14. -- This is the beginning of the main program which uses the generic
  15. -- procedure defined above.
  16. with Exchange_Data;
  17. with Text_IO;
  18. use Text_IO;
  19.  
  20. procedure CH28_1 is
  21.  
  22.    package Int_IO is new Text_IO.Integer_IO(INTEGER);
  23.    use Int_IO;
  24.  
  25.    type MY_INT is new INTEGER range 1..128;
  26.    subtype SUB_INT is INTEGER range 1.. 55;
  27.  
  28.    procedure SwapInt is new Exchange_Data(INTEGER);
  29.    procedure SwapNew is new Exchange_Data(MY_INT);
  30.    procedure SwapSub is new Exchange_Data(SUB_INT);
  31.  
  32.    Index1 : INTEGER := 17;
  33.    Index2 : INTEGER := 33;
  34.    Limit1 : MY_INT  := 3;
  35.    Limit2 : MY_INT  := 7;
  36.    Small1 : SUB_INT := 13;
  37.    Small2 : SUB_INT := 27;
  38.  
  39. begin
  40.  
  41.    SwapInt(Index1,Index2);
  42.    SwapNew(Limit1,Limit2);
  43.    SwapSub(Small1,Small2);
  44.    SwapInt(Small1,Small2);
  45.  
  46.    Put(Index1);
  47.    Put(Index2);
  48.    New_Line;
  49.    Put(INTEGER(Limit1));
  50.    Put(INTEGER(Limit2));
  51.    New_Line(2);
  52.  
  53.    SwapInt(Index1,INTEGER(Limit1));
  54.    SwapNew(MY_INT(Index2),Limit2);
  55.  
  56.    Put(Index1);
  57.    Put(Index2);
  58.    New_Line;
  59.    Put(INTEGER(Limit1));
  60.    Put(INTEGER(Limit2));
  61.    New_Line(2);
  62.  
  63. end CH28_1;
  64.  
  65.  
  66.  
  67.  
  68. -- Note that it is legal to instantiate a copy of the generic
  69. --   procedure for the subtype.  It is a waste of code however,
  70. --   because the procedure for the parent type can be used for
  71. --   the subtype as illustrated in line 44.
  72.  
  73. -- Result of Execution
  74.  
  75. --    33    17
  76. --     7     3
  77. --
  78. --     7     3
  79. --    33    17
  80.  
  81.