Tasks, geschützte Objekte und Verträge

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is

   task type Arbeiter (Id : Positive; Anzahl : Positive);

   task body Arbeiter is
      Summe : Natural := 0;
   begin
      for I in 1 .. Anzahl loop
         Summe := Summe + I;
      end loop;
      delay 0.01 * Id;
      Put_Line ("Arbeiter" & Positive'Image (Id) & ": " & Natural'Image (Summe));
   end Arbeiter;

   A1 : Arbeiter (1, 10);
   A2 : Arbeiter (2, 100);
   A3 : Arbeiter (3, 1000);
begin
   null;   -- Hauptprogramm wartet automatisch auf seine Tasks
end Main;

Arbeiter 1:  55
Arbeiter 2:  5050
Arbeiter 3:  500500

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is

   task Puffer is
      entry Ablegen (X : Integer);
      entry Holen (X : out Integer);
   end Puffer;

   task body Puffer is
      Wert : Integer := 0;
   begin
      for I in 1 .. 3 loop
         accept Ablegen (X : Integer) do
            Wert := X;
         end Ablegen;
         accept Holen (X : out Integer) do
            X := Wert * 2;
         end Holen;
      end loop;
   end Puffer;

   Ergebnis : Integer;
begin
   for I in 1 .. 3 loop
      Puffer.Ablegen (I * 10);
      Puffer.Holen (Ergebnis);
      Put_Line (Integer'Image (Ergebnis));
   end loop;
end Main;

20
 40
 60

with Ada.Text_IO; use Ada.Text_IO;

procedure Main is

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

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

begin
   declare
      task type Zaehle;
      task body Zaehle is
      begin
         for I in 1 .. 1000 loop
            Zaehler.Erhoehe;
         end loop;
      end Zaehle;
      Gruppe : array (1 .. 4) of Zaehle;
   begin
      null;
   end;   -- der Block endet erst, wenn alle Tasks fertig sind
   Put_Line (Natural'Image (Zaehler.Wert));
end Main;

4000

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Assertions;

procedure Main is
   subtype Gerade is Integer with Dynamic_Predicate => Gerade mod 2 = 0;

   function Teile (A, B : Integer) return Integer
     with Pre  => B /= 0,
          Post => Teile'Result * B <= A;

   function Teile (A, B : Integer) return Integer is (A / B);

   function Wurzel (X : Natural) return Natural
     with Post => Wurzel'Result * Wurzel'Result <= X
                  and (Wurzel'Result + 1) * (Wurzel'Result + 1) > X;

   function Wurzel (X : Natural) return Natural is
      R : Natural := 0;
   begin
      while (R + 1) * (R + 1) <= X loop
         R := R + 1;
      end loop;
      return R;
   end Wurzel;

   G : Gerade := 4;
begin
   Put_Line (Integer'Image (Teile (17, 5)));
   Put_Line (Integer'Image (Wurzel (50)));
   Put_Line (Integer'Image (G));
   Put_Line (Integer'Image (Teile (1, 0)));
exception
   when Ada.Assertions.Assertion_Error => Put_Line ("Vertragsverletzung: Vorbedingung");
end Main;

3
 7
 4
Vertragsverletzung: Vorbedingung