Run Code
|
API
|
Code Wall
|
Misc
|
Feedback
|
Login
|
Theme
|
Privacy
|
Patreon
Dynamic Dispatching
--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 self : access bird := new bird; super : access reptile := make_reptile(name,legs,fins); begin reptile(self.all) := super.all; self.wings := wings; 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
function calling using pointers
es_perfecto.adb
ada rocks!
Ada Dimentional System
Ada.adb
nested ADA code, same procedure name
susuma_dos_enteros.adb
Iterator Interface
Ada Dimentional System
division_emtera_p.adb