Ada (llenguatge de programació)

Ada

Tipus	wide-spectrum language (en) , llenguatge de programació multiparadigma, llenguatge de programació imperatiu, llenguatge de programació orientat a objectes i llenguatge de programació
Data de creació	1980
Disseny	Jean Ichbiah i S. Tucker Taft
Desenvolupador	Jean Ichbiah i S. Tucker Taft
Epònim	Ada Lovelace
Paradigma de programació	programació orientada a objectes, llenguatge imperatiu, programació estructurada i programació multiparadigma
Dialecte de	SPARK
Influenciat per	ALGOL 68, Pascal, Modula-2, C++, Smalltalk, Java, Llenguatge de programació Eiffel, ALGOL 60, Green i Ada 95 (en)
Etiqueta d'Stack Exchange	Etiqueta
Pàgina web	adaic.org

Ada és un llenguatge de programació estructurat i fortament tipat que fou dissenyat per Jean Ichbiah de CII Honeywell Bull per encàrrec del Departament de Defensa dels Estats Units. És un llenguatge d'ús general, orientat a objectes i concurrent, podent arribar des de la facilitat de Pascal fins a la flexibilitat de C++. El seu nom prové d'Ada Lovelace sovint considerada la primera escriptora de programes d'ordinador.

Fou dissenyat pensant en la seguretat i amb una filosofia orientada a la reducció d'errors comuns i difícils de descobrir. Per això es basa en el tipat fort i en verificacions en temps d'execució (desactivables en benefici del rendiment). La sincronització de tasques es realitza mitjançant la primitiva de comunicació síncrona rendez-vouz (cat.: trobada).

Ada es fa servir principalment en entorns en què es necessita una gran seguretat i fiabilitat, com pot ser la defensa, l'aeronàutica (Boeing o Airbus), la gestió del trànsit aeri (com Indra a l'Estat espanyol) i la indústria aeroespacial (ESA) entre d'altres, en estreta relació amb els Sistemes operatius de Temps Real.

Programa d'exemple

