Patchwork [Ada] Controlled finalization for references in Ada 2012 containers

Feb. 17, 2012, 2:16 p.m.

This patch introduces controlled finalization in order to prevent any tampering
while referencing to an element in a container.

------------
-- Source --
------------

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

procedure Main is
   type Element is record
      Comp : Integer := 1234;
   end record;

   E : Element := Element'(Comp => 4);

   package DLL is new Ada.Containers.Doubly_Linked_Lists
     (Element_Type => Element,
      "="          => "=");

   Cont : DLL.List;
   Pos  : DLL.Cursor;

begin
   Put_Line ("TEST: Doubly Linked Lists");

   Cont.Append (Element'(Comp => 1));
   Cont.Append (Element'(Comp => 2));
   Cont.Append (Element'(Comp => 3));

   begin
      --  Explicit references

      Put_Line ("Explicit reference 1:");
      Pos := Cont.First;

      declare
         R : constant DLL.Reference_Type := Cont.Reference (Pos);
      begin
         Cont.Delete_Last;
         Put_Line ("ERROR: tamper with cursors not prevented");
      exception
         when Program_Error => Put_Line ("OK");
         when others => Put_Line ("ERROR: unexpected error raised while " &
                                  "tampering with cursors");
      end;

      declare
         R : constant DLL.Reference_Type := Cont.Reference (Pos);
      begin
         Cont.Replace_Element (Pos, E);
         Put_Line ("ERROR: tamper with elements not prevented");
      exception
         when Program_Error => Put_Line ("OK");
         when others => Put_Line ("ERROR: unexpected error raised while " &
                                  "tampering with elements");
      end;

      Put_Line ("Explicit reference 2:");

      declare
         R : constant DLL.Constant_Reference_Type :=
               Cont.Constant_Reference (Pos);
      begin
         Cont.Delete_Last;
         Put_Line ("ERROR: tamper with cursors not prevented");
      exception
         when Program_Error => Put_Line ("OK");
         when others => Put_Line ("ERROR: unexpected error raised while " &
                                     "tampering with cursors");
      end;

      declare
         R : constant DLL.Constant_Reference_Type :=
                 Cont.Constant_Reference (Pos);
      begin
         Cont.Replace_Element (Pos, E);
         Put_Line ("ERROR: tamper with elements not prevented");
      exception
         when Program_Error => Put_Line ("OK");
         when others => Put_Line ("ERROR: unexpected error raised while " &
                                     "tampering with elements");
      end;

      --  Implicit references

      Put_Line ("Implicit reference 1:");

      declare
         E : Element renames Cont (Pos);
      begin
         Cont.Delete_Last;
         Put_Line ("ERROR: tamper with cursors not prevented");
      exception
         when Program_Error => Put_Line ("OK");
         when others => Put_Line ("ERROR: unexpected error raised while " &
                                  "tampering with cursors");
      end;

      declare
         E : Element renames Cont (Pos);
      begin
         Cont.Replace_Element (Pos, E);
         Put_Line ("ERROR: tamper with elements not prevented");
      exception
         when Program_Error => Put_Line ("OK");
         when others => Put_Line ("ERROR: unexpected error raised while " &
                                  "tampering with elements");
      end;

      Put_Line ("Implicit reference 2:");

      declare
      begin
         for E of Cont loop
            begin
               Cont.Delete_Last;
               Put_Line ("ERROR: tamper with cursors not prevented");
            exception
               when Program_Error => Put_Line ("OK");
               when others => Put_Line ("ERROR: unexpected error raised " &
                                        "while tampering with cursors");
            end;
         end loop;
      end;

      declare
      begin
         for E of Cont loop
            begin
               Cont.Replace_Element (Pos, E);
               Put_Line ("ERROR: tamper with elements not prevented");
            exception
               when Program_Error => Put_Line ("OK");
               when others => Put_Line ("ERROR: unexpected error raised " &
                                        "while tampering with elements");
            end;
         end loop;
      end;

      Cont.Replace_Element (Pos, E);
      Cont.Delete (Pos);

   exception
      when others => Put_Line ("ERROR: raised after finalization");
   end;
end Main;

-----------------
-- Compilation --
-----------------

gnatmake -q -gnat12 main.adb

-----------------------------------
-- Execution and expected output --
-----------------------------------

$./main
$TEST: Doubly Linked Lists
$Explicit reference 1:
$OK
$OK
$Explicit reference 2:
$OK
$OK
$Implicit reference 1:
$OK
$OK
$Implicit reference 2:
$OK
$OK
$OK
$OK
$OK
$OK

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-02-17  Vincent Pucci  <pucci@adacore.com>

	* a-cdlili.adb, a-cidlli.adb, a-cihama.adb, a-cimutr.adb,
	* a-ciorma.adb, a-cohama.adb, a-coinve.adb, a-comutr.adb,
	* a-convec.adb, a-coorma.adb (Adjust): New routine.
	(Constant_Reference): Increment Busy and Lock counters.
	(Reference): Increase Busy and Lock counters.
	(Finalize): New routine.
	* a-cihase.adb, a-ciorse.adb, a-cohase.adb, a-coorse.adb:
	(Adjust): New routine.	(Constant_Reference): Increment Busy
	and Lock counters.
	(Finalize): New routine.
	* a-cdlili.ads, a-cidlli.ads, a-cihama.ads, a-cihase.ads,
	* a-cimutr.ads, a-ciorma.ads, a-ciorse.ads, a-cohama.ads,
	* a-cohase.ads, a-coinve.ads, a-comutr.ads, a-convec.ads,
	* a-coorma.ads, a-coorse: Controlled component added to the
	reference types.

Submitter	Arnaud Charlet
Date	Feb. 17, 2012, 2:16 p.m.
Message ID	<20120217141607.GA22658@adacore.com>
Download	mbox \| patch
Permalink	/patch/141829/
State	New
Headers	show Return-Path: <gcc-patches-return-313375-incoming=patchwork.ozlabs.org@gcc.gnu.org> Comment: DKIM? See http://www.dkim.org Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=UlaMfFjejpNNQ6ceK9eb422CmaiNmwJA4vriCAyVQ0gDk3Shl4Zqu39mJmH858 F9ZDwxAiX2fi2fcGEZqwmLYcTx0w59gLGkIEl671TniVCLTtsGwlux85hs8xXiS1 FC4GydB1Uuz8s2VsaPFgHVwiGf3Zz5/HUQILuHVMZnjEI=; Date: Fri, 17 Feb 2012 09:16:07 -0500 From: Arnaud Charlet <charlet@adacore.com> To: gcc-patches@gcc.gnu.org Cc: Vincent Pucci <pucci@adacore.com> Subject: [Ada] Controlled finalization for references in Ada 2012 containers Message-ID: <20120217141607.GA22658@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="tKW2IUtsqtDRztdT" Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk Sender: gcc-patches-owner@gcc.gnu.org

Patchwork [Ada] Controlled finalization for references in Ada 2012 containers

Comments

Patch