Ada (llenguatge de programació)

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 s'usa 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 el monitor).

-- 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 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.

Tocs de Sintaxi

Bloc de codi:

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

Tipus

Vegeu refs.

• bàsics

  -- 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
  type Byte is mod 2**8      -- sense signe: rang definit per l'operació mòdul, anomenats ''modulars''.
 
  -- discrets (enumeració d'identificadors o de caràcters) predefinits: Boolean, Character
  type Hexa   is ('A', 'B', 'C', 'D', 'E', 'F');        
  type Boolean is (False, True) ;
 
  -- predefinits coma flotant: 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 (binaris i decimals quan s'especifica la precisió)
  type Kilo_Octet is delta 2.0**10               -- [[coma fixa]] binari, delta és el valor incremental
  type Durada is delta Resolució_rellotge
                          -- 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 Centims_DEuro is delta 0.01 digits 14     -- [[coma fixa]] decimal quan incorpora precisió en dígits,
                                              -- pels decimals la delta ha d'ésser obligatòriament potència de deu.

Si no s'especifica un tipus predefinit, es dedueix el tipus base per les restriccions:

només ''mod'' ⇒ aritmètica ''sense signe'', anomenats ''modulars''
només ''range'' ⇒ sencer amb restricció de rang
només ''digits'' ⇒ coma flotant
només ''delta'' ⇒ coma fixa binari
''delta'' i ''digits'' ⇒ coma fixa decimal

range <> -- <> : restricció indefinida concretada en un altre lloc (abstracte o per defecte o segons implementació)

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.

  package Long_Integer_IO is new Ada.Text_IO.Integer_IO (Long_Integer)
 
  package Long_Float_IO is new Ada.Text_IO.Float_IO (Long_Float)
 
  type Kilo_Octet is delta 2.0**10 ;
  package Kilo_Octet_IO is new Ada.Text_IO.Fixed_IO (Kilo_Octet) ;
 
  type Discret is (OPCIO_A, OPCIO_B) ;
  package Discret_IO is new Ada.Text_IO.Enumeration_IO (Discret) ;
 
  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)

 Positive'First

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

Conversions

• constructor tipus'(valor)

 K: Positive := Positive'(10)

• conversió NomDelTipus( expressió)

 Percentatge( Valor/100.0)

Tipus derivats i subtipus

• tipus derivats: amb new el compilador els discrimina

 type Poma is new Recompte range 0 .. 100

• categories: subtipus (acceptats en paràmetres del tipus)

 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)

  type PunterARegistre is [not_null] ''access'' Registre         -- punter accés-a-variable restringit-a
                                                                 --    -apuntar-al-propi-''storage-pool''
  type PunterARegistre is [not_null] ''access constant'' Registre      -- punter accés-només-de-lectura
  type PunterARegistre is [not_null] ''access all'' Registre           -- punter accés-a-variable

• punters desreferenciats amb .all (equival en C a prefixar amb asterisc: * punter)

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

• restricció limitat als tipus, prohibeix les operacions d'assignació (:=) i comparació (=) superficials (bit a bit) dels registres. En estructures encadenades (:=) i (=) tracten només la primera ceŀla.

  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, la comparació estructural no es pot basar 
                                     --      en la igualtat bit a bit de la primera cel·la. 
      Cap: Integer ;
      Cua: 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 (depenents de valors)

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

• tipus variants (tipus suma)

    type TIP_ARBRE is (FULLA, BRANCA) ;
 
    type ARBRE_DE_SENCERS( Tipus: TIP_ARBRE) is record     -- registre variant
          case Tipus 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;                              -- tipus formal més generalista (private: opac)
    type Buffer(Length : Natural) is limited private;  -- tipus indexat 
         -- (limited: assig. i comparació superficials prohibides (quan hi ha punters)) (private: opac)
 
    type Esdeveniment is (<>);          -- tipus formal enumerable (pels parèntesis) <>: abstracte en els valors
    type Poma  is range <>;                            -- sencer de rang indefinit
    type Angle is delta <>;                            -- coma fixa binari amb delta indefinida
    type Mass  is digits <>;                           -- coma flotant de precisió indefinida
 
    type Table is array (Esdeveniment) of Item;        -- vector formal amb tipus d'elements i d'índex mencionats com a formals

Orientació a objectes

• Classes (tipus tagged etiquetats, i empaquetament dels mètodes)

package Persona is
   type Objecte is tagged private;  -- private: definició opaca dels camps
   procedure Mètode (This : Objecte);  -- els mètodes de la instància duen la instància com a primer paràmetre.
   procedure MètodeEstàtic (Param: Integer) ;     -- mètode és estàtic o de la classe si no duu la instància com a paràmetre.
   function To_String( This: Objecte) return String ; -- per a l'exemple a ''herència'' 
   package Eines is
     -- Constructors 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

with Persona;
 
package Programador is
   type Objecte is new Persona.Objecte with private;  -- nou objecte derivat i 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 ;

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 and Imprimible.Objecte with private ;  
 
  procedure Imprimeix (This : Objecte) ;
 
private 
  -- declaració privada
end ProgramadorAmbImprimible ;
 
package body ProgramadorAmbImprimible is
 
  procedure Imprimeix (This : Objecte) is 
  begin
    ...
  end ;
end ProgramadorAmbImprimible ;

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 principal de vida iŀ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 el munt (Storage Pool) surt de l'àmbit, 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 ;  -- memòria d'à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;

Tipus de punters

