OOP Design in Ada: Private Extensions, Constructors & Class-Wide Contracts
Structure class hierarchies across packages with private tagged types and private extensions, write constructor functions, use class-wide preconditions and postconditions (Pre'Class, Post'Class) to enforce the Liskov substitution principle, null hook methods, and choose between variants, tagged types and generics.
Real Ada OOP combines packages, private types and tagged types: one package per abstraction, hidden representations, constructors instead of public aggregates, child packages for subclasses, and class-wide contracts that every descendant must honor. The result is an object-oriented design whose encapsulation and substitutability are checked by the compiler and the runtime.
Private Tagged Types and Private Extensions
'type Account is abstract tagged private;' hides the root's components. A child package declares a subclass with a private extension: 'type Savings_Account is new Account with private;' — clients know it is an Account, but its added components are hidden too. The child's private part and body see the parent's private components (S.Balance), so subclasses can be implemented efficiently without exposing data to clients.
• type T is [abstract] tagged private; • type D is new T with private; — private extension. • Put subclasses in child packages to see the parent's private part.
Constructors
Ada has no special constructor syntax. Use functions returning the type (Create), which inside the package can use extension aggregates such as (Account with Rate_Percent => Rate_Percent). A function returning a specific tagged type is itself a primitive and would have to be overridden in every extension (it 'goes abstract'); to avoid that, declare constructors in the child package of the concrete type (as here), in a nested package, or with a class-wide result. For limited types, constructors use build-in-place returns.
• Constructors are ordinary functions (Create / Make). • Primitive functions returning T must be overridden by extensions. • Put constructors in the concrete type's package or a nested package.
Class-Wide Contracts and Substitutability
Pre'Class and Post'Class attach contracts to a primitive that apply to all overridings. For a dispatching call, the class-wide precondition is checked (and a descendant may only weaken it, since Pre'Class conditions are combined with 'or'), while class-wide postconditions of ancestors must all hold (combined with 'and'). This is the Liskov substitution principle made executable: code written against Account'Class can rely on Deposit increasing the balance by exactly Amount. In the example, Pre'Class of Withdraw calls the dispatching Can_Withdraw, so each account kind defines its own rule.
• Pre'Class: inherited, may be weakened; Post'Class: inherited, strengthened. • Contracts that call dispatching functions adapt per subclass. • Violations raise Ada.Assertions.Assertion_Error (with -gnata / Assertion_Policy Check).
Code Examples
Both accounts receive 500. Checking may go to -50 thanks to its 100 overdraft. Month_End dispatches: Savings adds 2% interest (500 → 510); Checking uses the inherited null hook. Withdrawing 1 000 from savings violates the Pre'Class (Can_Withdraw returns False). Output: savings: 510 checking:-50 Withdraw (1_000) from savings: precondition failed
Ada offers several forms of polymorphism; choose by which dimension (kinds or operations) grows.
type Account is tagged record Balance: Integer; end record; -- public type Account is abstract tagged private;
Public components let clients bypass invariants; keep them private.
function Create return Account; -- primitive in the root package -- declare constructors for each concrete type in its own package
A primitive function returning the type must be overridden by every extension.
overriding procedure Deposit... with Pre => Amount < 100; -- stricter than parent -- only weaken preconditions in descendants (use Pre'Class on the root)
Strengthening a precondition breaks callers written against the parent class.
What is 'type D is new T with private;'? A. An interface B. A private extension C. A null record D. An abstract type
How are Pre'Class conditions combined across a hierarchy? A. and B. or (they can only be weakened) C. Only the last one counts D. They are ignored
Which exception is raised by a failed precondition under -gnata? A. Constraint_Error B. Ada.Assertions.Assertion_Error C. Program_Error D. Contract_Error
Why put Savings_Account in child package Accounts.Savings? A. Naming only B. The child can see Account's private components C. It must be D. Performance Trace the account hierarchy.
Real output: savings: 510 checking:-50 Withdraw (1_000) from savings: precondition failed
-- file: accounts-checking.ads
package Accounts.Checking is
type Checking_Account is new Account with private;
function Create (Overdraft : Natural) return Checking_Account;
overriding function Can_Withdraw (C : Checking_Account; Amount : Positive) return Boolean;
overriding function Kind (C : Checking_Account) return String is ("checking");
private
type Checking_Account is new Account with record
Overdraft : Natural;
end record;
end Accounts.Checking;
-- file: accounts-savings.ads
package Accounts.Savings is
-- Private extension: the added components are hidden too
type Savings_Account is new Account with private;
function Create (Rate_Percent : Natural) return Savings_Account; -- constructor
overriding function Can_Withdraw (S : Savings_Account; Amount : Positive) return Boolean;
overriding procedure Month_End (S : in out Savings_Account);
overriding function Kind (S : Savings_Account) return String is ("savings");
private
type Savings_Account is new Account with record
Rate_Percent : Natural;
end record;
end Accounts.Savings;
-- file: accounts.ads
package Accounts is
-- Private tagged type: an abstract root for a c
…Need Choose
Fixed set of kinds, many operations variant record + case
Open set of kinds, fixed operations tagged types + dispatching
Same algorithm for many types generics (static polymorphism)
Capability shared by unrelated types interfaces