stacks.adb

来自「Ada 2005 Training Notes.」· ADB 代码 · 共 65 行

with Ada.Text_IO;
use Ada.Text_IO;

with Ada.Numerics;
with LimitedPrivateType;

package body Stacks is
   procedure Push(OS: in out Object_Stack'Class; OCA: Object_Class_Ptr) is
   begin
      if OS.Top = Max then
         Put_Line("Stack is full Top = " & Integer'Image(OS.Top));
         return;
      end if;
      OS.Top := OS.Top +1;
      OS.S(OS.Top) := OCA;

   end Push;

   function "=" (First_OS, Second_OS: Object_Stack'Class) return Boolean is
   begin
      if First_OS.Top /= Second_OS.Top then
         return False;
      end if;

      for Idx in 1 .. First_OS.Top loop
         if First_OS.S(Idx) /= Second_OS.S(Idx) then
            return False;
         end if;
      end loop;

      return True;
   end "=";

   function Area(C: in Circle) return Float is
      PI: constant := 3.14;
   begin
      return PI * C.Radius ** 2;
   end Area;

   function Distance(OC: Object'Class) return Float is
   begin
      -- return Ada.Numerics.Sqrt(OC.X ** 2 + OC.Y** 2);
      return 0.0;
   end Distance;

   procedure LimitedPrivateTypeCannotBeAssigned(P: LimitedPrivateType.PrivateCell) is
      -- L: LimitedPrivateType.LimitedPrivateCell;
   begin
      Put_Line("LimitedPrivateTypeCannotBeAssigned");
      -- Error: left hand of assignment must not be limited type
      -- L := P;
   end LimitedPrivateTypeCannotBeAssigned;

   procedure LimitedPrivateTypeCanBeInitialized(P: LimitedPrivateType.LimitedPrivateCell) is
      -- This is initialization with limited types
      -- This is NOT copy (which is not allowed with limited types)
      -- But initialization is allowed.
      LPT: LimitedPrivateType.LimitedPrivateCell := LimitedPrivateType.Constructor(100);
   begin
      Put_Line("SubWithPrivateTypeCannotBeDeclated");
   end LimitedPrivateTypeCanBeInitialized;


end;