+2014-07-16 Robert Dewar <dewar@adacore.com>
+
+ * gnat_rm.texi: Document erroneous mixing of thin pointers and
+ unrestricted access
+ * gnat_ugn.texi: Add note on size of access types about thin
+ pointers and the use of attribute Unrestricted_Access.
+
+2014-07-16 Ed Schonberg <schonberg@adacore.com>
+
+ * a-cbdlli.ads, a-cbdlli.adb, a-cbhama.ads, a-cbhama.adb,
+ * a-cbhase.ads, a-cbhase.adb, a-cborma.ads, a-cborma.adb,
+ * a-cborse.ads, a-cborse.adb, a-cobove.ads a-cobove.adb: Add Control
+ machinery to detect tampering on bounded vectors.
+
2014-07-16 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Document that leading/trailing asterisks are
Insert (Container, No_Element, New_Item, Count);
end Append;
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : List renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B + 1;
+ L := L + 1;
+ end;
+ end if;
+ end Adjust;
+
------------
-- Assign --
------------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Position.Container.Busy;
+ L : Natural renames Position.Container.Lock;
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end if;
end Constant_Reference;
end if;
end Finalize;
+ procedure Finalize (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : List renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B - 1;
+ L := L - 1;
+ end;
+
+ Control.Container := null;
+ end if;
+ end Finalize;
+
----------
-- Find --
----------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
begin
- return (Element => N.Element'Access);
+ return R : constant Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end if;
end Reference;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
type List_Access is access all List;
for List_Access'Storage_Size use 0;
- type Cursor is
- record
- Container : List_Access;
- Node : Count_Type := 0;
- end record;
+ type Cursor is record
+ Container : List_Access;
+ Node : Count_Type := 0;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
for Cursor'Write use Write;
- type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
+ type Reference_Control_Type is new Controlled with record
+ Container : List_Access;
+ end record;
- procedure Write
- (Stream : not null access Root_Stream_Type'Class;
- Item : Constant_Reference_Type);
+ overriding procedure Adjust (Control : in out Reference_Control_Type);
+ pragma Inline (Adjust);
- for Constant_Reference_Type'Write use Write;
+ overriding procedure Finalize (Control : in out Reference_Control_Type);
+ pragma Inline (Finalize);
+
+ type Constant_Reference_Type
+ (Element : not null access constant Element_Type) is
+ record
+ Control : Reference_Control_Type;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
for Constant_Reference_Type'Read use Read;
- type Reference_Type
- (Element : not null access Element_Type) is null record;
+ procedure Write
+ (Stream : not null access Root_Stream_Type'Class;
+ Item : Constant_Reference_Type);
+
+ for Constant_Reference_Type'Write use Write;
+
+ type Reference_Type (Element : not null access Element_Type) is record
+ Control : Reference_Control_Type;
+ end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
return Is_Equal (Left, Right);
end "=";
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Map renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B + 1;
+ L := L + 1;
+ end;
+ end if;
+ end Adjust;
+
------------
-- Assign --
------------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Position.Container.Busy;
+ L : Natural renames Position.Container.Lock;
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
end if;
declare
+ Cur : Cursor := Find (Container, Key);
+ pragma Unmodified (Cur);
+
N : Node_Type renames Container.Nodes (Node);
+ B : Natural renames Cur.Container.Busy;
+ L : Natural renames Cur.Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
end if;
end Finalize;
+ procedure Finalize (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Map renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B - 1;
+ L := L - 1;
+ end;
+
+ Control.Container := null;
+ end if;
+ end Finalize;
+
----------
-- Find --
----------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Reference;
declare
N : Node_Type renames Container.Nodes (Node);
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Reference;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
for Cursor'Write use Write;
+ type Reference_Control_Type is new Controlled with record
+ Container : Map_Access;
+ end record;
+
+ overriding procedure Adjust (Control : in out Reference_Control_Type);
+ pragma Inline (Adjust);
+
+ overriding procedure Finalize (Control : in out Reference_Control_Type);
+ pragma Inline (Finalize);
+
type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
+ (Element : not null access constant Element_Type) is
+ record
+ Control : Reference_Control_Type;
+ end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
for Constant_Reference_Type'Read use Read;
- type Reference_Type
- (Element : not null access Element_Type) is null record;
+ type Reference_Type (Element : not null access Element_Type) is record
+ Control : Reference_Control_Type;
+ end record;
procedure Write
(Stream : not null access Root_Stream_Type'Class;
for Reference_Type'Read use Read;
Empty_Map : constant Map :=
- (Hash_Table_Type with Capacity => 0, Modulus => 0);
+ (Hash_Table_Type with Capacity => 0, Modulus => 0);
No_Element : constant Cursor := (Container => null, Node => 0);
+
type Iterator is new Limited_Controlled and
Map_Iterator_Interfaces.Forward_Iterator with
record
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
return Is_Equal (Left, Right);
end "=";
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Set renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B + 1;
+ L := L + 1;
+ end;
+ end if;
+ end Adjust;
+
------------
-- Assign --
------------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Position.Container.Busy;
+ L : Natural renames Position.Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
end if;
end Finalize;
+ procedure Finalize (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Set renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B - 1;
+ L := L - 1;
+ end;
+
+ Control.Container := null;
+ end if;
+ end Finalize;
+
----------
-- Find --
----------
end if;
declare
+ Cur : Cursor := Find (Container, Key);
+ pragma Unmodified (Cur);
+
N : Node_Type renames Container.Nodes (Node);
+ B : Natural renames Cur.Container.Busy;
+ L : Natural renames Cur.Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Key : Key_Type) return Reference_Type;
private
- type Reference_Type (Element : not null access Element_Type)
- is null record;
+ type Reference_Type (Element : not null access Element_Type) is
+ null record;
use Ada.Streams;
new Hash_Tables.Generic_Bounded_Hash_Table_Types (Node_Type);
type Set (Capacity : Count_Type; Modulus : Hash_Type) is
- new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
+ new HT_Types.Hash_Table_Type (Capacity, Modulus) with null record;
use HT_Types;
use Ada.Streams;
for Cursor'Read use Read;
+ type Reference_Control_Type is new Controlled with record
+ Container : Set_Access;
+ end record;
+
+ overriding procedure Adjust (Control : in out Reference_Control_Type);
+ pragma Inline (Adjust);
+
+ overriding procedure Finalize (Control : in out Reference_Control_Type);
+ pragma Inline (Finalize);
+
type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
+ (Element : not null access constant Element_Type) is
+ record
+ Control : Reference_Control_Type;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
end;
end ">";
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Map renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B + 1;
+ L := L + 1;
+ end;
+ end if;
+ end Adjust;
+
------------
-- Assign --
------------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Position.Container.Busy;
+ L : Natural renames Position.Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
end if;
declare
+ Cur : Cursor := Find (Container, Key);
+ pragma Unmodified (Cur);
+
N : Node_Type renames Container.Nodes (Node);
+ B : Natural renames Cur.Container.Busy;
+ L : Natural renames Cur.Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
end if;
end Finalize;
+ procedure Finalize (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Map renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B - 1;
+ L := L - 1;
+ end;
+
+ Control.Container := null;
+ end if;
+ end Finalize;
+
----------
-- Find --
----------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
begin
- return (Element => N.Element'Access);
+ return R : constant Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Reference;
declare
N : Node_Type renames Container.Nodes (Node);
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
begin
- return (Element => N.Element'Access);
+ return R : constant Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Reference;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
private
+ use Ada.Finalization;
pragma Inline (Next);
pragma Inline (Previous);
for Cursor'Read use Read;
+ type Reference_Control_Type is new Controlled with record
+ Container : Map_Access;
+ end record;
+
+ overriding procedure Adjust (Control : in out Reference_Control_Type);
+ pragma Inline (Adjust);
+
+ overriding procedure Finalize (Control : in out Reference_Control_Type);
+ pragma Inline (Finalize);
+
type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
+ (Element : not null access constant Element_Type) is
+ record
+ Control : Reference_Control_Type;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
for Constant_Reference_Type'Write use Write;
- type Reference_Type
- (Element : not null access Element_Type) is null record;
+ type Reference_Type (Element : not null access Element_Type) is record
+ Control : Reference_Control_Type;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
No_Element : constant Cursor := Cursor'(null, 0);
- use Ada.Finalization;
-
type Iterator is new Limited_Controlled and
Map_Iterator_Interfaces.Reversible_Iterator with
record
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
return Right < Left.Container.Nodes (Left.Node).Element;
end ">";
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Set renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B + 1;
+ L := L + 1;
+ end;
+ end if;
+ end Adjust;
+
------------
-- Assign --
------------
declare
N : Node_Type renames Container.Nodes (Position.Node);
+ B : Natural renames Position.Container.Busy;
+ L : Natural renames Position.Container.Lock;
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
end if;
end Finalize;
+ procedure Finalize (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Set renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B - 1;
+ L := L - 1;
+ end;
+
+ Control.Container := null;
+ end if;
+ end Finalize;
+
----------
-- Find --
----------
end if;
declare
+ Cur : Cursor := Find (Container, Key);
+ pragma Unmodified (Cur);
+
N : Node_Type renames Container.Nodes (Node);
+ B : Natural renames Cur.Container.Busy;
+ L : Natural renames Cur.Container.Lock;
+
begin
- return (Element => N.Element'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => N.Element'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Key : Key_Type) return Reference_Type;
private
- type Reference_Type
- (Element : not null access Element_Type) is null record;
+ type Reference_Type (Element : not null access Element_Type) is
+ null record;
use Ada.Streams;
new Tree_Types.Tree_Type (Capacity) with null record;
use Tree_Types;
+ use Ada.Finalization;
use Ada.Streams;
procedure Write
for Cursor'Read use Read;
+ type Reference_Control_Type is new Controlled with record
+ Container : Set_Access;
+ end record;
+
+ overriding procedure Adjust (Control : in out Reference_Control_Type);
+ pragma Inline (Adjust);
+
+ overriding procedure Finalize (Control : in out Reference_Control_Type);
+ pragma Inline (Finalize);
+
type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
+ (Element : not null access constant Element_Type) is
+ record
+ Control : Reference_Control_Type;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
No_Element : constant Cursor := Cursor'(null, 0);
- use Ada.Finalization;
-
type Iterator is new Limited_Controlled and
Set_Iterator_Interfaces.Reversible_Iterator with
record
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
raise;
end "=";
+ ------------
+ -- Adjust --
+ ------------
+
+ procedure Adjust (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Vector renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B + 1;
+ L := L + 1;
+ end;
+ end if;
+ end Adjust;
+
------------
-- Assign --
------------
declare
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Position.Index);
+ B : Natural renames Position.Container.Busy;
+ L : Natural renames Position.Container.Lock;
begin
- return (Element => A (I)'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => A (I)'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ B := B + 1;
+ L := L + 1;
+ end return;
end;
end Constant_Reference;
A : Elements_Array renames Container.Elements;
I : constant Count_Type := To_Array_Index (Index);
begin
- return (Element => A (I)'Access);
+ return R : constant Constant_Reference_Type :=
+ (Element => A (I)'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
+ do
+ R.Control.Container.Busy := R.Control.Container.Busy + 1;
+ R.Control.Container.Lock := R.Control.Container.Lock + 1;
+ end return;
end;
end Constant_Reference;
B := B - 1;
end Finalize;
+ procedure Finalize (Control : in out Reference_Control_Type) is
+ begin
+ if Control.Container /= null then
+ declare
+ C : Vector renames Control.Container.all;
+ B : Natural renames C.Busy;
+ L : Natural renames C.Lock;
+ begin
+ B := B - 1;
+ L := L - 1;
+ end;
+
+ Control.Container := null;
+ end if;
+ end Finalize;
+
----------
-- Find --
----------
declare
A : Elements_Array renames Container.Elements;
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
J : constant Count_Type := To_Array_Index (Position.Index);
begin
- return (Element => A (J)'Access);
+ B := B + 1;
+ L := L + 1;
+ return (Element => A (J)'Access,
+ Control => (Controlled with Container'Unrestricted_Access));
end;
end Reference;
declare
A : Elements_Array renames Container.Elements;
+ B : Natural renames Container.Busy;
+ L : Natural renames Container.Lock;
J : constant Count_Type := To_Array_Index (Index);
begin
- return (Element => A (J)'Access);
+ B := B + 1;
+ L := L + 1;
+ return (Element => A (J)'Access,
+ Control => (Controlled with Container'Unrestricted_Access));
end;
end Reference;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
for Cursor'Read use Read;
+ type Reference_Control_Type is new Controlled with record
+ Container : Vector_Access;
+ end record;
+
+ overriding procedure Adjust (Control : in out Reference_Control_Type);
+ pragma Inline (Adjust);
+
+ overriding procedure Finalize (Control : in out Reference_Control_Type);
+ pragma Inline (Finalize);
+
type Constant_Reference_Type
- (Element : not null access constant Element_Type) is null record;
+ (Element : not null access constant Element_Type) is
+ record
+ Control : Reference_Control_Type;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
for Constant_Reference_Type'Write use Write;
- type Reference_Type
- (Element : not null access Element_Type) is null record;
+ type Reference_Type (Element : not null access Element_Type) is record
+ Control : Reference_Control_Type;
+ end record;
procedure Read
(Stream : not null access Root_Stream_Type'Class;
@code{System.Aux_DEC.Type_Class}, which has the following definition:
@smallexample @c ada
- type Type_Class is
- (Type_Class_Enumeration,
- Type_Class_Integer,
- Type_Class_Fixed_Point,
- Type_Class_Floating_Point,
- Type_Class_Array,
- Type_Class_Record,
- Type_Class_Access,
- Type_Class_Task,
- Type_Class_Address);
+type Type_Class is
+ (Type_Class_Enumeration,
+ Type_Class_Integer,
+ Type_Class_Fixed_Point,
+ Type_Class_Floating_Point,
+ Type_Class_Array,
+ Type_Class_Record,
+ Type_Class_Access,
+ Type_Class_Task,
+ Type_Class_Address);
@end smallexample
@noindent
except that all accessibility and aliased view checks are omitted. This
is a user-beware attribute. It is similar to
@code{Address}, for which it is a desirable replacement where the value
-desired is an access type. In other words, its effect is identical to
+desired is an access type. In other words, its effect is similar to
first applying the @code{Address} attribute and then doing an unchecked
conversion to a desired access type. In GNAT, but not necessarily in
other implementations, the use of static chains for inner level
is in scope (normal Ada accessibility rules restrict this usage).
It is possible to use @code{Unrestricted_Access} for any type, but care
-must be exercised if it is used to create pointers to unconstrained
+must be exercised if it is used to create pointers to unconstrained array
objects. In this case, the resulting pointer has the same scope as the
context of the attribute, and may not be returned to some enclosing
scope. For instance, a function cannot use @code{Unrestricted_Access}
to create a unconstrained pointer and then return that value to the
-caller.
+caller. In addition, it is only valid to create pointers to unconstrained
+arrays using this attribute if the pointer has the normal default ``fat''
+representation where a pointer has two components, one points to the array
+and one points to the bounds. If a size clause is used to force ``thin''
+representation for a pointer to unconstrained where there is only space for
+a single pointer, then any use of @code{Unrestricted_Access}
+to create a value of such a type (e.g. by conversion from fat to
+thin pointers) is erroneous. Consider the following example:
+
+@smallexample @c ada
+with System; use System;
+procedure SliceUA is
+ type A is access all String;
+ for A'Size use Standard'Address_Size;
+
+ procedure P (Arg : A) is
+ begin
+ if Arg'Length /= 6 then
+ raise Program_Error;
+ end if;
+ end P;
+
+ X : String := "hello world!";
+
+begin
+ P (X(7 .. 12)'Unrestricted_Access);
+end;
+@end smallexample
+
+@noindent
+This inevitably raises @code{Program_Error}.
+A normal unconstrained array value
+or a constrained array object marked as aliased has the bounds in memory
+just before the array, so a thin pointer can retrieve both the data and
+the bounds. But in this case, the non-aliased object @code{X} does not have the
+bounds before the string. If the size clause for type @code{A}
+were not present, then the pointer
+would be a fat pointer, where one component is a pointer to the bounds,
+and all would be well. But with the size clause present, the conversion from
+fat pointer to think pointer in the call looses the bounds.
+
+In general, it is advisable to completely
+avoid mixing the use of thin pointers and the use of
+@code{Unrestricted_Access} where the designated type is an
+unconstrained array. The use of thin pointers should be restricted to
+cases of porting legacy code which implicitly assumes the size of pointers,
+and such code should not in any case be using this attribute.
@node Attribute Update
@unnumberedsec Attribute Update
Note that another way of forcing a thin pointer representation
is to use a component size clause for the element size in an array,
or a record representation clause for an access field in a record.
+
+See the documentation of Unrestricted_Access in the GNAT RM for a
+full discussion of possible problems using this attribute in conjunction
+with thin pointers.
@end table
@ifclear vms
projects / thirdparty / gcc.git / commitdiff
