-- $Id: methcall.gnat,v 1.0 2003/06/11 12:10:00 dada Exp $
-- http://dada.perl.it/shootout/
-- Ada 95 code by C.C.
with Text_IO, Ada.Command_Line, Ada.Characters.Handling;
procedure MethCall is
package Toggles is
type A_Rec is -- 'tagged' implies hidden field,
tagged record -- and can append new fields
Value : Boolean := True;
end record;
procedure Activate (A : in out A_Rec);
type B_Rec is new A_Rec with -- Add more fields to A_Rec
record
Flip_Period : Positive := 1;
Count : Natural := 0;
end record;
procedure Activate (B : in out B_Rec);
pragma Inline (Activate);
end Toggles;
package body Toggles is
procedure Activate (A : in out A_Rec) is
begin
A.Value := not A.Value;
end Activate;
procedure Activate (B : in out B_Rec) is
begin
B.Count := B.Count + 1;
if B.Count = B.Flip_Period then
B.Count := 0;
B.Value := not B.Value;
end if;
end Activate;
end Toggles;
X : Toggles.A_Rec := (Value => True);
Y : Toggles.B_Rec := (Value => True, Count => 0, Flip_Period => 3);
Val : Boolean;
N : Positive := 1;
begin
begin
N := Positive'Value (Ada.Command_Line.Argument (1));
exception
when Constraint_Error => null;
end;
for Iter in 1 .. N loop
Toggles.Activate (X);
Val := X.Value;
end loop;
Text_IO.Put_Line (Ada.Characters.Handling.To_Lower (Boolean'Image (Val)));
for Iter in 1 .. N loop
Toggles.Activate (Y);
Val := Y.Value;
end loop;
Text_IO.Put_Line (Ada.Characters.Handling.To_Lower (Boolean'Image (Val)));
end MethCall;