Ada.Containers.Formal_Indefinite_Vectors memory leak - ada

I'm using an instance of package Ada.Containers.Formal_Indefinite_Vectors to store two kinds of polimorphic objects.
I have the following package where I instantiate the container:
with Interfaces.C;
with Root.Classes.Concrete_1;
with Root.Classes.Concrete_2;
package Root.Vectors is
type vector_t is tagged limited private;
subtype vectorIndex_t is Interfaces.C.int range 1 .. Interfaces.C.int'Last;
procedure pAppend (this : in out vector_t;
New_Item : Root.Classes.Parent_t'Class);
procedure pClear (this : in out vector_t);
private
--TODO: I have to define it correctly, it could be the problem
function "=" (Left, Right : Root.Classes.Parent_t'Class)
return Boolean is (True);
MaxSize : constant Natural := Natural'Max
(Root.Classes.Concrete_1.Concrete_1_t'Size,
Root.Classes.Concrete_2.Concrete_2_t'Size);
package polimorphicVector_pck is new
Ada.Containers.Formal_Indefinite_Vectors
(Index_Type => vectorIndex_t,
Element_Type => Root.Classes.Parent_t'Class,
"=" => "=",
Max_Size_In_Storage_Elements => MaxSize,
Bounded => True);
type vector_t is tagged limited
record
v : polimorphicVector_pck.Vector (Capacity => 1000); --TODO: magic number
end record;
end Root.Vectors;
package body Root.Vectors is
procedure pAppend (this : in out vector_t;
New_Item : Root.Classes.Parent_t'Class) is
begin
polimorphicVector_pck.Append (Container => this.v,
New_Item => New_Item);
end pAppend;
procedure pClear (this : in out vector_t) is
begin
polimorphicVector_pck.Clear (Container => this.v);
end pClear;
end Root.Vectors;
Then I test it with the following main:
with Root.Classes.Concrete_1;
with Root.Vectors;
procedure Main is
aVector : Root.Vectors.Vector_t;
begin
for idx in Natural range 1 .. 1000 loop
declare
--Concrete_1_t is an unconstrained tagged type that requires constructor
obj : Root.Classes.Concrete_1.Concrete_1_t :=
Root.Classes.Concrete_1.fConstructor (Argument => idx);
begin
aVector.pAppend (New_Item => obj);
end;
end loop;
-- Trying to clear the vector after all appends; this does not seem to work
aVector.pClear;
end Main;
Then, I have used gnatmem to check if I have any memory leak, showing the following:
Global information
------------------
Total number of allocations :779831
Total number of deallocations :5080
Final Water Mark (non freed mem) : 26.71 Megabytes
High Water Mark : 26.71 Megabytes
Allocation Root # 1
-------------------
Number of non freed allocations :764550
Final Water Mark (non freed mem) : 17.50 Megabytes
High Water Mark : 17.50 Megabytes
Backtrace :
??:0 ??
Allocation Root # 2
-------------------
Number of non freed allocations :5100
Final Water Mark (non freed mem) : 119.53 Kilobytes
High Water Mark : 119.53 Kilobytes
Backtrace :
a-cfinve.adb:220 root.vectors.polimorphicVector_pck.copy
Allocation Root # 3
-------------------
Number of non freed allocations :3390
Final Water Mark (non freed mem) : 7.78 Megabytes
High Water Mark : 7.78 Megabytes
Backtrace :
a-cfinve.adb:466 root.vectors.polimorphicVector_pck.find_index
Allocation Root # 4
-------------------
Number of non freed allocations :1710
Final Water Mark (non freed mem) : 1.32 Megabytes
High Water Mark : 1.32 Megabytes
Backtrace :
a-cfinve.adb:219 root.vectors.polimorphicVector_pck.copy
Allocation Root # 5
-------------------
Number of non freed allocations : 1
Final Water Mark (non freed mem) : 8 Bytes
High Water Mark : 8 Bytes
Backtrace :
??:0 system.stream_attributes.xdr.i_ssi
Why is it leaking? It can be due to the "=" that always return True?

You instantiate the container as Bounded:
Bounded => True);
Bounded containers are allocated on stack. This is also documented in the spec-file:
Bounded : Boolean := True;
-- If True, the containers are bounded; the initial capacity is the maximum
-- size, and heap allocation will be avoided. If False, the containers can
-- grow via heap allocation.

Related

How to automate deallocation with storage pools in Ada95

I read that user-defined Storage Pools can be made to simplify the deallocation process and in some cases even automate it. Giddy at the possibility, I have been trying to make a simple storage pool example in Ada95, but I am running into trouble.
I have been reading the following recommended page to see an example of an implementation, and try and run it on my machine. However, after tweaking some of the with and use statements in order to get it to compile, when I ran it I saw that it actually failed on occasion and claimed that "adjust/finalize raised an error". Tweaking the exception handling to further propagate the full details I got the following message:
raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed
I'm struggling with this because the Unchecked_Deallocation call seems to be what is providing the inaccurate object size that is resulting in an inaccurate index! The new call never reports allocating the amount that is attempting to be deallocated. As I am very new to this concept, I am stumped as to what to do next. If anyone is willing to point out my silly mistake or highlight something I am misunderstanding, I would be very grateful.
Here is the code after I modified it, exactly as I organized it:
memory_management.ads
with System.Storage_Pools;
with System.Storage_Elements;
package Memory_Management is
use System;
type User_Pool (Size : Storage_Elements.Storage_Count) is new
System.Storage_Pools.Root_Storage_Pool with private;
procedure Allocate (
Pool : in out User_Pool;
Storage_Address : out System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count);
procedure Deallocate (
Pool : in out User_Pool;
Storage_Address : in System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count);
function Storage_Size (Pool : in User_Pool)
return Storage_Elements.Storage_Count;
-- Exeption declaration
Memory_Exhausted : exception;
Item_Too_Big : exception;
private
type User_Pool (Size : Storage_Elements.Storage_Count) is new
System.Storage_Pools.Root_Storage_Pool with record
Data : Storage_Elements.Storage_Array (1 .. Size);
Addr_Index : Storage_Elements.Storage_Count := 1;
end record;
end Memory_Management;
memory_management.adb
with Ada.Exceptions;
with Ada.Text_Io;
with System.Storage_Elements;
with System.Address_To_Access_Conversions;
package body Memory_Management is
use Ada;
use Text_Io;
use type System.Storage_Elements.Storage_Count;
Package_Name: constant String := "Memory_Management.";
-- Used to turn on/off the debug information
Debug_On: Boolean := True;
type Holder is record
Next_Address: System.Address := System.Null_Address;
end record;
package Addr_To_Acc is new Address_To_Access_Conversions(Holder);
-- Keep track of the size of memory block for reuse
Free_Storage_Keeper : array (Storage_Elements.Storage_Count
range 1 .. 100) of System.Address :=
(others => System.Null_Address);
procedure Display_Info(Message : String;
With_New_Line : Boolean := True) is
begin
if Debug_On then
if With_New_Line then
Put_Line(Message);
else
Put(Message);
end if;
end if;
end Display_Info;
procedure Allocate(
Pool : in out User_Pool;
Storage_Address : out System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count) is
Procedure_Name : constant String := "Allocate";
Temp_Address : System.Address := System.Null_Address;
Marker : Storage_Elements.Storage_Count;
begin
Marker := (Size_In_Storage_Elements + Alignment - 1) / Alignment;
if Free_Storage_Keeper(Marker) /= System.Null_Address then
Storage_Address := Free_Storage_Keeper(Marker);
Free_Storage_Keeper(Marker) :=
Addr_To_Acc.To_Pointer(Free_Storage_Keeper(
Marker)).Next_Address;
else
Temp_Address := Pool.Data(Pool.Addr_Index)'Address;
Pool.Addr_Index := Pool.Addr_Index + Alignment *
((Size_In_Storage_Elements + Alignment - 1) / Alignment);
Display_Info("storage elements to be allocated from pool: " &
System.Storage_Elements.Storage_Count'Image(
Size_In_Storage_Elements));
Display_Info("Alignment in allocation operation: " &
System.Storage_Elements.Storage_Count'Image(Alignment));
-- make sure memory is available as requested
if Pool.Addr_Index > Pool.Size then
Exceptions.Raise_Exception(Storage_Error'Identity,
"Storage exhausted in " & Package_Name &
Procedure_Name);
else
Storage_Address := Temp_Address;
end if;
end if;
--Display_Info("Address allocated from pool: " &
-- System.Storage_Elements.Integer_Address'Image(
-- System.Storage_Elements.To_Integer(Storage_Address)));
exception
when Error : others => -- Object too big or memory exhausted
Display_Info(Exceptions.Exception_Information(Error));
raise;
end Allocate;
procedure Deallocate(
Pool : in out User_Pool;
Storage_Address : in System.Address;
Size_In_Storage_Elements : in Storage_Elements.Storage_Count;
Alignment : in Storage_Elements.Storage_Count) is
Marker : Storage_Elements.Storage_Count;
begin
Marker := (Size_In_Storage_Elements + Alignment - 1) / Alignment;
--Display_Info("Address to be returned to pool: " &
-- System.Storage_Elements.Integer_Address'Image(
-- System.Storage_Elements.To_Integer(Storage_Address)));
Display_Info("storage elements to return to pool: " &
System.Storage_Elements.Storage_Count'Image(
Size_In_Storage_Elements));
Display_Info("Alignment to be used in deallocation: " &
System.Storage_Elements.Storage_Count'Image(Alignment));
Addr_To_Acc.To_Pointer(Storage_Address).Next_Address :=
Free_Storage_Keeper(Marker);
Free_Storage_Keeper(Marker) := Storage_Address;
exception
when Error: others =>
Ada.Text_IO.Put_Line(Ada.Exceptions.Exception_Information(Error));
raise;
end Deallocate;
function Storage_Size (Pool : in User_Pool)
return Storage_Elements.Storage_Count is
begin
return Pool.Size;
end Storage_Size;
end Memory_Management;
memory_management-support.ads
with Ada.Finalization;
package Memory_Management.Support is
use Ada;
-- Adjust the storage size according to the application
Big_Pool : User_Pool(Size => 100);
type Int_Acc is access Integer;
for Int_Acc'Storage_Pool use Big_Pool;
type Str_Acc is access all String;
for Str_Acc'Storage_Pool use Int_Acc'Storage_Pool;
type General_Data is new Finalization.Controlled
with record
Id : Int_Acc;
Name : Str_Acc;
end record;
procedure Initialize(Object : in out General_Data);
procedure Finalize(Object : in out General_Data);
end Memory_Management.Support;
memory_management-support.adb
with Ada.Unchecked_Deallocation;
with Ada.Exceptions;
with Ada.Text_IO;
package body Memory_Management.Support is
procedure Free is new Ada.Unchecked_Deallocation(Integer, Int_Acc);
procedure Free is new Ada.Unchecked_Deallocation(String, Str_Acc);
procedure Initialize(Object : in out General_Data) is
begin
null;
end Initialize;
procedure Finalize(Object : in out General_Data) is
begin
Free(Object.Id);
Free(Object.Name);
end Finalize;
end Memory_Management.Support;
memory_management_test.adb
with Ada.Finalization;
with Ada.Text_Io;
with Memory_Management.Support;
procedure Memory_Management_Test is
use Ada;
use Text_Io;
use Memory_Management.Support;
begin
Put_Line ("********* Memory Control Testing Starts **********");
for Index in 1 .. 10 loop
declare
David_Botton : General_Data;
Nick_Roberts : General_Data;
Anh_Vo : General_Data;
begin
David_Botton := (Finalization.Controlled with
Id => new Integer'(111),
Name => new String'("David Botton"));
Nick_Roberts := (Finalization.Controlled with
Id => new Integer'(222),
Name => new String' ("Nick Roberts"));
Anh_Vo := (Finalization.Controlled with
Id => new Integer'(333),
Name => new String' ("Anh Vo"));
end;
end loop;
Put_Line ("Memory Management Test Passes");
exception
when others =>
Put_Line ("Memory Management Test Fails");
end Memory_Management_Test;
lastly, here is what the output looks like upon failure:
********* Memory Control Testing Starts **********
storage elements to be allocated from pool: 4
Alignment in allocation operation: 4
storage elements to be allocated from pool: 20
Alignment in allocation operation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 24
Alignment to be used in deallocation: 4
storage elements to be allocated from pool: 20
Alignment in allocation operation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 20
Alignment to be used in deallocation: 4
storage elements to be allocated from pool: 16
Alignment in allocation operation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 16
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 12
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 12
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 8
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 20
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 20
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 16
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 12
Alignment to be used in deallocation: 4
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 238878632
Alignment to be used in deallocation: 4
raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed
storage elements to return to pool: 4
Alignment to be used in deallocation: 4
storage elements to return to pool: 238878632
Alignment to be used in deallocation: 4
raised CONSTRAINT_ERROR : memory_management.adb:113 index check failed
Memory Management Test Fails
I stand by my remarks in the comments above, that the following problems exist:
The Marker variable, which is the requested size divided by the requested alignment (rounded up), and is used to index the Free_Storage_Keeper, presumably in an attempt to keep same-sized blocks together. But 16 bytes/alignment 4 will end in the same index as 32 bytes/alignment 8.
There’s no attempt to actually align the request.
You need an Adjust for General_Data (you always need an Adjust for a Controlled type containing pointers).
Free_Storage_Keeper ought to live in the storage pool (what happens if you have two instances of User_Pool? what about tasks?)
However, I think the immediate cause of the crash is this statement in Deallocate:
Addr_To_Acc.To_Pointer(Storage_Address).Next_Address :=
Free_Storage_Keeper(Marker);
because it assumes that a pointer can fit in an allocation, which is certainly not the case with an Integer on a 64-bit OS (4-byte integer vs 8-byte access).
You could start by forcing a minimum allocation in Allocate, Deallocate:
Size : constant Storage_Elements.Storage_Count
:= Storage_Elements.Storage_Count'Max
(Size_In_Storage_Elements,
System.Address'Max_Size_In_Storage_Elements);
and then use Size instead of Size_In_Storage_Elements throughout.

Ada.Text_IO.Float_IO.get() not behaving as expected

I'm about 5 hours into learning Ada. I made a simple program and I was putting different values into it and experienced behavior I can't explain.
My program works fine with normal inputs like km = 100, litres = 10, result = 10.0.
And obviously bad inputs work: km = "cat" result in "raised ADA.IO_EXCEPTIONS.DATA_ERROR"
But this combination of inputs has me baffled: km = 100..10. The program skips over the litres input and presents a result that works back to a litres value of 0.10. I was expecting a constraint error like when I entered 'cat'.
Can someone please explain this to me and how Ada programmers work around it so that 100..10 results in an error.
Here's my program:
-- This program takes km driven and litres consumed to calculate
-- fuel economy.
with Ada.Text_IO;
with Ada.Float_Text_IO;
procedure Main is
package TIO renames Ada.Text_IO;
package FIO renames Ada.Float_Text_IO;
type Km is new Float range 0.01 .. 10_000.00;
type Litres is new Float range 0.01 .. 10_000.00;
package Km_IO is new TIO.Float_IO (Km);
package Litres_IO is new TIO.Float_IO (Litres);
Entered_Km : Km;
Entered_Litres : Litres;
function Fuel_Economy (
Entered_Km : in Km;
Entered_Litres : in Litres
) return Float is
-- returns fuel economy normalized to litres per 100 km
begin
return Float(Entered_Litres) / Float(Entered_Km) * 100.0;
end Fuel_Economy;
begin
TIO.Put_Line ("This program calculates fuel economy.");
TIO.Put_Line ("Enter km:");
Km_IO.Get (Entered_Km);
TIO.Put_Line ("Enter litres:");
Litres_IO.Get (Entered_Litres);
TIO.Put ("Your fuel economy is ");
FIO.Put (Item => Fuel_Economy (Entered_Km, Entered_Litres),
Fore => 1,
Aft => 2,
Exp => 0
);
TIO.Put_Line (" litres per 100 km.");
end Main;
Exact output:
This program calculates fuel economy.
Enter km:
100..10
Enter litres:
Your fuel economy is 0.10 litres per 100 km.
[2018-05-06 14:08:16] process terminated successfully, elapsed time: 04.01s
I'm using GPS 2017 on windows 7.
Many thanks.
Typically experienced Ada users read the entire line into a String (using function Get_Line) and then extract the numeric value(s) from the String. Since programs like this typically loop until the user enters a valid value, reading into a String avoids a common problem with direct numeric I/O in which invalid input results in an infinite loop:
Get_Km : loop
Handle_Invalid : begin
Put_Line (Item => "Enter km");
Get (Item => Entered_Km);
exit Get_Km;
exception -- Handle_Invalid
when others =>
Put_Line ("Invalid input");
end Handle_Invalid;
end loop Get_Km;
The invalid input remains in the buffer and is repeatedly processed by Get.
Wright demonstrated a variation of this, but usually anything left on the line after the value(s) is discarded, so that input can be redirected from a file with trailing comments:
13.3 -- km traveled
One solution would be to discard the rest of the line after having read the (leading) number:
TIO.Put_Line ("Enter km:");
Km_IO.Get (Entered_Km);
TIO.Skip_Line;
Another, less straightforward, would be to check that there wasn’t anything left over:
TIO.Put_Line ("Enter km:");
Get_Km:
loop
declare
Input : constant String := TIO.Get_Line;
Last : Natural;
begin
Km_IO.Get (From => Input, Item => Entered_Km, Last => Last);
exit Get_Km when Input (Last + 1 .. Input'Length)
= (Last + 1 .. Input'Length => ' ');
TIO.Put_Line ("... just the number, please; '"
& Input (Last + 1 .. Input'Length)
& "' was left over");
exception
when others =>
TIO.Put_Line ("... a number, please");
end;
end loop Get_Km;
According to the Ada Language Reference Manual A.10.9(15-16) your run-time library is behaving correctly, as these two formats are allowed syntax for Ada.Text_IO.Float_IO.Get:
[+|–]numeral.[exponent]
[+|–].numeral[exponent]

Ada: Understanding variable'Size vs type'Size vs value_size vs object_size

Let the following Ada types be defined:
type Type_Huge is array (1 .. Integer'Last) of Float;
type Type_B is (foo, bar, blop, bloub);
type Type_A ( disc : Type_B := foo) is
record
case disc is
when foo =>
My_int : Integer;
when bar =>
huge_data : Type_Huge := (others => 0.0);
when others =>
null;
end case;
end record;
1- Do you confirm the following ?
my_var : Type_A;
(Type_A'Size = my_var'Size) returns False
2- what is the real value of my_var'Size ?
I would say the size is at least:
Type_B'Size + Integer'Size
3- What is the value of Type_A'Size ?
I would say the size is the max of the possible configurations.
3- Is there anything else the compiler would add (probably hidden) to my_var?
I have also read some articles concerning Value_Size and Object_Size
But I don't get the full picture right now.
Thx
As quoted in another answer the LRM requires 'Size be defined by the implementation for indefinite types; in addition, LRM M.2 (45) requires that the implementation documents this characteristic:
(45) The meaning of Size for indefinite subtypes.
If your compiler is GNAT, this is what it states in its reference manual:
Size for an indefinite subtype is the maximum possible size,
(...).
You can see the compiler's choice when you add compiler switch -gnatR3. The output also lists numbers for 'Value_Size as they depend on the record discriminant's value. (The (...) part talks about sizes of subprogram parameters.)
Quoting section 13.3 in the LRM:
(44) For every subtype S:
(45) S'Size [...]
(48) If S is indefinite, the meaning is implementation defined. [...]
In other words: It is implementation defined.

Using a Variant Record by Pointer

I simply don't catch why the following does not work. Could someone help me to fix it? It complains (at runtime):
raised CONSTRAINT_ERROR : variant2.adb:21 discriminant check failed
procedure Variant2 is
type POWER is (NONE,GAS, STEAM);
type VEHICLE (Engine : POWER := NONE) is
record
Model_Year : INTEGER range 1888..1992;
case Engine is
when NONE => null;
when GAS => Cylinders : INTEGER range 1..16;
when STEAM => Boiler_Size : INTEGER range 5..22;
Coal_Burner : BOOLEAN;
end case;
end record;
Works : VEHICLE;
Works_Not : access VEHICLE := new VEHICLE;
begin
Works := (GAS,1980,4); -- (1)
Works_Not.all := (GAS,1981,8); -- (2)
end Variant2;
(1) is working, but (2) does not
Thanks in advance!
The RM explicitly states that "If the designated type is composite, [...] the created object is constrained by its initial value (even if the designated subtype is unconstrained with defaults)." (RM 4.8(6/3))
which means you have to reallocate your access type
Works_Not := new VEHICLE'(GAS,1981,8);
(of course, you should deallocate the old access value first (see RM 13.11.2 Unchecked Storage Deallocation), but I leave that as an exercise)
UPDATE: as discussed in the comments
Here's an example you can play around with:
with Ada.Text_IO;
procedure Array_Of_Aliased is
type POWER is (NONE, GAS, STEAM);
type VEHICLE(Engine : POWER := NONE) is
record
Model_Year : Integer range 1888..1992;
case Engine is
when NONE => null;
when GAS => Cylinders : INTEGER range 1..16;
when STEAM => Boiler_Size : INTEGER range 5..22;
Coal_Burner : BOOLEAN;
end case;
end record;
-- array of aliased elements
type Vehicle_Array is array(1..5) of aliased VEHICLE;
-- the access type need to be "all" or "constant" in order to access aliased values
type Vehicle_Access is access all VEHICLE;
Vehicles : Vehicle_Array;
Works : Vehicle_Access;
begin
-- access to the first element of the array. Can't change discriminant this way...
Works := Vehicles(1)'Access;
Ada.Text_IO.Put_Line(POWER'Image(Works.Engine));
-- However, using the array, we _can_ change the discriminant, since it's _not_ an access value
Vehicles(1) := (STEAM, 1890, 20, True);
Vehicles(2) := (GAS, 1981, 8);
Ada.Text_IO.Put_Line(POWER'Image(Works.Engine));
-- We can still update the record elements using the access value, as long as the discriminant stays the same
Works.all := (STEAM, 1900, 15, False);
end Array_Of_Aliased;
As egilhh said, when you allocate a discriminant record using new, you can't change the discriminant of the record you allocated, even though you could do this for a variable of the type (as opposed to an allocated record). This rule has been around since Ada 83. The rationale was, I believe, that it allows the compiler to optimize space when allocating records. In your example, if we assume all the fields (including the discriminant) are 1 word, then the record will be 2 words if ENGINE=NONE, 3 words if ENGINE=GAS, 4 words if ENGINE=STEAM. When Works_Not is initialized, it's initialized to a NONE, which means it may take only 2 words on the heap (note: it's not a requirement that compilers optimize in this way). If it uses only 2 words, then reassigning the record to one with ENGINE=GAS would be a disaster--you'd be overflowing the area that you previously allocated, and stomping on other data.
Whether this was a good language design decision or not, I can't say; I don't know how many compilers, and how many applications, needed to take advantage of this optimization. Somebody 33 years ago thought it would be useful, and they must have had some good reasons for thinking so.
The restriction is annoying but not insurmountable. I've definitely run into it before, multiple times, but the simple answer is to wrap it in another record.
type VEHICLE_DATA (Engine : POWER := NONE) is
record
Model_Year : INTEGER range 1888..1992;
case Engine is
when NONE => null;
when GAS => Cylinders : INTEGER range 1..16;
when STEAM => Boiler_Size : INTEGER range 5..22;
Coal_Burner : BOOLEAN;
end case;
end record;
type VEHICLE is record
Data : VEHICLE_DATA;
end record;
Now_Works : access VEHICLE := new VEHICLE; -- still sets ENGINE=NONE
Now_Works := (Data => (Gas, 1981, 8)); -- legal
Now_Works.Data := (Gas, 1981, 8); -- legal, does the same thing
These are OK because the allocated record is a VEHICLE, which isn't a discriminant record. It's OK to change the discriminant of a subcomponent like this. That's how I've gotten around the rule.

Mapping chunk of shared memory for reading/writing in Ada

I have a chunk (1024 bytes) of shared memory between two processes for which I have an address pointing to. I want to copy some data to this shared memory, and read it on the other process. Coming from a C background, it seems easiest to map a record to this address, and then write to the record, but it does not seem to be copying correctly.
Currently, I am trying to convert the pointer to a pointer-to-record type using an Unchecked Conversion, and copy to the record, but I am seeing differences in the data when I compare the original payload with the one received in the second process.
Is this the proper way of doing this?:
type Payload_Array_Type is array (1..255) of Integer_32;
type Common_Buffer_Type is
record
Size : Integer_32;
Payload : Payload_Array_Type;
end record;
type Common_Buffer_Ptr_Type is access Common_Buffer_Type;
function Convert_Common_Memory_Ptr is new Unchecked_Conversion (
Source => System.Address,
Target => Common_Buffer_Ptr_Type);
Common_Memory_Ptr : System.Address;
procedure Copy_To_Common_Buffer
(
Size : Integer_32;
Payload : Payload_Array_Type
) is
Common_Buffer_Ptr : Common_Buffer_Ptr_Type;
begin
Common_Buffer_Ptr := Convert_Common_Memory_Ptr(Common_Memory_Ptr);
Common_Buffer_Ptr.Size := Size;
Common_Buffer_Ptr.Payload(1..255) := Payload(1..255);
end Copy_To_Common_Buffer;
I would try to do it this way:
procedure Payload is
type Payload_Array_Type is array (1..255) of Integer_32;
type Common_Buffer_Type is record
Size : Integer_32;
Payload : Payload_Array_Type;
end record;
for Common_Buffer_Type use record -- representation clause should be common to both processes
Size at 0 range 0 .. 31;
Payload at 0 range 32 .. 1023;
end record;
for Common_Buffer_Type'Size use 1024; -- check this is also used in the other process.
type Common_Buffer_Ptr_Type is access Common_Buffer_Type;
Common_Memory_Ptr : System.Address; -- assuming this is where the shared object resides with a real address, possibly make it constant
procedure Copy_To_Common_Buffer (Size : in Integer_32;
Payload : in Payload_Array_Type) is
Common_Buffer : Common_Buffer_Type;
for Common_Buffer'Address use Common_Memory_Ptr; -- address overlay
begin
Common_Buffer := (Size => Size,
Payload => Payload);
end Copy_To_Common_Buffer;
begin
Copy_To_Common_Buffer (9,(others => 876));
end Payload;
The type definitions should be common to the two processes, and note I've used a representation clause to specify where the components go.
I've used an address overlay to specify the location of where I'm writing, and written the whole record in one go.
Also look up usage of pragma volatile as #Brian Drummond suggests.

Resources