Run Code
|
API
|
Code Wall
|
Users
|
Misc
|
Feedback
|
Login
|
Theme
|
Privacy
|
Patreon
Dynamic Dispatching with dynamic allocation
--GNAT 4.9.3 with Ada.Text_IO; use Ada.Text_IO; procedure main is package animals is type walk is interface; function can_walk(self : walk) return boolean is abstract; type swim is interface; function can_swim(self : swim) return boolean is abstract; type fly is interface; function can_fly(self : fly) return boolean is abstract; type animal is abstract new walk and swim and fly with record name : string(1..5); end record; function can_walk(self : animal) return boolean is abstract; function can_swim(self : animal) return boolean is abstract; function can_fly(self : animal) return boolean is abstract; subtype animal_class is animal'class; type animal_class_access is access all animal_class; type animal_list is array(positive range <>) of animal_class_access; type mammal is new animal with record legs : integer; fins : integer; end record; function can_walk(self : mammal) return boolean; function can_swim(self : mammal) return boolean; function can_fly(self : mammal) return boolean; type reptile is new animal with record legs : integer; fins : integer; end record; function can_walk(self : reptile) return boolean; function can_swim(self : reptile) return boolean; function can_fly(self : reptile) return boolean; type bird is new reptile with record wings : integer; end record; function can_fly(self : bird) return boolean; package constructor is function make_mammal(name : string; legs, fins : integer) return access mammal; function make_reptile(name : string; legs, fins : integer) return access reptile; function make_bird(name : string; legs, fins, wings : integer) return access bird; end constructor; end animals; package body animals is function can_walk(self : mammal) return boolean is begin if self.legs >= 2 then return True; else return false; end if; end can_walk; function can_swim(self : mammal) return boolean is begin return false; end can_swim; function can_fly(self : mammal) return boolean is begin return false; end can_fly; function can_walk(self : reptile) return boolean is begin if self.legs >= 2 then return True; else return false; end if; end can_walk; function can_swim(self : reptile) return boolean is begin if self.fins > 0 then return True; else return false; end if; end can_swim; function can_fly(self : reptile) return boolean is begin return false; end can_fly; function can_fly(self : bird) return boolean is begin if self.wings > 0 then return True; else return false; end if; end can_fly; package body constructor is function make_mammal(name : string; legs, fins : integer) return access mammal is self : access mammal := new mammal'(name => name, legs=> legs, fins=> fins); begin return self; end make_mammal; function make_reptile(name : string; legs, fins : integer) return access reptile is self : access reptile := new reptile'(name => name, legs=> legs, fins=> fins); begin return self; end make_reptile; function make_bird(name : string; legs, fins, wings : integer) return access bird is super : access reptile := make_reptile(name,legs,fins); self : access bird := new bird'(super.all with wings=>wings); begin return self; end make_bird; end constructor; end animals; use animals, animals.constructor; dog : animal_class_access := make_mammal(name => "dog ", legs => 4, fins=>0); snake : animal_class_access := make_reptile(name => "snake", legs => 0, fins=>0); fish : animal_class_access := make_reptile(name => "fish ", fins => 2, legs=>0); kite : animal_class_access := make_bird(name => "kite ", wings=>2 , legs => 0, fins=>0); my_animals : animal_list := (dog,snake,fish,kite); begin for i in my_animals'range loop Put (my_animals(i).name); if my_animals(i).can_walk then Put(" walking "); elsif not my_animals(i).can_swim and not my_animals(i).can_fly then Put(" crawling "); end if; if my_animals(i).can_swim then Put (" swimming "); end if; if my_animals(i).can_fly then Put (" flying "); end if; new_line; end loop; end main;
run
|
edit
|
history
|
help
1
Please
log in
to post a comment.
ada rocks!
Normal Random Numbers
plop
susuma_dos_enteros.adb
function calling using pointers
Dynamic Dispatching with no dynamic allocation
Controlled types (temporary anonymous objects)
Dynamic Dispatching
Iterator Interface
nested ADA code, same procedure name
Please log in to post a comment.