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

  1.                                        -- Chapter 21 - Program 4
  2.  
  3. -- This package uses a data structure composed of three INTEGER
  4. -- variables.  It allow the user to add two structures, component
  5. -- by component, or subtract component by component.  Provision is
  6. -- also made to build a structure from three numbers, or decompose
  7. -- a structure into its components.
  8.  
  9. package Three is
  10. type DATA_STRUCTURE is limited private;
  11. function "+"(Data1, Data2 : DATA_STRUCTURE) return DATA_STRUCTURE;
  12. function "-"(Data1, Data2 : DATA_STRUCTURE) return DATA_STRUCTURE;
  13. function Build_Structure(Val1, Val2, Val3 : INTEGER) return
  14.                                                    DATA_STRUCTURE;
  15. procedure Decompose(Data1 : DATA_STRUCTURE;
  16.                     Val1, Val2, Val3 : out INTEGER);
  17. procedure Assign_Struct(Data1 : out DATA_STRUCTURE;
  18.                         Data2 : in DATA_STRUCTURE);
  19. function Compare(Data1, Data2 : DATA_STRUCTURE) return BOOLEAN;
  20.  
  21. private
  22.    type DATA_STRUCTURE is
  23.       record
  24.          Value1 : INTEGER;
  25.          Value2 : INTEGER;
  26.          Value3 : INTEGER;
  27.       end record;
  28. end Three;
  29.  
  30.  
  31.  
  32. package body Three is
  33.  
  34. function "+"(Data1, Data2 : DATA_STRUCTURE) return DATA_STRUCTURE is
  35. Temp : DATA_STRUCTURE;
  36. begin
  37.    Temp.Value1 := Data1.Value1 + Data2.Value1;
  38.    Temp.Value2 := Data1.Value2 + Data2.Value2;
  39.    Temp.Value3 := Data1.Value3 + Data2.Value3;
  40.    return Temp;
  41. end "+";
  42.  
  43.  
  44. function "-"(Data1, Data2 : DATA_STRUCTURE) return DATA_STRUCTURE is
  45. Temp : DATA_STRUCTURE;
  46. begin
  47.    Temp.Value1 := Data1.Value1 - Data2.Value1;
  48.    Temp.Value2 := Data1.Value2 - Data2.Value2;
  49.    Temp.Value3 := Data1.Value3 - Data2.Value3;
  50.    return Temp;
  51. end "-";
  52.  
  53.  
  54. function Build_Structure(Val1, Val2, Val3 : INTEGER) return
  55.                                                    DATA_STRUCTURE is
  56. Temp : DATA_STRUCTURE;
  57. begin
  58.    Temp.Value1 := Val1;
  59.    Temp.Value2 := Val2;
  60.    Temp.Value3 := Val3;
  61.    return Temp;
  62. end Build_Structure;
  63.  
  64.  
  65. procedure Decompose(Data1 : DATA_STRUCTURE;
  66.                     Val1, Val2, Val3 : out INTEGER) is
  67. begin
  68.    Val1 := Data1.Value1;
  69.    Val2 := Data1.Value2;
  70.    Val3 := Data1.Value3;
  71. end Decompose;
  72.  
  73.  
  74.  
  75. procedure Assign_Struct(Data1 : out DATA_STRUCTURE;
  76.                         Data2 : in DATA_STRUCTURE) is
  77. begin
  78.    Data1 := Data2;
  79. end Assign_Struct;
  80.  
  81.  
  82.  
  83. function Compare(Data1, Data2 : DATA_STRUCTURE) return BOOLEAN is
  84. begin
  85.    return Data1 = Data2;
  86. end Compare;
  87.  
  88. end Three;
  89.  
  90.  
  91.  
  92.  
  93. -- This program exercises the package Three as an illustration.
  94.  
  95. with Text_IO;   use Text_IO;
  96. with Three;     use Three;
  97.  
  98. procedure LimPriv is
  99.  
  100.    My_Data, Extra_Data : DATA_STRUCTURE;
  101.  
  102. begin
  103.  
  104.    Assign_Struct(My_Data, Build_Structure(3,7,13));
  105.    Assign_Struct(Extra_Data, Build_Structure(-4,77,0));
  106.    Assign_Struct(My_Data, My_Data + Extra_Data);
  107.  
  108.    if not Compare(My_Data, Extra_Data) then
  109.       Put_Line("The two structures are not equal.");
  110.    end if;
  111.  
  112.    Assign_Struct(My_Data, Extra_Data);
  113.  
  114.    if Compare(My_Data, Extra_Data) then
  115.       Put_Line("The two structures are equal now.");
  116.    end if;
  117.  
  118. --       The following line is illegal with the limited private type
  119. --  My_Data.Value1 := My_Data.Value1 + 13;
  120.  
  121. end LimPriv;
  122.  
  123.  
  124.  
  125.  
  126. -- Result of execution
  127.  
  128. -- The two structures are not equal.
  129. -- The two structures are equal now.
  130.  
  131.