-- $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;