The following is an attempt to produce my problem with the minimum code (it is not intended to be a useful program).
My problem is that I want to make a precondition on a public function dependent on a private variable. I have to declare my function before the "private" indicator and my variables after that indicator. This means that I get the compilation error
problem.ads:10:16: "secondPrivateVariable" is undefined
problem.ads:10:40: "firstPrivateVariable" is undefined
I have tried putting placeholder definitions above the function, but then I get compilation errors about conflicting definitions.
package Problem is
pragma Elaborate_Body (Problem);
function publicAPI(which : Positive) return Natural with
Pre => secondPrivateVariable > firstPrivateVariable;
-- should only be called when second > first
private
-- the following variables are used by many procedures and
-- should be kept private
firstPrivateVariable : Natural := 7;
secondPrivateVariable : Natural := 465;
end Problem;
Any assistance would be welcomed.
You could wrap the check in a function:
function Call_Permitted return Boolean;
function publicAPI(which : Positive) return Natural with
Pre => Call_Permitted;
private
firstPrivateVariable : Natural := 7;
secondPrivateVariable : Natural := 465;
function Call_Permitted return Boolean is
(secondPrivateVariable > FirstPrivateVariable);
If Call_Permitted is only to be used locally and only to generate object code if assertions are enabled, you could say
function Call_Permitted return Boolean with Ghost;
(this is a SPARK-related feature, probably only available in GNAT)
Related
I am learning Ada and I've hit a design problem. Excuse me as I'm not up with basic Ada mechanisms and idioms.
Let's say I want to represent an operation. Operators can be either plus or minus and operands can be either integers or strings.
Disclaimer: some things may not make much sense on a semantic level (minus on strings, operators without operands, ...) but it's all about representation.
For now I have the following incorrect code:
operand.ads:
package Operand is
-- I want a None for unary operands or operators without operands
type Operand_Type is (Int, Str, None);
-- This needs to be tagged
type Instance (Op_Type : Operand_Type := None) is tagged record
case Op_Type is
when Int =>
Int_Value : Integer;
when Str =>
Str_Value : String (1 .. 10);
when None =>
null;
end case;
end record;
-- Some methods on operands...
end Operand;
operation.ads:
with Operand;
package Operation is
type Operation_Type is (Plus, Minus);
-- This also needs to be tagged
type Instance is tagged record
Left, Right : Operand.Instance;
end record;
-- Some methods on operations...
end Operation;
main.adb:
with Operand;
with Operation;
procedure Main is
Op : Operation.Instance;
begin
Op.Left := (Op_Type => Operand.Int, Int_Value => 1);
Op.Right := (Op_Type => Operand.Int, Int_Value => 3);
end Main;
When I try to compile I get the following errors:
$ gnatmake main.adb
gcc -c main.adb
operand.ads:7:45: discriminants of nonlimited tagged type cannot have defaults
operation.ads:9:28: unconstrained subtype in component declaration
gnatmake: "main.adb" compilation error
I get why I can't use defaults on tagged type's discriminant but I don't really know how to get around this limitation.
Proposal 1:
Stop using variant records and use a record with one field for each operand. But I feel like this is just throwing away code elegance.
Proposal 2:
Remove defaults from Operand.Instance record and constrain Left and Right from Operation.Instance record. But I get a runtime error :
raised CONSTRAINT_ERROR : main.adb:7 discriminant check failed
As I cannot dynamically change discriminant value of a record's field.
Any help would be much appreciated !
Jim Rogers already discussed using inheritance. You can also use composition if you like by creating an internal non tagged type (which allows defaults), make the Operand.Instance type tagged private, have the private implementation use the internal non tagged version, and just add what operations you need to set and get the operands:
with Ada.Text_IO; use Ada.Text_IO;
procedure Hello is
package Operand is
-- I want a None for unary operands or operators without operands
type Operand_Type is (Int, Str, None);
Invalid_Operand : exception;
-- This needs to be tagged
type Instance is tagged private;
function Int_Value(Value : Integer) return Instance;
function Str_Value(Value : String) return Instance;
function Null_Instance return Instance;
function Int_Value(Self : Instance) return Integer;
function Str_Value(Self : Instance) return String;
function Op_Type(Self : Instance) return Operand_Type;
-- Some methods on operands...
private
type Instance_Internal (Op_Type : Operand_Type := None) is record
case Op_Type is
when Int =>
Int_Value : Integer;
when Str =>
Str_Value : String (1 .. 10);
when None =>
null;
end case;
end record;
type Instance is tagged record
Impl : Instance_Internal;
end record;
function Int_Value(Value : Integer) return Instance is (Impl => (Int, Value));
function Str_Value(Value : String) return Instance is (Impl => (Str, Value));
function Null_Instance return Instance is (Impl => (Op_Type => None));
function Int_Value(Self : Instance) return Integer
is (if Self.Impl.Op_Type = Int then Self.Impl.Int_Value else raise Invalid_Operand);
function Str_Value(Self : Instance) return String
is (if Self.Impl.Op_Type = Str then Self.Impl.Str_Value else raise Invalid_Operand);
function Op_Type(Self : Instance) return Operand_Type
is (Self.Impl.Op_Type);
end Operand;
package Operation is
type Operation_Type is (Plus, Minus);
-- This also needs to be tagged
type Instance is tagged record
Left, Right : Operand.Instance;
end record;
-- Some methods on operations...
end Operation;
Op : Operation.Instance;
begin
Put_Line("Hello, world!");
Op.Left := Operand.Int_Value(1);
Op.Right := Operand.Int_Value(3);
Put_Line(Integer'Image(Op.Left.Int_Value));
Put_Line(Integer'Image(Op.Right.Int_Value));
end Hello;
You can break the Operand package into spec and body for better readability, this was just for example.
I recently started learning Ada. I want to see if there's a possibility in creating a Boost::Statechart-like framework in Ada. To do this I need a record structure with a constant access-to-object-of-parent-type component, like a tree node that statically points to another tree node, and the parent pointer must not be changed at all times. Something like this:
-- Not working sample
type Node_T is record
Parent : constant access Node_T;
-- error: constant components are not permitted
end record;
-- I wish to create objects of this type like this
Top_Node : Node_T (null);
Child1_Node : Node_T (Top_Node'Access);
Child2_Node : Node_T (Top_Node'Access);
It seems that constant member fields are not supported in Ada. So I resorted to using access discriminants:
-- Not working sample
type Node_T (Parent : access Node_T) is null record;
-- error: type declaration cannot refer to itself
However, using named-access-type as discriminant works
type Node_T;
type Ref_Node_T is access all Node_T;
type Node_T (Parent : Ref_Node_T) is null record;
However, from what I learned this causes the life-time of Node_T objects to be bound to that of a Ref_Node_T object, rather than another parent Node_T object. Is this true?
Are there any better ways of implementing what I need?
An alternate approach to creating a finite state machine is described in https://www.sigada.org/ada_letters/june2000/sanden.pdf
This solution uses a combination of protected objects and tasks to implement the finite state machine.
An alternate alternate solution for FSM is to use enumerations and arrays, and if you're going to need more than one, generic.
Generic
Type State is (<>); -- Any discrete type.
Type Event is (<>);
Package Finite_State_Machine_Domain is
Type Domain is Array(State, Event) of State;
Generic
Start,
Error : State;
Package Finite_State_Machine is
Type State_Machine is private;
Function Create (State_Map : Domain) return State_Machine;
Function Get_State (Object : in State_Machine) return State;
Procedure Send_Event(Object : in out State_Machine; Transition : in Event);
Private
Type State_Machine is record
Current : State := Start;
State_Map : Domain := (Others => Error);
End record;
End Finite_State_Machine;
End Finite_State_Machine_Domain;
Package Body Finite_State_Machine_Domain is
Package Body Finite_State_Machine is
Function Create (State_Map : Domain) return State_Machine is
( State_Machine'(State_Map => State_Map, Others => <>) );
Function Get_State (Object : in State_Machine) return State is
( Object.Current );
Procedure Send_Event(Object : in out State_Machine; Transition : in Event) is
Begin
if Object.Current /= Error then
Object.Current:= Object.State_Map(Object.Current, Transition);
end if;
End Send_Event;
End Finite_State_Machine;
End Finite_State_Machine_Domain;
I'm kinda new with Ada and recently got an error that I don't seem to know how to solve.
I have the following code:
data.ads
with Text_IO; use text_io;
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
package data is
type file is private;
type file_set is array (Integer range <>) of file;
procedure file_Print (T : in out file); --Not used
private
type file is record
start, deadline : integer;
end record;
end data;
Main.adb
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
procedure Main is
Num_files: integer:=3;
Files:file_set(1..Num_files);
begin
Files(1):=(2,10); -- Expected private type "file" defined at data.ads
for i in 1..Num_Files loop
Put(integer'Image(i));
New_Line;
data.File_Print(Files(i));
But I'm getting this error Expected private type "file" defined at data.ads
How can I access the file type and declare a new array of values in main?
That's right - you don't get to see or manipulate what's inside a private type. That would be breaking encapsulation. Bugs and security risks follow.
You can only interact with a private type via its methods : functions and procedures declared in the package where it's declared.
Now file_set is NOT a private type (you might consider making it private later, for better encapsulation, but for now ....) you can index it to access a file within it (using one of those procedures).
Files(1):=(2,10);
As you want to create a file here, you need a method to create a file ... a bit similar to a constructor in C++, but really more like the Object Factory design pattern. Add this to the package:
function new_file(start, deadline : integer) return file;
And implement it in the package body:
package body data is
function new_file(start, deadline : integer) return file is
begin
-- check these values are valid so we can guarantee a proper file
-- I have NO idea what start, deadline mean, so write your own checks!
-- also there are better ways, using preconditions in Ada-2012
-- without writing explicit checks, but this illustrates the idea
if deadline < NOW or start < 0 then
raise Program_Error;
end if;
return (start => start, deadline => deadline);
end new_file;
procedure file_Print (T : in out file) is ...
end package body;
and that gives the users of your package permission to write
Files(1):= new_file(2,10);
Files(2):= new_file(start => 3, deadline => 15);
but if they attempt to create garbage to exploit your system
Files(3):= new_file(-99,-10); -- Oh no you don't!
this is the ONLY way to create a file, so they can't bypass your checks.
I have the following code, related to the dining philosopher problem. I am very new to Ada so am not sure about how to implement the Id_Dispenser package.
with Ada.Text_IO; use Ada.Text_IO;
with Id_Dispenser;
with Semaphores; use Semaphores;
procedure Philos is
No_of_Philos : constant Positive := 5; -- Number of philosophers
Meditation : constant Duration := 0.0;
type Table_Ix is mod No_of_Philos;
Forks : array (Table_Ix) of Binary_Semaphore (Initially_Available => True);
package Index_Dispenser is new Id_Dispenser (Element => Table_Ix);
use Index_Dispenser;
task type Philo;
task body Philo is
Philo_Nr : Table_Ix; -- Philisopher number
begin
Dispenser.Draw_Id (Id => Philo_Nr);
Put_Line ("Philosopher" & Table_Ix'Image (Philo_Nr) & " looks for forks.");
Forks (Philo_Nr).Wait; delay Meditation; Forks (Philo_Nr + 1).Wait;
Put_Line ("Philosopher" & Table_Ix'Image (Philo_Nr) & " eats.");
Forks (Philo_Nr).Signal; Forks (Philo_Nr + 1).Signal;
Put_Line ("Philosopher" & Table_Ix'Image (Philo_Nr) & " dropped forks.");
end Philo;
Table : array (Table_Ix) of Philo; pragma Unreferenced (Table);
begin
null;
end Philos;
I have implemented the following semaphore, which I think should be correct
package body semaphores is
protected body Binary_Semaphore is
entry Wait when Count > 0 is
begin
Count := Count - 1;
end Wait;
entry Release when Count < 1 is
begin
Count := Count + 1;
end Signal
end Binary_Semaphore;
end semaphores;
What does the Id_Dispenser need?
Looking at your code,
type Table_Ix is mod No_of_Philos;
...
package Index_Dispenser is new Id_Dispenser (Element => Table_Ix);
we can tell that Id_Dispenser is a generic package with a formal type named Element, and that the formal type is modular:
generic
type Element is mod <>;
package Id_Dispenser is
This
Philo_Nr : Table_Ix; -- Philisopher number
begin
Dispenser.Draw_Id (Id => Philo_Nr);
tells us that Id_Dispenser has some sort of component called Dispenser with a subprogram Draw_Id with an out parameter named Id which returns an Element.
Now, since this is a concurrent program, I'm going to guess that Dispenser is a protected object:
protected Dispenser is
procedure Draw_Id (Id : out Element);
private
...
end Dispenser;
The private part could simply be an array of Boolean indexed by Element,
Available : array (Element) of Boolean := (others => True);
but unfortunately you can't have an anonymous array as a component, so you need a proper type, giving
generic
type Element is mod <>;
package Id_Dispenser is
type Availability is array (Element) of Boolean;
protected Dispenser is
procedure Draw_Id (Id : out Element);
private
Available : Availability := (others => True);
end Dispenser;
end Id_Dispenser;
I'm not happy that the type Availability is visible, but the package now just needs implementing (!)
We could make Availability invisible by making Id_Dispenser.Dispenser a package, with Availability and the actual PO declared in the body. But that may be getting a little too purist for Ben’s context.
Firstly, you shouldn't really shorten identifiers, so you should have task type Philosophers... You can always use a renaming later on.
Shouldn't you model the forks and the philosophers? Each Philosopher as a task (hint array of task types).
Look at protected objects to model the forks.
Id_dispenser needs to implement a Draw_ID method.
Since the Dispenser variable is not declared here, it must presumably be declared in Id_dispenser. This hidden declaration is not very good style, as you can see it causes confusion; I would use a qualified name to make it obvious where it came from, as Index_Dispenser.Dispenser (which can then be renamed to reduce clutter in the rest of the code).
Id_dispenser may also need to provide an object factory method to initialise the Dispenser variable at its declaration.
Or, the intent may be that Dispenser will be the only one of its type, in which case you can treat Id_dispenser as a singleton package with Dispenser as the only object.
I'm interfacing to a USB device (on Debian Stretch) using hidraw, and I need to process some information supplied by the USB device in the form of wchar_t* which I need to convert into (Ada) Wide_String. This is giving some trouble and I'm not seeing a clean way forward using the facilities in Interfaces.C and Interfaces.C.Strings.
All files are edited down without destroying their consistency. They will build, but without one of these, they won't actually run.
The problem is that device information like Serial Number and Product Name are presented by the Linux device driver as an access stddef_h.wchar_t from which I want to return a Wide_String or even a normal String) and I'm not seeing any good way to get there.
Interfaces.C.Strings has function Value (Item : in chars_ptr) return String; but no equivalent exists for Wide_String that I can see. So I think I need an equivalent Value function for wide characters.
The approach below uses To_Ada (from Interfaces.C) to return a Wide_String given a wchar_array. It fails, of course, because an access wchar_t is not convertible to a wchar_array.
-- helper function to deal with wchar_t * to wide_string
function Value (P : access stddef_h.wchar_t) return Wide_String is
temp : Wide_String(1 .. 256);
count : natural := 0;
-- ugliness to convert pointer types
type sd_wchar_ptr is access all stddef_h.wchar_t;
type wchar_array_ptr is access wchar_array;
Function To_Wchar_Array_Ptr is new Ada.Unchecked_Conversion(sd_wchar_ptr, wchar_array_ptr);
-- this does NOT create the required wchar_array pointer
WCP : wchar_array_ptr := To_Wchar_Array_Ptr(sd_wchar_ptr(P));
begin
Put_Line("Wide string");
To_Ada(WCP.all, temp, count);
Put_Line("Wide string length " & natural'image(count));
return temp(1..count);
end Value;
and the inevitable result
./test_hid
Wide string
Execution terminated by unhandled exception raised STORAGE_ERROR :
stack overflow or erroneous memory access
A similar character by character approach would be possible ... if (and I can't believe I'm saying this!) you could increment access types...
Feels like there's something missing from Interfaces.C here... what am I missing? any ideas to get round this relatively trivial seeming stumbling block?
EDIT : I'm leaning towards some brazen theft from the Interfaces.C.Strings sources with appropriate changes, but I'd welcome alternative suggestions.
The rest of this below is the full story so far (including all code necessary to reproduce)
Step 1 : generate low level Ada bindings automatically using gcc.
gcc -c -fdump-ada-spec-slim /usr/include/hidapi/hidapi.h
producing the low level binding package hidapi_hidapi_h
pragma Ada_2005;
pragma Style_Checks (Off);
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings;
with stddef_h;
with System;
package hidapi_hidapi_h is
-- see source file /usr/include/hidapi/hidapi.h
type hid_device_info is record
path : Interfaces.C.Strings.chars_ptr; -- /usr/include/hidapi/hidapi.h:51
vendor_id : aliased unsigned_short; -- /usr/include/hidapi/hidapi.h:53
product_id : aliased unsigned_short; -- /usr/include/hidapi/hidapi.h:55
serial_number : access stddef_h.wchar_t; -- /usr/include/hidapi/hidapi.h:57
release_number : aliased unsigned_short; -- /usr/include/hidapi/hidapi.h:60
manufacturer_string : access stddef_h.wchar_t; -- /usr/include/hidapi/hidapi.h:62
product_string : access stddef_h.wchar_t; -- /usr/include/hidapi/hidapi.h:64
usage_page : aliased unsigned_short; -- /usr/include/hidapi/hidapi.h:67
usage : aliased unsigned_short; -- /usr/include/hidapi/hidapi.h:70
interface_number : aliased int; -- /usr/include/hidapi/hidapi.h:75
next : access hid_device_info; -- /usr/include/hidapi/hidapi.h:78
end record;
pragma Convention (C_Pass_By_Copy, hid_device_info); -- /usr/include/hidapi/hidapi.h:49
function hid_enumerate (arg1 : unsigned_short; arg2 : unsigned_short) return access hid_device_info; -- /usr/include/hidapi/hidapi.h:132
pragma Import (C, hid_enumerate, "hid_enumerate");
end hidapi_hidapi_h;
This is a low level binding, exposing C types (and the binding generator has decided that the wchar_t in Interfaces.C isn't good enough, it wants one from stddef.h too, so...
pragma Ada_2005;
pragma Style_Checks (Off);
with Interfaces.C; use Interfaces.C;
package stddef_h is
-- unsupported macro: NULL ((void *)0)
subtype size_t is unsigned_long; -- /usr/lib/gcc/x86_64-linux-gnu/6/include/stddef.h:216
subtype wchar_t is int; -- /usr/lib/gcc/x86_64-linux-gnu/6/include/stddef.h:328
end stddef_h;
Because it is a low level binding; we want to hide it (and implement RAII etc) behind a simpler and more usable high level binding, so ... (below)
with Ada.Finalization; use Ada.Finalization;
private with hidapi_hidapi_h;
private with System;
package hidapi is
type id is new natural range 0 .. 2**16 - 1;
type hid_device is new Limited_Controlled with private;
-- find first matching devices by enumeration : the RA part of RAII.
function enumerate (vendor_id, product_id : id) return hid_device;
-- accessors for device characteristics on enumerated device
function Serial_No (D : hid_device) return Wide_String;
function Product_String (D : hid_device) return Wide_String;
private
type hid_device is new Limited_Controlled with record
member : access hidapi_hidapi_h.hid_device_info;
addr : System.Address;
end record;
end hidapi;
and its implementation, containing the problem function value to return a Wide_String.
with hidapi_hidapi_h;
with Interfaces.C; use Interfaces.C;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Conversion;
with stddef_h;
package body hidapi is
function enumerate (vendor_id, product_id : id) return hid_device is
use hidapi_hidapi_h;
first : access hid_device_info;
begin
first := hid_enumerate(unsigned_short(vendor_id), unsigned_short(product_id));
if first /= null then
return H : hid_device do
H.member := first;
H.addr := System.Null_Address;
end return;
else raise Program_Error;
end if;
end enumerate;
-- helper function to deal with wchar_t * to wide_string
function Value (P : access stddef_h.wchar_t) return Wide_String is
temp : Wide_String(1 .. 256);
count : natural := 0;
type sd_wchar_ptr is access all stddef_h.wchar_t;
type wchar_array_ptr is access wchar_array;
Function To_Wchar_Array_Ptr is new Ada.Unchecked_Conversion(sd_wchar_ptr, wchar_array_ptr);
WCP : wchar_array_ptr := To_Wchar_Array_Ptr(sd_wchar_ptr(P));
begin
Put_Line("Wide string");
To_Ada(WCP.all, temp, count);
Put_Line("Wide string length " & natural'image(count));
return temp(1..count);
end Value;
function Serial_No (D : hid_device) return Wide_String is
use hidapi_hidapi_h;
begin
return Value(D.member.serial_number);
end Serial_No;
function Product_String (D : hid_device) return Wide_String is
use hidapi_hidapi_h;
begin
return Value(D.member.product_string);
end Product_String;
end hidapi;
And of course a test case to exercise it...
with Hidapi;
with Ada.Wide_Text_IO;
procedure Test_Hid is
usbrelay_vendor_id : constant Hidapi.id := 16#16c0#;
usbrelay_product_id : constant Hidapi.id := 16#05df#;
Device : Hidapi.hid_device := Hidapi.Enumerate(usbrelay_vendor_id, usbrelay_product_id);
begin
Ada.Wide_Text_IO.Put_Line("Serial : " & Device.Serial_No);
Ada.Wide_Text_IO.Put_Line("Product : " & Device.Product_String);
end Test_Hid;
One answer, slavishly copying the approach in the package body for Tnterfaces.C.Strings with necessary changes.
The naughty stuff is in functions "+" and Peek which use Unchecked Conversions on pointers,
to permit address arithmetic. Not pointer increment, but pointer+offset. One change is that the offset has to be scaled for 4 byte characters. I haven't set that scaling in a portable manner, but note that "+" will overload for each different return type so that offsets will be scaled appropriately for different named access types.
to allow the stddef_h.wchar_t to be viewed as a Wide_Wide_Character in the absence of any type conversion function. Whether the representation is correct is another matter (here, it is) but this technique could also be used to fake the input type of a suitable conversion function like To_Ada in Interfaces.C.
The remainder is straightforward character by character handling. One other change (so far) is to return Wide_Wide_Character rather than Wide_Character (because as the stddef_h package above reveals, the stored characters are 32 bit, same size as Interfaces.C.int. I'm happy to change my interface, but Wide_String could be easily handled by Ada.Strings packages.
type sd_wchar_ptr is access all stddef_h.wchar_t;
type w_w_char_ptr is access all char32_t;
-- Two Unchecked_Conversions to allow pointer arithmetic
-- And a third to allow the resulting storage to be interpreted as Wide_Wide_Char
function To_Sd_wchar_ptr is new Ada.Unchecked_Conversion (System.Address, sd_wchar_ptr);
function To_Address is new Ada.Unchecked_Conversion (sd_wchar_ptr, System.Address);
function To_Wchar_Ptr is new Ada.Unchecked_Conversion (sd_wchar_ptr, w_w_char_ptr);
-- pointer + offset arithmetic, with offset scaled for size of stddef_h.wchar_t;
-- TODO: attempted better way of computing word size ran into type errors
function "+" (Left : sd_wchar_ptr; Right : size_t) return sd_wchar_ptr is
begin
return To_Sd_wchar_ptr (To_Address (Left) + Storage_Offset (Right) * 4);
end "+";
function Peek (From : sd_wchar_ptr) return char32_t is
begin
return To_Wchar_Ptr(From).all;
end Peek;
function Strlen (Item : sd_wchar_ptr) return size_t is
Item_Index : size_t := 0;
begin
if Item = Null then
raise Program_Error;
end if;
loop
if Peek (Item + Item_Index) = char32_nul then
return Item_Index;
end if;
Item_Index := Item_Index + 1;
end loop;
end Strlen;
function Value (Item : sd_wchar_ptr) return char32_array is
Result : char32_array (0 .. Strlen (Item));
begin
if Item = Null then
raise Program_Error;
end if;
Put_Line("String length " & size_t'image(Strlen(Item)));
-- Note that the following loop will also copy the terminating Nul
for J in Result'Range loop
Result (J) := Peek (Item + J);
end loop;
return Result;
end Value;
-- helper function to deal with wchar_t * to wide_wide_string
function Value (Item : access stddef_h.wchar_t) return Wide_Wide_String is
begin
return To_Ada (Value (sd_wchar_ptr(Item)));
end Value;