• Punters (access) restringits a apuntar a elements del seu mateix Storage_Pool associat al seu tipus

type Punter_A_Sencer is access Integer ;

for Punter_A_Sencer'Storage_Pool use Pool_Name ;  -- assignació de Storage_Pool específic a un tipus

• Punters no restringits (access all)
• Punters amb accés de només lectura (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

• Assignació (i comparació) de variables de tipus compostos (ex. registres) amb còpia / comparació bit a bit. Es pot retornar un registre com a resultat d'una funció.

• Qualificador limited: prohibeix assignacions i comparacions superficials (bit a bit) per a tipus que designin estructures de més profunditat

Allotjament i desallotjament

new, Unchecked_Deallocation

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

Objectes amb vida lligada a l'àmbit - Constructors, Destructors i Clonadors

A banda del gestor Unbounded_Reclaim_Pool (Storage_Pool lligat a l'àmbit), es pot limitar la vida dels objectes a l'àmbit amb desallotjament individual controlat.

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 variables dels tipus de les classes que se'n derivin. Vegeu refs.

• • Tipus 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 (constructor buit).
2. Adjust, cridat automàticament en les assignacions, per completar la clonació d'una estructura després de la còpia superficial, bit a bit dels camps.
3. i Finalize, en sortir la variable de l'àmbit de visibilitat o bé en deslligar-se la variable en ésser-li assignat un altre valor).

• • Tipus limitat Limited_Controlled: Els tipus limitats prohibeixen la còpia i la comparació superficials d'objectes. Inclou Initialize, i Finalize però no Adjust.
  • És responsabilitat del programador decidir o no l'engegada del procés destructor de les subestructures dins el mètode Finalize (Quan als camps hi hagi còpies de punters caldrà portar un comptador de referències).

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

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

Pragma Controlled

Pragma per evitar que el recoŀ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))

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 una entrada de codi abortable que s'executa mentre no es doni cap dels esdeveniments especificats al select.(exemple)

L'ordre d'inicialització dels mòduls

Vegeu ref.

• gnatbind: genera el fitxer principal que conté el mòdul ada_main incloent els procediments adainit (que inicialitza els mòduls involucrats en l'ordre deduït de les Pragmes Elaborate) i adafinal.

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 cridat en la inicialització del mòdul actual
 Pragma Elaborate_All (mòdul_M) -- obté els mòduls de clàusules ''with'' recursivament
                                -- i en dedueix l'ordre d'inicialització

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 dinàmica, nom_biblioinit i nom_bibliofinal.

Compilació separada:

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

Gestió de projectes

• 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.

JGNAT A la JavaVM

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).

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 ;                           -- tipus formal generalista
    with function Producte (X, Y: T) return T ;   -- funció formal (paràmetre del genèric)  
                                                  --     el param. actual ha de coincidir en la signatura.
 
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
 
  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)

-- fitxer el_meu_functor.ads -- signatura
with La_Meva_Biblio ;
 
generic 
    with package Biblio is new La_Meva_Biblio (<>) ;   -- mòdul formal 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 ;
 
  -- derivem submòduls per imprimir tipus bàsics
  package IntIO is new Ada.Text_IO.Integer_IO (Integer);
  package LFloatIO is new Ada.Text_IO.Float_IO (Long_Float) ;
  package BoolIO is new Ada.Text_IO.Enumeration_IO (Boolean) ;
 
  -- derivem 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

dóna 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 ;
 
  titol: SB_Buf.Bounded_String ;
 
  procedure ImprimeixISaltaLinia (obj:T) is
  begin
    SB_Buf_IO.Put ( titol) ;
    Imprimeix (obj) ;
    TextIO.New_Line( Spacing => 1) ;
 
  end ImprimeixISaltaLinia ;
 
begin                                           -- inicialització de mòdul
                                                -- útil per inicialitzacions que depenen d'un altre mòdul
 
  titol := 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 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 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 (cua de missatges)

when condició => accept canal : entrada del canal amb guarda

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 a l'esgotament
 
      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. 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 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 entrades Entry permeten especificar cues de fils d'execució pendents d'una condició. (POSIX condition variables)

-- 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 Modul_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) (quan cua és buida)
  private
    Cua: Modul_Cua_Esdev.List ;
  end Cua_Protegida ;  
 
  protected body Cua_Protegida is
 
    procedure Afegir( Esdev: TEsdeveniment) is
    begin
      Modul_Cua_Esdev.Append( Cua, Esdev) ;
    end Afegir;
 
    entry Retirar_Primer (Esdev: out TEsdeveniment)    -- canal d'entrada 
           when not Modul_Cua_Esdev.Is_Empty( Cua) is        -- barrera que bloca si cua és buida
    begin
      Esdev := Modul_Cua_Esdev.First_Element( Cua) ;
      Modul_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(automatisme descrit) derivats de la classe abstracta Ada.Finalization.Controlled. Mètodes cridats automàticament:

• Initialize: cridat en les declaracions sense inicialització
• Finalize: cridat quan una var. surt de l'àmbit o se li assigna un altre valor passant com a param. la ref. que es deslliga.
• Adjust: cridat en les assignacions després de la còpia superficial, o bé del valor (bit a bit) o bé del punter, per si cal clonar els membres referits per punters o si cal portar un comptador de referències.

Vegeu #Objectes amb vida lligada a l'àmbit - 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 la ref. s'assigna a un altre obj.
 
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

dóna:

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

• 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à)