This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Controlled finalization for references in Ada 2012 containers


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.

Attachment: difs
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]