pck.ads 2.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576
  1. -- Copyright 2017-2022 Free Software Foundation, Inc.
  2. --
  3. -- This program is free software; you can redistribute it and/or modify
  4. -- it under the terms of the GNU General Public License as published by
  5. -- the Free Software Foundation; either version 3 of the License, or
  6. -- (at your option) any later version.
  7. --
  8. -- This program is distributed in the hope that it will be useful,
  9. -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. -- GNU General Public License for more details.
  12. --
  13. -- You should have received a copy of the GNU General Public License
  14. -- along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. with System;
  16. package Pck is
  17. package Top is
  18. type Top_T is tagged private;
  19. type Top_A is access Top_T'Class;
  20. procedure Assign (Obj: in out Top_T; TV : Integer);
  21. private
  22. type Top_T is tagged record
  23. N : Integer := 1;
  24. A : Integer := 48;
  25. end record;
  26. end Top;
  27. package Middle is
  28. type Middle_T is new Top.Top_T with private;
  29. type Middle_A is access Middle_T'Class;
  30. procedure Assign (Obj: in out Middle_T; MV : Character);
  31. private
  32. type Middle_T is new Top.Top_T with record
  33. N : Character := 'a';
  34. end record;
  35. end Middle;
  36. type Bottom_T is new Middle.Middle_T with record
  37. N : Float := 4.0;
  38. X : Integer := 6;
  39. A : Character := 'J';
  40. end record;
  41. type Bottom_A is access Bottom_T'Class;
  42. procedure Assign (Obj: in out Bottom_T; BV : Float);
  43. procedure Do_Nothing (A : System.Address);
  44. type Integer_Array is array (Natural range <>) of Integer;
  45. package Dyn_Top is
  46. type Dyn_Top_T (Disc : Natural) is tagged private;
  47. type Dyn_Top_A is access Dyn_Top_T'Class;
  48. procedure Assign (Obj: in out Dyn_Top_T; TV : Integer);
  49. private
  50. type Dyn_Top_T (Disc : Natural) is tagged record
  51. S : Integer_Array (1 .. Disc) := (others => Disc);
  52. N : Integer := 1;
  53. A : Integer := 48;
  54. end record;
  55. end Dyn_Top;
  56. package Dyn_Middle is
  57. type Dyn_Middle_T is new Dyn_Top.Dyn_Top_T with private;
  58. type Dyn_Middle_A is access Dyn_Middle_T'Class;
  59. procedure Assign (Obj: in out Dyn_Middle_T; MV : Character);
  60. private
  61. type Dyn_Middle_T is new Dyn_Top.Dyn_Top_T with record
  62. N : Character := 'a';
  63. U : Integer := 42;
  64. end record;
  65. end Dyn_Middle;
  66. end Pck;