Aquest programa escriu "Hola, món!" al dispositiu de sortida per defecte (habitualment la línia d'ordres).

-- fitxer hola.adb

-- mòduls dels quals depèn
with Ada.Text_IO; 

procedure Hola is

 use Ada.Text_IO; -- importa espai de noms

begin
 Put_Line("Hola, món!");
end Hola;

Compilació i execució a Linux

gnatmake hola.adb

./hola

Compiladors

Des del Març de 2008 es disposa d'una versió experimental sobre el sistema LLVM.

• GNAT en anglès (GNU NewYorkUniv. Ada Translator) Compilador d'Ada de la sèrie GNU GCC
• Com construir el frontal ADA sobre LLVM Arxivat 2010-06-12 a Wayback Machine. en anglès Frontal ADA per al sistema de compiladors LLVM.

Característiques

Especificació i API biblioteca estàndard aquí.

Lèxic

• Tots els identificadors són independents de caixa de lletra (majúscula/minúscula). Abc equival a abc i també a ABC.

Sintaxi dels blocs de codi

function | procedure | declare
 -- declaracions
begin
 -- instruccions
exception
 -- gestors d'excepcions:
 when E: TipusExcepcio => -- tractament

 when E: others => -- tracta altres excepcions

end NomDelBloc ;

Tipus

Vegeu refs.

Si no s'especifica un tipus predefinit, es dedueix el tipus base per les clàusules de restricció:

• clàusula range : sencer -- restricció de rang
• clàusula mod : "modulars" (naturals) -- restricció pel valor del mòdul
• clàusula dígits : coma flotant -- precisió
• clàusula delta : coma-fixa (binari si no s'especifica precisió);
  • cas de clàusula dígits addicional a la clàusula delta, llavors és coma-fixa decimal

• range <> -- <> : restricció indefinida:
  • o bé abstracte (paràmetre formal d'un genèric)
  • o bé indica "rang per defecte"
  • o bé "rang segons implementació".

sencers

Predefinits:

• sencers: Integer (mínim 16 bits)
• subtipus Long_Integer (mínim 32 bits), opcionalment Long_Long_Integer (64 bits), Short_Integer (16 bits)
• subtipus restringits: Natural [0..), Positive[1..)

 type Recompte is range 0 .. 999 -- restricció de rang sobre sencers

aritmètica sense signe (modulars)

• sense signe: rang definit per l'operació mòdul, anomenats modulars.

 type Byte is mod 2**8

enumerats (discrets)

• discrets: (enumeració d'identificadors o de caràcters). Predefinits: Boolean, Character

 type Hexa is ('0', '9', 'A', 'B', 'C', 'D', 'E', 'F'); 
 type Boolean is (False, True) ;
 type Opcions is (OpcioA, OpcioB, OpcioC)

coma-flotant

• predefinits: Float (precisió simple de 6 dígits), Long_Float (precisió doble de 15 dígits), ...

 type Percentatge is digits 4 range 0.0 .. 1.0 -- coma-flotant precisió amb restricció de rang

coma-fixa

• coma-fixa binaris o bé decimals quan s'especifica la precisió.
• la clàusula delta precisa el valor incremental (el factor per al valor emmagatzemat), és a dir, la resolució del tipus.
• les operacions entre coma-fixes de delta diferents són més ràpides si les deltes són potència de la base.

 type Durada is delta Resolució_rellotge -- coma-fixa binari

 type Centim_DEuro is delta 0.01 digits 14 -- coma-fixa decimal quan incorpora precisió en dígits,
 -- pels coma-fixa decimals la delta (resolució) ha d'ésser obligatòriament potència de deu.

Entrada / Sortida específica per tipus

Els mòduls d'entrada sortida són genèrics. Per imprimir o llegir valors, cal obtenir una instància del genèric adequat per al tipus específic.

 -- instància del genèric 'Integer_IO' per a la precisió Long_Integer
 package Long_Integer_IO is new Ada.Text_IO.Integer_IO (Long_Integer)

 -- instància del genèric 'Float_IO' per a la precisió Long_Float
 package Long_Float_IO is new Ada.Text_IO.Float_IO (Long_Float)

 -- instància del genèric 'Fixed_IO' (coma-fixa) per al tipus específic
 type Kilo_Octet is delta 2.0**10 ;
 package Kilo_Octet_IO is new Ada.Text_IO.Fixed_IO (Kilo_Octet) ;

 -- instància del genèric 'Enumeration_IO' per al tipus específic
 type Discret is (OPCIO_A, OPCIO_B) ;
 package Discret_IO is new Ada.Text_IO.Enumeration_IO (Discret) ;

 -- instància del genèric 'Modular_IO' per al tipus específic
 type Byte is mod 2**8 ;
 package Byte_IO is new Ada.Text_IO.Modular_IO (Byte) ;

Atributs

• atributs dels tipus, després d'un apòstrof com el genitiu de l'idioma anglès (per ex.: John's car)

-- lectura
 Positive'First -- el primer del tipus

-- escriptura
 for Tipus'Atribut use ValorNouDeLAtribut -- modificació d'atributs actualitzables

Constructor del tipus i conversions

-- constructor i components especificant '(x ,..) l'atribut per defecte: el constructor 
 K: Positive := Positive'(10) 

-- conversió amb NomDelTipus(expressió)
 Percentatge(Valor/100.0)

Tipus derivats i subtipus

• tipus derivats: amb new el compilador els discrimina
• categories: subtipus (acceptats en paràmetres del tipus)

 type Poma is new Recompte range 0 .. 100

 subtype OuDeLaDotzena is OuDelGalliner range 0 .. 12

Registres i punters

• registres

 type Registre is record
 A, B : Boolean;
 Mida : Positive;
 end record;
 VarR : Registre := (A => False, B => True, Mida => 10) ;

• punters (amb access)

 -- Amb ''access''/''access constant'' només poden apuntar dins el propi dipòsit de dades (''storage pool'')
 type PunterARegistre is [not_null] access Registre -- accés RW (només pot apuntar dins el dipòsit de dades del tipus)
 type PunterARegistre is [not_null] access constant Registre -- accés RO

 -- Amb ''access all'' els punters no tenen restriccions d'apuntament.
 type PunterARegistre is [not_null] access all Registre -- accés RW (all: sense restricció de dipòsit d'apuntament)

• Per assignar un nou valor a l'objecte apuntat cal desreferenciar el punter amb .all (equival en C a prefixar un punter amb l'asterisc: * punter)

 punterARegistreTal.all := (A => False, B => True, Mida => 10) ;

• limited: per al cas d'estructures amb punters, prohibeix les operacions d'assignació (:=) i comparació (=) que ho fan bit a bit (superficials). (Per exemple, la comparació estructural de nodes encadenats no estaria garantida amb (=) doncs només compara bit-a-bit les primeres cel·les)

 type Tupla is record -- no limitat, admet assignació (:=) i comparació bit a bit (=) del registre
 A, B : Boolean;
 end record; 

 type Llista is limited record -- limitat, assignació (:=) i comparació bit a bit (=) prohibides
 -- la comparació estructural, quan hi ha punters, no es pot basar 
 -- en la igualtat bit a bit de la primera cel·la.
 Cap: Integer ;
 Cua: access constant Llista -- PunterALlista 
 end record ;

Vectors, Tipus paramètrics, Variants

• vectors

 type VectorDeSencers is array (1 .. 10) of Integer
 -- exemple d'ús amb inicialització 
 -- (el d'índex 1 => 15, el segon 16, altres => valor_per_defecte)
 VA: VectorDeSencers := (1 => 15, 2 => 16, others => 0)

• tipus indexats (dependents de valors)

 type BUFFER(MIDA : BUFFER_SIZE := 100) is 
 record
 Posicio : BUFFER_SIZE := 0;
 Valor : STRING(1 .. MIDA);
 end record;

• registres variants (per codificar tipus de dades algebraic anomenats també tipus suma)

 type TIP_ARBRE is (FULLA, BRANCA) ;

 type ARBRE_DE_SENCERS(Constructor: TIP_ARBRE) is record -- registre variant
 case Constructor is
 when FULLA => dadaFulla: Integer ;
 when BRANCA => dadaNus: Integer ;
 esquerre,dreta: access ARBRE_DE_SENCERS; -- punters a arbres
 end case ;
 end record ;

Genèrics - Parametrització de tipus en mòduls, procediments i funcions

• Cal precedir l'element a parametritzar amb la clàusula generic seguida dels paràmetres de tipus.
• Tipus formals: paràmetres formals de tipus en un genèric.

Vegeu exemple #Composició. Mòduls genèrics i Functors.

 generic
 type Item is private; -- paràmetre de tipus opac 
 type Poma is range <>; -- paràmetre de tipus enter, <>: abstracte en el rang 
 type Mass is digits <>; -- paràmetre de tipus coma flotant, <>: abstracte en la precisió 
 type Angle is delta <>; -- paràmetre de tipus coma fixa binari, <>: abstracte en la resolució (valor mínim)
 type Esdeveniment is (<>); -- paràmetre de tipus enumerable (pels parèntesis) <>: abstracte en els valors

 type Buffer(Length : Natural) is limited private; -- paràmetre de tipus indexat 
 -- (limited: assig. i comparació superficials prohibides (quan hi ha punters)) (private: opac)


 type Table is array (Esdeveniment) of Item; -- paràmetre de tipus vector amb tipus d'elements i d'índex declarats prèviament

Depuració, Assercions i Contractes

Assercions

Des de l'Ada2005.

pragma Assert([Check =>] boolean_expression[, [Message =>] string_expression]);

havent afegit la següent pragma de configuració a l'inici del fitxer o al fitxer de configuració del projecte gnat.adc

pragma Assertion_Policy(Check) ;

Precondicions i Postcondicions

Des de l'Ada2012.

generic
 type Elem is private;

package Piles is
 type Pila is private;

 function Es_Buit(S: Pila) return Boolean;
 function Es_Ple(S: Pila) return Boolean;

 procedure Apila(S: in out Pila; X: in Elem)
 with
 Pre => not Es_Ple(S),
 Post => not Es_Buit(S);

 procedure Desapila(S: in out Pila; X: out Elem)
 with
 Pre => not Es_Buit(S),
 Post => not Es_Ple(S);
private
 ...
end Stacks;

API estàndard i predefinits

• API biblioteca estàndard.
• Atributs dels tipus estàndard.
• Elements predefinits (mòdul Ada.Standard)

Gestió de memòria

Ada permet a l'usuari un control fi de la gestió de memòria així com definir els seus propis gestors.

Tipus de gestors

Gestors d'allotjament de mem. dinàmica (Storage_Pool) assignables a diferents tipus de dades

Munt d'allotjament (ang: heap) principal de vida il·limitada

Amb el tipus de gestor Unbounded_No_Reclaim de System.Pool_Global

Segons la ref. el recol·lector de brossa no hi passa. Al codi, però no a l'estàndard, hi diu: Allotjament per defecte dels tipus de punters declarats globalment. GNAT de GNU permet associar-hi un recol·lector de brossa recompilant GCC amb --enable-objc-gc incorporant la biblio. libobjc-gc.a si l'arquitectura la suporta.

Munt d'allotjament amb vida associada a un àmbit

Amb el tipus de gestor Unbounded_Reclaim_Pool de System.Pool_Local.

Quan l'execució surt de l'àmbit on el munt (Storage Pool) està definit, se'n reclama la memòria. Al codi, però no a l'estàndard, hi diu: Allotjament per defecte dels tipus de punters declarats localment. Sembla que era una pràctica en alguns compiladors de l'Ada83. AdaCore parla d'associació explícita. Vegeu exemple #Allotjament dinàmic i Memòria d'àmbit.

 Local_Pool: System.Pool_Local.Unbounded_Reclaim_Pool; -- munt reclamat en sortir de l'àmbit

 for Punter_A_T'Storage_Pool use Local_Pool ;

 -- en sortir de l'àmbit, el Local_Pool queda inaccessible
 -- i se n'executa automàticament el mètode ''Finalize'' que n'allibera la memòria.

Munt d'allotjament a la pila

Amb tipus de gestor Stack_Bounded_Pool de System.Pool_Size, per reservar memòria dinàmica a la pila de manera acotada.

Allotja elements d'un únic tipus. El manual de AdaCore diu que aquest mòdul no està pensat per un ús directe per l'usuari, i que és el que es fa servir automàticament quan s'especifica el nombre d'elements per al tipus de punter.

 for Punter_A_T'Storage_Size use 10_000; -- reserva un Stack_Bounded_Pool per a 10000 elems. del tipus

Tipus de punters

• Punters (clàusula access) restringits a apuntar només a elements de l'Storage_Pool associat al seu tipus.

type Punter_A_Sencer is access Integer ;
for Punter_A_Sencer'Storage_Pool use Nom_del_Pool; -- assignació de Storage_Pool específic a un tipus

• Punters no restringits (clàusula: access all): permet apuntar a elements de qualsevol Storage_Pool
• Punters amb accés de només lectura (clàusula: access constant)

aliased

Qualificador per indicar que un element d'una estructura pot ser accedit per punter i evitar que l'optimitzador del compilador l'empaqueti.

Registres amb membres punters i restricció de còpia/comparació superficials

• Les operacions d'assignació (:=) i comparació (=) són superficials (bit a bit), no tenen en compte si el registre conté punters.

• Es pot retornar un registre (tipus compost) com a resultat d'una funció.

• El qualificador limited: prohibeix assignacions i comparacions superficials (bit a bit) per a tipus que designin estructures de més profunditat (per quan hi ha punters, per ex. llistes encadenades).

Allotjament i desallotjament de dades referides per punters

new

allotjament amb new Punter_A_Tipus,

Unchecked_Deallocation

alliberament amb Unchecked_Deallocation similar al Free() del C/C++ Vegeu exemple #Allotjament dinàmic i Memòria d'àmbit

Directives de compilació (Pragma) relacionades amb la memòria

Pragma Controlled

Pragma per evitar que el recol·lector de memòria brossa (si l'habilitem), gestioni un determinat tipus

Volatile

Pragma per indicar que un element de memòria pot ser modificat externament i cal llegir-lo a memòria cada vegada evitant optimitzacions.

Atomic

Pragma per forçar la lectura i escriptura de manera atòmica (no interrompible i respectant l'ordre a les CPU's de procés especulatiu(ang: out-of-order CPU))

Orientació a objectes

• Classes d'objectes formades per
• # un tipus tagged (etiquetat), descrit a la implementació com a registre amb els camps de l'objecte.
• # procediments i funcions de la instància quan el primer paràmetre és la instància del tipus definit.
• # procediments i funcions estàtiques (de la classe) quan no duen la instància com a primer paràmetre.
• Els procediments i funcions a nivell de paquet són heretables (virtuals).
• Per definir generadors i altres funcions com a no-heretables cal fer-ho en un submòdul.

package Persona is
 type Objecte is tagged -- ''etiquetat'' (defineix el tipus com a constitutiu de classe)
 private ; -- private: definició opaca dels camps

 procedure MètodeDeLaInstància (This : Objecte); -- la instància és el primer paràmetre

 procedure MètodeEstàtic (Param: Integer); -- no duu la instància com a primer paràmetre

 function To_String(This: Objecte) return String; -- per a l'exemple a ''herència''

 -- submòdul 
 package Eines is
 -- Generadors i Funcions que no volem que s'heretin han d'estar en un submòdul.
 function Nou_Persona (...) return Objecte ;
 end Eines ;
private
 type Objecte is tagged record -- camps de dades del tipus de la classe
 Nom : String (1 .. 10);
 Gènere : Tipus_Gènere;
 end record;
end Persona;

Vegeu exemple.

herència

• qualificatiu overriding per redefinir un procediment o funció
• per referir-se al mètode homònim de la classe base, cal caracteritzar la instància amb el tipus del pare, mitjançant una conversió de tipus: Tipus_del_pare(This).

with Persona;

package Programador is
 type Objecte is new Persona.Objecte -- nou tipus ''Objecte'' derivat de Persona.Objecte
 with private; -- opac, definit a l'àrea privada

 overriding function To_String(This: Objecte) return String; 

 type Llenguatge is (LLENG_ADA, HASKELL, OCAML); -- ADA és paraula reservada

 package Eines is -- submòdul per a funcions no heretables

 function Nou_programador (pers: Persona.Objecte; esp: Llenguatge) return Objecte ;
 end Eines ;

private
 type Objecte is new Persona.Objecte with -- objecte derivat del tipus de la superclasse
 record -- ampliació del registre de camps 
 Especialitat : Llenguatge;
 end record;
end Programador;

-- implementació
with Ada.Text_IO ;
with Ada.Strings ;

package body Programador is

 package body Eines is
 function Nou_programador (pers: Persona.Objecte; esp: Llenguatge) return Objecte is
 begin
 return Objecte'(pers with Especialitat => esp); -- extensió de registre
 end ;
 end Eines ;

 package Llenguatge_IO is new Ada.Text_IO.Enumeration_IO (Llenguatge) ;

 function To_String(This: Objecte) return String is
 str_Esp: String (1..20) ;
 begin
 Llenguatge_IO.Put(To => str_Esp, Item => This.Especialitat) ;

 return (Persona.To_String(-- crida al mateix mètode, a la superclasse
 Persona.Objecte(This)) -- caracterització a la superclasse
 & "; Especialitat: " & str_Esp) ;
 end ;
 ...
end Programador ;

Constructors, Destructors i Clonadors

Per fer una gestió fina de la memòria cal que els tipus implementin les classes Controlled o bé Limited_Controlled, que proporcionen mètodes per intervenir en les ops. de lligar un objecte a una variable i en deslligar-lo.

Sobre aquestes classes abstractes s'hi pot implementar, si hom vol, un mecanisme d'alliberament per comptador de referències. Com a l'exemple més avall.

El mòdul Ada.Finalization incorpora les classes abstractes Controlled i Limited_Controlled que ofereixen mètodes cridats automàticament en inicialitzar, en assignar, i en sortir de l'àmbit les variables dels tipus de les classes que se'n derivin. Vegeu refs.

• Classe Controlled: amb mètodes abstractes Initialize, Adjust i Finalize (cridats respectivament de manera automàtica,

1. Initialize, cridat en la declaració de variables del tipus quan no s'inicialitzen.
2. Finalize, cridat en deslligar l'objecte de la variable, perquè, o bé se li ha assignat un altre valor a la variable, o bé la variable surt de l'àmbit.
3. Adjust, cridat en lligar un objecte a una variable en les assignacions, per quan hi ha punters, poder completar la clonació d'una estructura després de la còpia superficial (bit a bit) de la primera ceŀla que el compilador genera.

• Classe Limited_Controlled: Inclou Initialize, i Finalize però no Adjust.

• En els mètodes Adjust i Finalize s'hi pot implementar un comptador de referències com a l'exemple proposat.

Tipus definits per signatures (Interface)

Des de l'Ada2005.

package Imprimible is

 type Objecte is interface;

 procedure Imprimeix (This : Objecte) is abstract; -- is abstract => cal implementar-lo en classes derivades.
 procedure UnAltreMètode (This : Objecte) is null; -- is null => buit, no requereix implem. en classes derivades.

end Imprimible;

with Programador ;
with Imprimible ;

package ProgramadorAmbImprimible is

 type Objecte is new Programador.Objecte -- derivat de Programador.Objecte
 and Imprimible.Objecte -- i també de Imprimible.Objecte
 with private; 

 procedure Imprimeix (This : Objecte) ; -- redefineix el procediment virtual (abstracte a Imprimible)

private 
 -- declaració privada
end ProgramadorAmbImprimible ;

package body ProgramadorAmbImprimible is

 procedure Imprimeix (This : Objecte) is -- implementa Imprimible 
 begin
 ...
 end ;
end ProgramadorAmbImprimible ;

Concurrència

• Fils d'execució:
  • La clàusula task designa un fil d'execució que engega tot just en acabar d'inicialitzar la construcció que l'enclou. (exemple).
  • La seva definició inclourà els canals d'entrada (Entry) del fil d'execució.

• Exclusió mútua i espera condicionada (POSIX condition variables): La construcció Protected incorpora un monitor a l'estructura. (exemple)

• Transferència de control asíncrona: La clàusula select {esdeveniment} then-abort procediment pot incloure un procediment que es cancel·larà en el moment que s'esdevingui algun dels esdeveniments especificats al select.(exemple)

Compilació

• Compilació: compila l'arbre de paquets obtingut de les clàusules d'importació with Nom_Paquet;

gnatmake hola.adb

• Compilació separada:

gcc -c hola.adb
gnatbind hola # genera b~hola.ads i .adb que conté el ''package ada_main'' autogenerat de l'aplicació.
gnatlink hola

Fitxer de configuració del projecte

• El fitxer gnat.adc es pot establir per contenir Pragmes de Configuració del projecte del directori. El compilador cercarà el fitxer de configuració al directori de treball.

L'ordre d'inicialització dels mòduls

El mòdul autogenerat ada_main inclou els procediments d'inicialització adainit i de tancament adafinal. El procediment adainit executa la inicialització de cada mòdul en l'ordre deduït de les clàusules with i les pragmes Elaborate.

Vegeu ref.

• gnatbind: genera els fitxers .ads i .adb que conté el mòdul ada_main, amb nom de fitxer obtingut prefixant amb b~ el nom del mòdul principal.

L'ordre d'inicialització es pot alterar quan a un mòdul li convé que un altre s'inicialitzi abans, especificant-ho amb la pragma Elaborate o Elaborate_All.

 -- força la inicialització prèvia del mòdul_M i els mòduls que importi.
 -- alterant l'ordre d'exec. de les inicialitzacions al procés autogenerat ''adainit''
 Pragma Elaborate_All (mòdul_M)

Generació de biblioteques

En cas de voler generar una biblioteca en comptes d'un executable, caldrà fer un programa principal de pega que cridi a les rutines de la biblioteca i extreure'n del mòdul principal generat (ada_main) els processos d'inicialització i tancament adainit i adafinal que inclourem a les rutines d'inicialització i finalització de la biblioteca de relligat dinàmic (.dll o bé .so), nom_biblioinit i nom_bibliofinal.

JGNAT a la Màquina Virtual Java

AdaCore, mantenidor del compilador GNAT, disposa a la pàgina de descàrregues de codi obert d'una versió per a "jvm-windows" que també funciona sobre Linux mitjançant l'emulador Wine excepte pels caràcters no anglosaxons (la codif. de caràcters és Latin-1 a Windows i UTF-8 a GNU/Linux).

Compilació a GNU/Linux:

 wineconsole --backend=curses cmd
 jvm-gnatmake -gnat05 principal
 exit

Execució (a la consola Unix):

 export JGNAT_JAR=~/.wine/drive_c/GNAT/2010/lib/jgnat.jar
 java -cp .:$JGNAT_JAR principal

Exemples

Composició. Mòduls genèrics i Functors

• La biblio paramètrica en tipus i operacions (funció d'un tipus T i d'una op. formal Producte) :

-- fitxer la_meva_biblio.ads -- signatura

generic 
 type T is private; -- paràmetre de tipus (''private'': tipus opac)
 with function Producte (X, Y: T) return T; -- paràmetre funció
 -- el param. actual ha de coincidir en la signatura de la funció

package La_Meva_Biblio is

 function Quadrat (x:T) return T ;

end La_Meva_Biblio ;

-- fitxer la_meva_biblio.adb -- implementació

package body La_Meva_Biblio is

 -- implementa Quadrat basat en la funció Producte que és paràmetre del genèric
 function Quadrat (x:T) return T is
 begin
 return Producte (x, x) ;
 end quadrat ;

end La_Meva_Biblio ;

• Un Functor (mòdul amb un mòdul abstracte com a paràmetre formal). Transformarà instàncies que implementin La_Meva_Biblio.

-- fitxer el_meu_functor.ads -- signatura
with La_Meva_Biblio ;

generic 
 with package Biblio is new La_Meva_Biblio (<>); -- mòdul formal. cal que el mòdul paràmetre actual n'implementi la signatura
 -- en aquest cas, cal que sigui derivat de La_Meva_Biblio
 -- <>: indefinit en la parametrització (abstracte)

package El_meu_functor is

 use Biblio; -- incorpora l'espai de noms del mòdul formal

 function Cub(x: T) return T ;

 function Quadrat(x: T) return T renames Biblio.quadrat; -- publica una funció del mòdul formal

end El_meu_functor ;

-- fitxer el_meu_functor.adb -- implementació
package body El_Meu_Functor is

 function Cub (x:T) return T is
 begin
 return Producte (Quadrat(x), x) ;
 end ;

end El_Meu_Functor ;

• El principal:

-- fitxer principal.adb

-- paquets per relligar amb el ''linker''
with La_Meva_Biblio ;
with El_Meu_Functor ;
with Ada.Text_IO; 

procedure Principal is
 -- nom curt per al mòdul
 package TextIO renames Ada.Text_IO ;

 -- instanciem mòduls genèrics per a l'entrada/sortida dels tipus primitius per als tipus concrets

 package IntIO is new Ada.Text_IO.Integer_IO (Integer); -- Integer_IO per a precisió Integer
 package LFloatIO is new Ada.Text_IO.Float_IO (Long_Float) ; -- Float_IO per a precisió Long_Float
 package BoolIO is new Ada.Text_IO.Enumeration_IO (Boolean) ; -- Enumeration_IO per al cas Boolean

 -- instanciem biblioteques

 package La_Meva_Biblio_sobre_Sencers is new La_Meva_Biblio(T => Integer, Producte => "*") ;
 package La_Meva_Biblio_sobre_Reals is new La_Meva_Biblio(T => Long_Float, Producte => "*") ;

 package El_Meu_Functor_sobre_Sencers is new El_Meu_Functor(La_Meva_Biblio_sobre_Sencers) ;
 package El_Meu_Functor_sobre_Reals is new El_Meu_Functor(La_Meva_Biblio_sobre_Reals) ;

 -- declaració variables

 i : constant Integer := 2 ;
 j,k : Integer ;
 x : constant Long_Float := 2.0 ;
 y,z : Long_Float ;

 comprovacio: Boolean ;

begin
 j := La_Meva_Biblio_sobre_Sencers.Quadrat(i) ;
 y := La_Meva_Biblio_sobre_Reals.Quadrat(x) ;

 k := El_Meu_Functor_sobre_Sencers.Cub(i) ;
 z := El_Meu_Functor_sobre_Reals.Cub(x) ;

 TextIO.Put("Quadrat i Cub de 2 Integer, i comprovació:");
 IntIO.Put(j, Width => 4); -- format: %4d
 IntIO.Put(k, 4) ;

 comprovacio := j = El_Meu_Functor_sobre_Sencers.Quadrat(i) ;

 TextIO.Put(" ") ;
 BoolIO.Put(comprovacio) ;

 TextIO.New_Line(Spacing => 2); -- spacing: nombre de salts de línia

 TextIO.Put("Quadrat i Cub de 2.0 Long_Float, i comprovació:");
 LFloatIO.Put(y, Fore => 3, Aft => 2, Exp => 0); -- format: %3.2f; Exp (dígits exponent)
 LFloatIO.Put(z, 3, 2, 0) ;

 comprovacio := y = El_Meu_Functor_sobre_Reals.Quadrat(x) ;

 TextIO.Put(" ") ;
 BoolIO.Put(comprovacio) ;

 TextIO.New_Line; 

end Principal;

Compila i executa:

 gnatmake principal.adb
 ./principal

dona el resultat:

Quadrat i Cub de 2 Integer, i comprovació: 4 8 TRUE

Quadrat i Cub de 2.0 Long_Float, i comprovació: 4.00 8.00 TRUE

Composició en O.O. - Parametritzant per tipus d'objecte

Parametritzant per tipus d'objecte amb requeriments de superclasse i interfaces

• Les constants de configuració de l'aplicació

-- fitxer definicions.ads
package Definicions is
 TITOL_APLICACIO : constant String := "Títol_aplicació" ;
end Definicions ;

• L'interface :

-- fitxer imprimible.ads -- només signatura
package Imprimible is

 type Objecte is interface ;

 procedure Imprimeix(obj: Objecte) is abstract; -- is abstract => cal redefinir-lo en la classe derivada
 -- procedure Imprimeix(obj: Objecte) is null; -- is null => no implementat, no és obligat redefinir-lo

end Imprimible ;

• La biblio paramètrica en un tipus descendent d'un tipus d'objecte i amb requeriment d'interface

-- fitxer la_meva_biblio.ads -- signatura
with Persona ;
with Imprimible ;

generic 
 type T is new Persona.Objecte and Imprimible.Objecte with private; -- tipus formal 
 -- (cal que sigui derivat de Persona.Objecte 
 -- i que implementi Imprimible.Objecte)

package La_Meva_Biblio is

 procedure ImprimeixISaltaLinia (obj:T) ;

end La_Meva_Biblio ;

-- fitxer la_meva_biblio.adb -- implementació
with Ada.Text_IO ;
with Ada.Text_IO.Bounded_IO ;

with Ada.Strings ;
with Ada.Strings.Bounded;

package body La_Meva_Biblio is

 MAX_BUF : constant Integer := 20 ;
 package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;
 package SB_Buf_IO is new Ada.Text_IO.Bounded_IO(SB_Buf) ;

 package TextIO renames Ada.Text_IO ;

 títol: SB_Buf.Bounded_String ;

 procedure ImprimeixISaltaLinia (obj:T) is
 begin
 SB_Buf_IO.Put (títol) ;
 Imprimeix (obj) ;
 TextIO.New_Line(Spacing => 1) ;

 end ImprimeixISaltaLinia ;

begin -- inicialització de mòdul
 -- útil per inicialitzacions que depenen d'un altre mòdul

 títol := SB_Buf.To_Bounded_String(Definicions.TITOL_APLICACIO & ": ") ;

end La_Meva_Biblio ;

• La classe arrel Persona (incorpora un constructor i un mètode Put_To_String(obj))

-- fitxer persona.ads -- signatura
with Ada.Strings.Bounded; -- cadenes de text acotades

package Persona is

 type Objecte is tagged private; -- ''tagged'': objectes, ''private'': opac, definit a l'àrea privada

 function Put_To_String(obj: Objecte) return String ;

 package Eines is -- mòdul niuat per a les funcions que no volem virtuals (heretables)

 function Nou_Persona(nom: String; edat: Integer) return Objecte ;
 end Eines ;

 MAX_NOM : constant integer := 16 ;
 package SB_Nom is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_NOM) ;

private 
 type Objecte is tagged record
 Nom: SB_Nom.Bounded_String ;
 Edat: Integer ;
 end record ;

end Persona;

-- fitxer persona.adb -- implementació
with Ada.Text_IO ;
with Ada.Strings ;
with Ada.Strings.Fixed ;
with Ada.Strings.Bounded ;

package body Persona is

 package IntIO is new Ada.Text_IO.Integer_IO (Integer) ;

 package body Eines is -- mòdul niuat per les funcions que no volem virtuals (heretables)

 function Nou_Persona(nom: String; edat: Integer) return Objecte is
 begin
 return Persona.Objecte'(Nom => Persona.SB_Nom.To_Bounded_String(nom)
			, Edat => edat
			) ;
 exception
 when E: Ada.Strings.Length_Error =>
 Ada.Text_IO.Put("error: nom massa llarg, màxim: ") ;
 IntIO.Put(MAX_NOM) ;
 Ada.Text_IO.New_Line(1) ;
 raise ;

 end Nou_Persona ;
 end Eines ;

-----------------------
 function Put_To_String(obj: Objecte) return String is

 MAX_BUF : constant Integer := 40 ;
 package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;

 sb_buf1: SB_Buf.Bounded_String ;
 buf2: String (1 .. 10) ;

 use SB_Buf; -- incorpora espai de noms
 use Ada.Strings ;

 begin
 sb_buf1 := To_Bounded_String(SB_Nom.To_String(obj.nom)) ;

 IntIO.Put (To => buf2, Item => obj.edat) ;

 return To_String(sb_buf1 & " " & Fixed.Trim(buf2, Left)) ;
 end Put_To_String ;

end Persona;

• La classe derivada Programador: implementa l'interface i, a banda, incorpora un constructor i sobrescriu el mètode Put_To_String(obj).

-- fitxer programador.ads -- signatura
with Persona ;
with Imprimible ;

package Programador is

 type Objecte is new Persona.Objecte -- deriva de Persona.Objecte 
 and Imprimible.Objecte -- i també de Imprimible.Objecte
 with private; -- extensió de camps opaca (a l'àrea privada)

 overriding function Put_To_String(obj: Objecte) return String; -- sobrescriu mètode de la superclasse

 procedure Imprimeix (obj: Objecte) ;

 type Llenguatge is (LLENG_ADA, HASKELL, OCAML, SCALA); -- LLENG_ADA doncs ADA és nom reservat

 package Eines is -- mòdul niuat per les funcions que no volem virtuals (heretables)

 function Nou_Programador(nom: String; edat: Integer; especialitat: Llenguatge) 
		 return Objecte ;
 end Eines ;

private

 type Objecte is new Persona.Objecte and Imprimible.Objecte with record -- extensió de registre de camps

 Especialitat: Llenguatge ;
 end record; 

end Programador;

-- fitxer programador.adb -- implementació
with Ada.Text_IO ;
with Ada.Strings ;
with Ada.Strings.Bounded ;

package body Programador is

 package body Eines is -- mòdul niuat per les funcions que no volem virtuals (heretables)

 function Nou_Programador(nom: String; edat: Integer; especialitat: Llenguatge) 
		 return Objecte is
 begin
 return Objecte'(Persona.Eines.Nou_Persona(nom, edat) with Especialitat => especialitat) ;
 end Nou_Programador ;
 end Eines ;

------------
 function Put_To_String(obj: Objecte) return String is

 package Llenguatge_IO is new Ada.Text_IO.Enumeration_IO(Llenguatge) ;

 MAX_BUF : constant Integer := 60 ;
 package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;

 sb_buf1: SB_Buf.Bounded_String ;
 buf2: String (1 .. 12) ;

 use SB_Buf; -- incorpora espai de noms

 begin
 sb_buf1 := To_Bounded_String(
 Persona.Put_To_String(-- crida al mètode homònim de la superclasse
 Persona.Objecte(obj) -- cal fer un ''up-cast'' (caracterització) de l'objecte 
 -- al supertipus corresp. al mètode
)) ;

 Llenguatge_IO.Put(buf2, obj.especialitat) ;

 return To_String(sb_buf1 & " " & buf2) ;
 end Put_To_String ;

------------
 procedure Imprimeix (obj: Objecte) is

 package TextIO renames Ada.Text_IO ;

 begin
 TextIO.Put ("Programador: ") ;
 TextIO.Put (Put_To_String(obj)) ;
 end Imprimeix ;

end Programador;

• Principal:

-- fitxer principal.adb
with La_Meva_Biblio ;
with Programador ;

procedure Principal is

 package La_Meva_Biblio_ProgImp is new La_Meva_Biblio(T => Programador.Objecte) ;

 obj : Programador.Objecte ;

 use Programador; -- incorpora espai de noms del mòdul
 use La_Meva_Biblio_ProgImp ;

begin
 obj := Eines.Nou_Programador("Gabriel", 59, Especialitat => HASKELL) ;

 ImprimeixISaltaLinia(obj) ;
end Principal;

Compila i executa:

 gnatmake principal.adb
 ./principal

Comunicació síncrona (rendez-vous)

Vegeu ref.

task: fil d'execució (ang: ''thread'')

entry: canal d'entrada (bústia de comunicació amb cua de missatges)

(when condició => accept canal) : entrada del canal amb guarda (procés condicionat)

Activació de tasques

-- fitxer prova.adb
with Ada.Strings ;
with Ada.Strings.Fixed ;
with Ada.Strings.Bounded ;

with Ada.Text_IO ;
with Ada.Text_IO.Bounded_IO ;

procedure Prova is
 package TextIO renames Ada.Text_IO ;

 str1 : String := "abcdefghi" ;
 MAX_BUF : constant Integer := str1'Last ;

 package SB_Buf is new Ada.Strings.Bounded.Generic_Bounded_Length (MAX_BUF) ;
 package SB_Buf_IO is new Ada.Text_IO.Bounded_IO(SB_Buf) ;

 sb_buf2 : SB_Buf.Bounded_String ;

 type T_ESTAT is range 1..(MAX_BUF +1) ;

 task Automata is -- task és fil d'execució (''thread'')
 entry Llegeix(ch: in Character); -- canal d'entrada
 entry Imprimeix; -- canal d'entrada
 end Automata ;

 task body Automata is -- l'activació s'inicia en completar la inicialització de l'objecte que l'enclou

 Estat: T_ESTAT := T_ESTAT'First ;
 -- use SB_Buf ;
 begin
 loop
 select
	when Estat < T_ESTAT'Last =>
		accept Llegeix(ch: in Character) do

 SB_Buf.Append(sb_buf2, ch) ;
 TextIO.Put(ch); -- fem l'eco 
		end Llegeix ;
		Estat := Estat +1 ;
 or
 when Estat = T_ESTAT'Last =>
	 accept Imprimeix do

 TextIO.New_Line ;
		SB_Buf_IO.Put(sb_buf2) ;
	 end Imprimeix ;
 or 
 terminate; -- acaba quan hi ha una opció ''terminate'' oberta
 -- i no hi ha entrades pendents 
 -- i totes les tasques (fils d'execució) estan igual 
 -- i el procés principal enllesteix.

 -- o bé, en comptes d'acabar, especificar un lapse de temps i les accions a prendre

 delay 1.0; TextIO.New_Line -- termini i accions subseqüents al venciment

 end select ;
 end loop ;

 end Automata ;
begin
 for i in str1'Range loop

 Automata.Llegeix(str1(i)) ;
 delay 0.2 ;

 end loop ;
 Automata.Imprimeix ;

end prova ;

gnatmake prova.adb
./prova

Transferència de control asíncrona

Càlculs abortables per venciment de terminis o altres esdeveniments esmentats a la clàusula select. Detalls a la documentació.

select
 -- ''delay or triggering statement''
 delay 5.0;
 Put_Line("El càlcul no convergeix");
then abort
 -- Aquest càlcul està limitat en temps pel termini prèviament esmentat
 Càlcul_que_pot_excedir_el_temps_tolerable(X, Y) ;
end select;

protected - Exclusió mútua i accés condicionat

La construcció protected aporta coherència al manteniment d'estructures compartides per diferents fils d'execució.

Aporta un monitor a l'estructura per garantir l'exclusió mútua dels fils d'execució que executin els membres exportats de l'estructura.

Les clàusules Entry permeten condicionar el desblocatge d'execució (monitor) a una condició expressada en la clàusula when.

-- fitxer prova.adb -- procés cua d'esdeveniments

with Ada.Text_IO ;
with Ada.Containers.Doubly_Linked_Lists ;

procedure Prova is

 package TextIO renames Ada.Text_IO ;

 type TEsdeveniment is (SUCCES_A, SUCCES_B, FINAL) ;

 package TEsdeveniment_IO is new Ada.Text_IO.Enumeration_IO (TEsdeveniment) ;

 package Cua_Esdev is new Ada.Containers.Doubly_Linked_Lists (TEsdeveniment); -- cua de dos caps, il·limitada

----------------

 protected Cua_Protegida is

 procedure Afegir(Esdev: TEsdeveniment); -- procedure (no bloca) (cua és il·limitada) 
 entry Retirar_Primer(Esdev: out TEsdeveniment); -- entry (pot blocar) (Retirar_Primer requereix cua no buida)
 private
 Cua: Cua_Esdev.List ;
 end Cua_Protegida; 

 protected body Cua_Protegida is

 procedure Afegir(Esdev: TEsdeveniment) is
 begin
 Cua_Esdev.Append(Cua, Esdev) ;
 end Afegir;

 entry Retirar_Primer (Esdev: out TEsdeveniment) -- canal d'entrada 
 when not Cua_Esdev.Is_Empty(Cua) is -- requeriment d'accés
 begin
 Esdev := Cua_Esdev.First_Element(Cua) ;
 Cua_Esdev.Delete_First(Cua) ;
 end Retirar_Primer;

 end Cua_Protegida ;

----------------

 task Processa_Esdeveniments; -- no exporta res

 task body Processa_Esdeveniments is
 Es_Final: Boolean := False ;
 begin
 while not Es_Final loop
 declare
 Esdev: TEsdeveniment ;
 begin

 Cua_Protegida.Retirar_Primer(Esdev) ;

 TEsdeveniment_IO.Put(Esdev) ;
 TextIO.New_Line ;

 Es_Final := Esdev = FINAL ;
 end ;
 end loop ;
 end Processa_Esdeveniments ;

begin
 Cua_Protegida.Afegir (SUCCES_A) ;
 Cua_Protegida.Afegir (SUCCES_B) ;
 delay 1.0 ;

 Cua_Protegida.Afegir (FINAL) ;
end Prova ;

gnatmake prova.adb
./prova

Allotjament dinàmic i Memòria d'àmbit

Vegeu #Gestió de memòria

-- fitxer prova_mem.ads

package Prova_Mem is
 procedure Prova ;
end Prova_Mem ;

-- fitxer prova_mem.adb

with Ada.Text_IO ;
with Ada.Unchecked_Deallocation ;
with System.Pool_Local ;
with Ada.Exceptions ;

package body Prova_Mem is

 package Except renames Ada.Exceptions ;

 package Txt_IO renames Ada.Text_IO ;
 package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;
 package Boolean_IO is new Ada.Text_IO.Enumeration_IO (Boolean) ;

 procedure Prova is

 type Tipus is array (1..1000) of Integer;
 type Ptr_A_Tipus is access Tipus;

 Local_Pool : System.Pool_Local.Unbounded_Reclaim_Pool; -- memòria d'àmbit.
 for Ptr_A_Tipus'Storage_Pool use Local_Pool ;

 procedure Free_Ptr_A_Tipus is new Ada.Unchecked_Deallocation (Tipus, Ptr_A_Tipus);

 subtype Ptr_No_Nul_A_Tipus is not null Ptr_A_Tipus ;

 A : Ptr_A_Tipus;

 procedure Allotja is
 begin
	A := new Tipus'(others=>10); -- allotja i inicialitza
 end Allotja;

 procedure DesAllotja is
 begin
	Free_Ptr_A_Tipus (A);
 end DesAllotja;

 procedure Comprova_Nul (B: Ptr_A_Tipus) is
 begin

 Txt_IO.Put ("Que és nul el punter? ") ;
 Boolean_IO.Put (B = null) ;
 Txt_IO.New_Line ;
 end Comprova_Nul ;

 procedure Imprimeix_Elem (B: Ptr_No_Nul_A_Tipus) is -- restringit pel subtipus, dispara exc. Constraint_Error
 -- procedure Imprimeix_Elem (B: not null access Tipus) is -- alternativa
 vec: Tipus ;
 begin
 vec := B.all ;
 Txt_IO.Put ("El primer elem. és") ;
 Int_IO.Put (vec(1), Width => 4) ;
 Txt_IO.New_Line; 
 end Imprimeix_Elem ;

 begin

 Allotja ;

 A.all := (others => 20) ;

 Comprova_Nul(A) ;

 Imprimeix_Elem(A) ;

 Allotja ;
 DesAllotja; -- A queda ''null''

 Comprova_Nul(A) ;

 begin
 Imprimeix_Elem(A) ;

 exception
 when Constraint_Error => Txt_IO.Put_Line ("Restricció ''not null'' fallida: El punter era nul") ;

 when E: others => Txt_IO.Put_Line ("disparada: " & Except.Exception_Name (E));
 end ;

 Allotja ;
 end Prova; -- el Local_Pool queda fora d'àmbit i se'n reclama la memòria
end Prova_Mem ;

-- fitxer principal.adb

with Prova_Mem ;

procedure Principal is
begin
 Prova_Mem.Prova ;
end ;

gnatmake principal.adb
./principal

O.O. - Finalització controlada - Estructura amb component allotjat dinàmicament i comptador de referències

Classe d'objectes amb Finalització controlada, derivats de la classe abstracta Ada.Finalization.Controlled. Mètodes cridats automàticament:

• Initialize: cridat en les declaracions sense inicialització
• Finalize: cridat en deslligar l'objecte de la variable, perquè, o bé se li ha assignat un altre valor a la variable, o bé la variable surt de l'àmbit
• Adjust: cridat en lligar un objecte a una variable a les assignacions, després de la còpia superficial (bit a bit) de l'objecte, per si cal clonar els membres referits per punters o si cal portar un comptador de referències.

Vegeu #Constructors, Destructors i Clonadors.

-- fitxer controlat.ads
with Carrega ;
with Ada.Finalization; 

package Controlat is

 use Carrega ;

 type Objecte is new Ada.Finalization.Controlled with -- classe derivada de ''Ada.Finalization.Controlled''
 record
 Ptr_A_La_Meva_Carrega: Carrega.Ptr_A_Carrega := null ;
 end record;

private

 procedure Initialize(Obj: in out Objecte); -- constructor buit (cridat quan no hi ha inicialització en la declaració)
 procedure Adjust(Obj: in out Objecte); -- constructor de còpia (ajustatge després de còpia superficial)
 procedure Finalize (Obj: in out Objecte); -- cridat en sortir de l'àmbit o quan l'obj. es deslliga de la variable quan és modificada
end Controlat;

-- fitxer controlat.adb
with Ada.Text_IO; 

package body Controlat is

 package Txt_IO renames Ada.Text_IO ;
 package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;

 procedure Initialize(Obj: in out Objecte) is -- constructor buit 
 begin
 Txt_IO.Put("Initialize:"); 

 Obj.Ptr_A_La_Meva_Carrega := Carrega.Nova_Carrega (Id => 1); 
 Txt_IO.New_Line ;
 end;

 procedure Adjust(Obj: in out Objecte) is -- constructor de còpia (ajustatge després de còpia superficial bit a bit)
 begin
 Txt_IO.Put("Adjust :"); 

 Carrega.Incr_Refs(Obj.Ptr_A_La_Meva_Carrega) ;
 Txt_IO.New_Line ;
 end;

 procedure Finalize (Obj: in out Objecte) is -- en sortir de l'àmbit o en ésser deslligat de la ref.
 refs: Natural ;
 begin
 Txt_IO.Put("Finalize :"); 
 if not Carrega.Es_Nul (Obj.Ptr_A_La_Meva_Carrega) then 

 Carrega.Decr_Refs(Obj.Ptr_A_La_Meva_Carrega, refs) ;

 if refs = 0 then
	Carrega.Allibera_Carrega (Obj.Ptr_A_La_Meva_Carrega) ;
	Txt_IO.Put("; Desallotjat") ;
 end if ;
 end if ;
 Txt_IO.New_Line ;
 end;
end Controlat;

• La càrrega

-- fitxer carrega.ads
with Ada.Unchecked_Deallocation; 

package Carrega is

 type Carrega is private ;

 type Ptr_A_Carrega is access Carrega ;

 function Nova_Carrega (Id: integer) return Ptr_A_Carrega ;
 function Es_Nul(ptr_carr: Ptr_A_Carrega) return Boolean ;

 procedure Incr_Refs (ptr_carr: in Ptr_A_Carrega) ;
 procedure Decr_Refs (ptr_carr: in Ptr_A_Carrega; refs: out Natural) ;

 procedure Allibera_Carrega (ptr_carr: in out Ptr_A_Carrega) ;

 private
 type Carrega is record 
 Id: Integer ;
 Num_Refs: Natural := 1 ;
 end record ;

 procedure Free_Carrega is new Ada.Unchecked_Deallocation (Carrega, Ptr_A_Carrega);

end Carrega;

-- fitxer carrega.adb
with Ada.Text_IO; 

package body Carrega is

 package Txt_IO renames Ada.Text_IO ;
 package Int_IO is new Ada.Text_IO.Integer_IO (Integer) ;

 function Nova_Carrega (Id: integer) return Ptr_A_Carrega is
 Ptr: Ptr_A_Carrega := null ;
 begin
 Ptr := new Carrega'(Id => Id, others => <>); -- ''<>'': valors per defecte

 Txt_IO.Put(" Càrrega Id.: "); Int_IO.Put(Id, 4) ;
 Txt_IO.Put(" Refs: "); Int_IO.Put(Ptr.all.Num_Refs, 4) ;
 Txt_IO.New_Line ;
 return Ptr ;
 end Nova_Carrega ;

 function Es_Nul(ptr_carr: Ptr_A_Carrega) return Boolean is
 begin
 return ptr_carr = null ;
 end ;

 procedure Incr_Refs (ptr_carr: in Ptr_A_Carrega) is
 begin
 ptr_carr.all.Num_Refs := ptr_carr.all.Num_Refs +1 ;

 Txt_IO.Put(" Càrrega Id.: "); Int_IO.Put(ptr_carr.all.Id, 4) ;
 Txt_IO.Put(" Refs: "); Int_IO.Put(ptr_carr.all.Num_Refs, 4) ;
 end ;

 procedure Decr_Refs (ptr_carr: in Ptr_A_Carrega; refs: out Natural) is
 begin
 if ptr_carr.all.Num_Refs > 0 then
 ptr_carr.all.Num_Refs := ptr_carr.all.Num_Refs -1 ;
 end if ;
 refs := ptr_carr.all.Num_Refs ;

 Txt_IO.Put(" Càrrega Id.: "); Int_IO.Put(ptr_carr.all.Id, 4) ;
 Txt_IO.Put(" Refs: "); Int_IO.Put(ptr_carr.all.Num_Refs, 4) ;

 end ;

 procedure Allibera_Carrega (ptr_carr: in out Ptr_A_Carrega) is
 begin
 Free_Carrega(ptr_carr) ;
 end ;

end Carrega;

• Provatura:

-- fitxer principal.adb
with Carrega ;
with Controlat ;
with Ada.Finalization; 
with Ada.Text_IO ;

procedure Principal is

 package Txt_IO renames Ada.Text_IO ;

 use Controlat ;
 obj1: Controlat.Objecte; -- Sense inicialitzar, ''Initialize'' s'executa

begin
 declare -- àmbit intern fet a posta per a l'exemple
 obj2: Controlat.Objecte := (Ada.Finalization.Controlled 
 with Ptr_A_La_Meva_Carrega => Carrega.Nova_Carrega (Id => 2)); -- ''Initialize'' no actúa
 obj3: Controlat.Objecte := (Ada.Finalization.Controlled 
 with Ptr_A_La_Meva_Carrega => Carrega.Nova_Carrega (Id => 3)); -- ''Initialize'' no actúa
 begin
 Txt_IO.New_Line; Txt_IO.Put_Line("-- obj2 := obj3 -- finalitza objecte de la var obj2; adjust objecte de la var obj3") ;
 obj2 := obj3; 

 Txt_IO.New_Line; 
 Txt_IO.Put_Line("-- sortida àmbit intern, variables obj2 i obj3 surten del seu àmbit") ;
 end; -- sortida de l'àmbit, 

 Txt_IO.New_Line; 
 Txt_IO.Put_Line("-- sortida àmbit extern, variable obj1 surt de l'àmbit") ;
end Principal;

Compila i executa:

gnatmake principal.adb
./principal

dona:

Initialize: Càrrega Id.: 1 Refs: 1

 Càrrega Id.: 2 Refs: 1
 Càrrega Id.: 3 Refs: 1

-- obj2 := obj3 -- finalitza objecte de la var obj2; adjust objecte de la var obj3
Finalize : Càrrega Id.: 2 Refs: 0; Desallotjat
Adjust : Càrrega Id.: 3 Refs: 2

-- sortida àmbit intern, variables obj2 i obj3 surten del seu àmbit
Finalize : Càrrega Id.: 3 Refs: 1
Finalize : Càrrega Id.: 3 Refs: 0; Desallotjat

-- sortida àmbit extern, variable obj1 surt de l'àmbit
Finalize : Càrrega Id.: 1 Refs: 0; Desallotjat

Vegeu també

• Perfil Ravenscar

Bibliografia

• Embedded.com - Programació d'aplicacions de temps-real amb Ada 2005 en anglès

Enllaços externs

A Wikimedia Commons hi ha contingut multimèdia relatiu a: Ada

• Estàndards sobre Ada en anglès Ada95, Ada2005, ..
• Univ. de Saragossa - Introduccción a Ada (castellà)
• Viquillibre - Programació en Ada en anglès
• Univ. Rovira i Virgili - Pascal i Ada (castellà)

Viccionari