Pakete, Generics und Objekte

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is

   package Zaehler is
      procedure Erhoehe;
      function Wert return Natural;
   private
      Stand : Natural := 0;
   end Zaehler;

   package body Zaehler is
      procedure Erhoehe is
      begin
         Stand := Stand + 1;
      end Erhoehe;
      function Wert return Natural is (Stand);
   end Zaehler;

begin
   Zaehler.Erhoehe;
   Zaehler.Erhoehe;
   Put_Line (Natural'Image (Zaehler.Wert));
end Main;

2

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is

   generic
      type T is private;
   procedure Tausche (A, B : in out T);

   procedure Tausche (A, B : in out T) is
      Tmp : constant T := A;
   begin
      A := B;
      B := Tmp;
   end Tausche;

   generic
      type Element is private;
      with function "<" (L, R : Element) return Boolean is <>;
   function Kleineres (A, B : Element) return Element;

   function Kleineres (A, B : Element) return Element is
   begin
      if A < B then return A; else return B; end if;
   end Kleineres;

   procedure Tausche_Int is new Tausche (Integer);
   procedure Tausche_Str is new Tausche (Character);
   function Min_Int is new Kleineres (Integer);
   function Min_Float is new Kleineres (Float);

   X, Y : Integer := 0;
   A, B : Character := 'a';
begin
   X := 1; Y := 2;
   Tausche_Int (X, Y);
   Put_Line (Integer'Image (X) & Integer'Image (Y));
   A := 'x'; B := 'y';
   Tausche_Str (A, B);
   Put_Line (A & B);
   Put_Line (Integer'Image (Min_Int (9, 4)));
   Put_Line (Float'Image (Min_Float (2.5, 1.5)));
end Main;

2 1
yx
 4
 1.50000E+00

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is

   package Tiere is
      type Tier is tagged record
         Name : String (1 .. 3);
      end record;
      function Laut (T : Tier) return String is ("...");
      procedure Vorstellen (T : Tier'Class);

      type Hund is new Tier with null record;
      overriding function Laut (T : Hund) return String is ("Wau");

      type Katze is new Tier with record
         Leben : Natural := 9;
      end record;
      overriding function Laut (T : Katze) return String is ("Miau");
   end Tiere;

   package body Tiere is
      procedure Vorstellen (T : Tier'Class) is
      begin
         Put_Line (T.Name & " sagt " & Laut (T));
      end Vorstellen;
   end Tiere;

   use Tiere;
   H : Hund := (Name => "Rex");
   K : Katze := (Name => "Mim", Leben => 7);
begin
   Vorstellen (H);
   Vorstellen (K);
   Put_Line (Natural'Image (K.Leben));
end Main;

Rex sagt Wau
Mim sagt Miau
 7

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions;

procedure Main is
   Zu_Klein : exception;

   procedure Pruefe (N : Integer) is
   begin
      if N < 0 then
         raise Zu_Klein with "negativ: " & Integer'Image (N);
      end if;
      Put_Line ("ok" & Integer'Image (N));
   end Pruefe;
begin
   Pruefe (5);
   Pruefe (-1);
   Put_Line ("nicht erreicht");
exception
   when E : Zu_Klein =>
      Put_Line ("Fehler: " & Ada.Exceptions.Exception_Message (E));
   when Constraint_Error =>
      Put_Line ("Wertebereich");
end Main;

ok 5
Fehler: negativ: -1