I'm trying to write the flow dependency of a procedure in Ada and Spark 2014 and the compiler give me a medium warning that
medium: missing dependency "null => MyBool"
medium: incorrect dependency "MyBool => MyBool"
Here is my .ads file:
SPARK_Mode (On);
package TestDep is
pragma Elaborate_Body;
MyBool: Boolean := False;
procedure ToFalse with
Global => (In_Out => MyBool),
Depends => (MyBool =>+ null),
Pre => (MyBool = True),
Post => (MyBool = False);
end TestDep;
and in the .adb:
pragma SPARK_Mode (On);
package body TestDep is
procedure ToFalse is
begin
MyBool := False;
end ToFalse;
end TestDep;
I'm new to Ada and Spark and I'm still learning it, but from the AdaCore documentation I've saw that Depends => (X =>+ null) should indicate that the value of X at the end of the procedure only depends on the value of X and nothing else.
Why does the compiler give me those warning ? Am I doing something wrong ?
Related
I have this code in utils-file.ads,
package Utils.File with
SPARK_Mode
is
procedure Read_Content (File_Name : String);
end Utils.File;
and the corresponding utils-file.adb
with Interfaces;
with Ada.Sequential_IO;
package body Utils.File with
SPARK_Mode => Off
is
package Seq is new Ada.Sequential_IO (Interfaces.Unsigned_8);
procedure Read_Content (File_Name : String) with
SPARK_Mode => Off
is
Handle : Seq.File_Type;
Item : Interfaces.Unsigned_8 := 0;
begin
Seq.Open (Handle, Seq.In_File, File_Name);
Seq.Read (Handle, Item);
Seq.Close (Handle);
end Read_Content;
end Utils.File;
I try to call it from my main program,
with Utils.File;
procedure Main with
SPARK_Mode => On
is
begin
Utils.File.Read_Content ("foo.bin");
end Main;
When I run gnatprove, I get this error
main.adb:7:15: medium: "memory accessed through objects of access type" might not be initialized after elaboration of main program "Main"
It doesn't give that error if I use Text_IO instead of Sequential_IO, but I want to read it as binary and not text. What is it complaining about and how do I fix it?
How to incorporate proof aspects into the specification so that every function and procedure has a Post aspect and, if required, a Pre aspect that outlines the proper behaviour of the code below:
package Stack with SPARK_Mode is
pragma Elaborate_Body;
Stack_Size : constant := 100;
type Pointer_Range is range 0 .. Stack_Size;
subtype Index_Range is Pointer_Range range 1 .. Stack_Size;
type Vector is array(Index_Range) of Integer;
S: Vector;
Pointer: Pointer_Range;
function isEmpty return Boolean;
procedure Push(X : in Integer)
with
Global => (In_out => (S, Pointer)),
Depends => (S => (S, Pointer, X),
Pointer => Pointer);
procedure Pop(X : out Integer)
with
Global => (input => S, in_out => Pointer),
Depends => (Pointer => Pointer,
X => (S, Pointer));
end Stack;
Following is a possible set of post conditions and pre conditions for your example. The actual set must depend upon actual requirements for your stack behavior. This example is simply a typical set of conditions for the stack.
package Stack with SPARK_MODE is
pragma Elaborate_Body;
Stack_Size : constant := 100;
type Pointer_Range is range 0 .. Stack_Size;
subtype Index_Range is Pointer_Range range 1..Stack_Size;
type Vector is array (Index_Range) of Integer;
S : Vector;
Pointer : Pointer_Range := 0;
function isEmpty return Boolean with
Post => IsEmpty'Result = (if Pointer = 0 then True else False);
procedure Push(X : in Integer) with
Global => (In_Out => (S, Pointer)),
Depends => (S => (S, Pointer, X), Pointer => Pointer),
Pre => Pointer < Stack_Size,
Post => Pointer = Pointer'Old + 1 and S(Pointer) = X;
procedure Pop(X : out Integer) with
Global => (In_Out => (S, Pointer)),
Depends => (Pointer => Pointer,
X => (S, Pointer),
S => S),
Pre => not isEmpty,
Post => Pointer = Pointer'Old - 1 and X = S(Pointer'Old);
end Stack;
In brief, you should add a Post-condition aspect to every subprogram in the package, and a Pre-condition aspect to those subprograms that need it.
Preconditions and postconditions in Ada are explained at http://www.ada-auth.org/standards/22rm/html/RM-6-1-1.html.
What is your problem, really? Is it about the syntax of the pre/post-condition aspects, or about their content and meaning? Or is it about the meaning of "proper behaviour" in the problem statement? In the last case, try to imagine what might be improper behaviour, or incorrect use, of a Push or Pop operation on a stack with a fixed maximum size.
I've tried searching the docs and the code, but I'm unable to find what this is and therefore how to correct it.
Scenario:
I'm using the Ada SPARK vectors library and I have the following code:
package MyPackage
with SPARK_Mode => On
is
package New_Vectors is new Formal_Vectors (Index_Type => test, Element_Type => My_Element.Object);
type Object is private;
private
type Object is
record
Data : New_Vectors.Vector (Block_Vectors.Last_Count);
Identifier : Identifier_Range;
end record;
I get the error when the code calls:
function Make (Identifier : Identifier_Range) return Object is
begin
return (
Data => New_Vectors.Empty_Vector,
Identifier => Identifier);
end Make;
Pointing to Empty_Vector. The difficulty is that Empty_Vector defines the Capacity as 0 which appears to be leading to the problem. Now I'm not sure then how to deal with that as Capacity seems to be in the type definition (having looked in a-cofove.ads).
So basically I'm stuck as to how to resolve this; or quite how to spot this happening in future.
Your analysis is correct. The error occurs because you attempt to assign an empty vector (i.e. a vector with capacity 0) to a vector with capacity Block_Vectors.Last_Count (which appears to be non-zero).
You actually do not need to initialize the vector explicitly in order to use it. A default initialization (using <>, see, for example, here) suffices as shown in de example below.
However, in order to prove the absence of runtime errors, you do need to explicitly clear the vector using Clear. The Empty_Vector function can then be used to in assertions that check if a vector is empty or not as shown in the example below. The example can be shown to be free of runtime errors using gnatprove. For example by opening the prove settings via menu SPARK > Prove in GNAT Studio, selecting "Report checks moved" in the "General" section (top left) and then running the analysis by selecting "Execute" (bottom right).
main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Containers.Formal_Vectors;
procedure Main with SPARK_Mode is
package My_Vectors is new Ada.Containers.Formal_Vectors
(Index_Type => Natural,
Element_Type => Integer);
use My_Vectors;
type Object is record
Data : Vector (Capacity => 10); -- Max. # of elements: 10
Value : Integer;
end record;
-- Initialize with default value (i.e. <>), no explicit initialization needed.
Obj : Object :=
(Data => <>,
Value => 42);
begin
-- Clear the vector, required for the assertions to be proven.
Clear (Obj.Data);
-- Assert that the vector is not empty.
pragma Assert (Obj.Data = Empty_Vector);
-- Populate the vector with some elements.
Append (Obj.Data, 4);
Append (Obj.Data, 5);
Append (Obj.Data, 6);
-- Assert that the vector is populated.
pragma Assert (Obj.Data /= Empty_Vector);
-- Show the contents of Obj.Data.
Put_Line ("Contents of Obj.Data:");
for I in Natural range 0 .. Natural (Length (Obj.Data)) - 1 loop
Put_Line ("[" & I'Image & "]" & Element (Obj.Data, I)'Image);
end loop;
New_Line;
-- or, alternatively using an iterator ...
declare
I : Extended_Index := Iter_First (Obj.Data);
begin
while Iter_Has_Element (Obj.Data, I) loop
Put_Line ("[" & I'Image & "]" & Element (Obj.Data, I)'Image);
I := Iter_Next (Obj.Data, I);
end loop;
end;
New_Line;
-- Show the contents of Obj.Value.
Put_Line ("Contents of Obj.Value:");
Put_Line (Obj.Value'Image);
New_Line;
end Main;
output
Contents of Obj.Data:
[ 0] 4
[ 1] 5
[ 2] 6
[ 0] 4
[ 1] 5
[ 2] 6
Contents of Obj.Value:
42
I'm working through the example here: https://www.adahome.com/rm95/rm9x-12-08.html
I've written my generic_stack.ads:
generic
type Item_Type is private;
size : Positive;
package Generic_Stack is
procedure push( item : in Item_Type );
function pop return Item_Type;
function is_Empty return Boolean;
STACK_EMPTY : exception;
STACK_FULL : exception;
end Generic_Stack;
And my generic_stack.adb:
package body Generic_Stack
is
type Stack_Table is array (Positive range <>) of Item_Type;
nodes : Stack_Table( 1..size );
index : Natural := 0;
procedure push( item : in Item_Type )
is
begin
if ( index < size )
then
index := index + 1;
nodes(index) := item;
else
raise STACK_FULL;
end if;
end push;
function pop()
return
Item_Type
is
item : Item_Type;
begin
if ( index > 0 )
then
item := nodes( index );
index := index - 1;
else
raise STACK_EMPTY;
end if;
return item;
end pop;
-- function is_Empty() removed for the sake of brevity
end Generic_Stack;
I don't really understand how to actually use the Generic_Stack.
With the simple generic_stack_test.adb code:
with Generic_Stack;
package Stack_Int_Type is new Generic_Stack( Item_Type => Integer, Size => 32 );
procedure Generic_Stack_Test
is
stack : Stack_Int_Type;
begin
stack.push( 3 );
end Generic_Stack_Test;
Gnat gives me errors on compilation:
# gnat make -gnat95 generic_stack_test.adb -o generic_stack_test
x86_64-linux-gnu-gcc-8 -c -gnat95 generic_stack_test.adb
generic_stack_test.adb:9:08: keyword "body" expected here [see file name]
generic_stack_test.adb:20:24: missing "end Stack_Int_Type;"
x86_64-linux-gnu-gnatmake-8: "generic_stack_test.adb" compilation error
Do I have to declare the Stack_Int_Type or suchlike? I don't understand how to use a declare inside a procedure. If I pass a Stack_Int_Type to another procedure, does it have to declare the type too?
Is it possible to simply declare Stack_Int_Type once in an .ads, and use it as a regular type? My book and web-pages kind of suggest it has to be declared every time, which sounds onerous.
Your test code is actually two library items:
with Generic_Stack;
package Stack_Int_Type is new Generic_Stack( Item_Type => Integer, Size => 32 );
declares a library package Stack_Int_Type, and
procedure Generic_Stack_Test
is
stack : Stack_Int_Type;
begin
stack.push( 3 );
end Generic_Stack_Test;
declares a library procedure which, as it stands, knows nothing about Stack_Int_Type.
We can fix that by adding the necessary with, but (compiling with -gnatl)
1. with Stack_Int_Type;
2. procedure Generic_Stack_Test
3. is
4. stack : Stack_Int_Type;
|
>>> subtype mark required in this context
>>> found "Stack_Int_Type" declared at stack_int_type.ads:2
5. begin
6. stack.push( 3 );
1 2
>>> invalid prefix in selected component "stack"
>>> prefixed call is only allowed for objects of a tagged type
7. end Generic_Stack_Test;
What’s happening here is that Generic_Stack doesn’t declare a type, so you can’t declare an instance of it at line 4; it’s a sort of singleton. (Amongst other things, that means it’s confusingly named: I’d’ve called it Integer_Stack. Never call a package _Type; _Types, maybe.)
Fixing that,
with Generic_Stack;
package Integer_Stack is new Generic_Stack( Item_Type => Integer, Size => 32 );
and
with Integer_Stack;
procedure Generic_Stack_Test
is
begin
Integer_Stack.push( 3 );
end Generic_Stack_Test;
You could have made Integer_Stack local:
with Generic_Stack;
procedure Generic_Stack_Test
is
package Integer_Stack
is new Generic_Stack( Item_Type => Integer, Size => 32 );
begin
Integer_Stack.push( 3 );
end Generic_Stack_Test;
Your Generic_Stack package never defines a stack data type.
The procedure Push and Pop are operations on a stack. You must have a type upon which to operate. There are two general categories of stacks; bounded stacks and unbounded stacks. You must decide which kind of stack you wish to create.
A discussion of both kinds of stacks implemented in Ada can be found at https://sworthodoxy.blogspot.com/2019/02/stack-abstract-data-type-using-ada.html
In the examples referenced in the URL above you will see how to create stack types that can be used multiple times. The example from Adahome is an old and problematic example. You have identified the biggest problem.
As explained elsewhere, no type is defined by your package specification. Otherwise, you would have type ... is somewhere after the package keyword. It's that simple.
But as explained elsewhere too, it's not dramatic. Your package instantiation will define exactly one stack, and not a type to be used in multiple places. In some cases, it's exactly what you need. So, your could call your instantiated package My_Stack, which actually articulates around an object (My_Stack.nodes, accessible only through Push & Pop).
You need to do the instantiation of Generic_Stack from within a unit (procedure, package, ...). Outside of it, it is the "outer space" only with with and use clauses needed to connect with other units.
with Generic_Stack;
procedure Generic_Stack_Test
is
package My_Stack is new Generic_Stack( Item_Type => Integer, Size => 32 );
begin
My_Stack.push( 3 );
end Generic_Stack_Test;
How do I fix this Seg Fault in my DLL?
I'm generating a Windows DLL (in Ada) and using the DLL from an Ada
program. I’m using AdaCore’s GNAT GPS v6.0.1 IDE for both the DLL
and an Ada program to test the DLL, running on a Windows 7 machine.
Two separate project files are used, one for the DLL, the other for
the test driver. The DLL does not have any DLLMain nor initialization
or finalization routines.
As a first step (because I've never created a DLL or used GPS prior to this, do know some Ada though), I coded two very simple functions for the DLL. One function returns a pointer to a string, the other function returns a fixed length string.
The test program successfully calls the DLL function that returns a fixed-length
string, however when calling the function that returns a string pointer, a
segmentation fault occurs. Here is the gcc debug output:
Program received signal SIGSEGV, Segmentation fault.
0x6b81dd2c in system.secondary_stack.ss_mark () from C:\GNAT\2014\bin\libgnat-2014.dll
(gdb) quit
Here is the code:
DLL Spec
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
package String_Utils is
type String_Ptr_T is access String;
type Spec_Str is new String (1..7);
function Int_Trim_Left( IntToTrim : Integer) return String_Ptr_T;
pragma Export(DLL, Int_Trim_Left, "String_Utils__Int_Trim_Left");
function Spec( Input_Int : Integer) return Spec_Str;
pragma Export(DLL, Spec, "String_Utils__Spec");
end String_Utils;
DLL Body
package body String_Utils is
function Int_Trim_Left( IntToTrim : Integer) return String_Ptr_T is
String_Ptr : String_Ptr_T;
begin
Text_IO.Put_Line("About to call new String in DLL.");
String_Ptr := new String'(
Ada.Strings.Fixed.Trim(Integer'Image(IntToTrim),
Ada.Strings.Left));
return String_Ptr;
end;
--
function Spec( Input_Int : Integer) return Spec_Str
is
Result_Spec : String := "ABC-UNK";
begin
case Input_Int is
when 1 => return "ABC-STD"; -- Standard
when 2 => return "ABC-PRF"; -- Performance
when 3 => return "DEF-DTL"; -- Detailed
when Others => return "ABC-UNK";
end case;
end;
DLL Project File
project HAGUtils is
for Library_Name use "HAGUtils";
for Library_Dir use "libdir";
for Library_Version use "0.01";
for Library_Kind use "dynamic";
for Object_Dir use "obj";
for Source_Dirs use ("src");
for Source_Files use ("string_utils.adb", "string_utils.ads");
end HAGUtils;
Test Driver
-- Driver for DLL
with Text_IO; use Text_IO;
procedure test_ada_dll is
type String_Ptr_T is access String;
subtype String7 is String(1..7);
input_val : Integer := 0;
Spec_Str : String7 := (Others => ' ');
Int_String_Ptr : String_Ptr_T:= null;
-- Import
function Int_Trim_Left ( IntToTrim : Integer) return String_Ptr_T
is
function Inner_Int_Trim_Left ( IntToTrim : Integer) return String_Ptr_T;
pragma Import (DLL, Inner_Int_Trim_Left, "String_Utils__Int_Trim_Left");
begin
return Inner_Int_Trim_Left (IntToTrim);
end Int_Trim_Left;
-- Import
function Spec ( Input_Int : Integer) return String7
is
function Inner_Spec ( Input_Int : Integer) return String7;
pragma Import (DLL, Inner_Spec, "String_Utils__Spec");
begin
return Inner_Spec (Input_Int);
end Spec;
begin
input_val := 3;
Spec_Str := Spec(input_val);
Text_IO.Put_Line("The Spec is -- " & Spec_Str);
Text_IO.Put_Line("Calling Int_Trim_Left with --" & Integer'Image(input_val));
Int_String_Ptr := Int_Trim_Left(input_val);
Text_IO.Put_Line("After call --" & Int_String_Ptr.all);
end;
I think that the SEGV happened because your DLL wasn’t initialized. The Ada runtime system needs initialization, which in the absence of DLLs would be called up in the GNAT bind process (you may have seen calls to gnatbind or gprbind flashing up the screen).
However, you have a DLL that requires the RTS to be initialized (the part that deals with the secondary stack, which is where GNAT constructs temporary unconstrained objects such as strings); but the binder isn’t aware of this because of the way you’ve linked your program (you don’t say, but I suspect you’ve specified the DLL via -lHAGutils?).
The way to get GNAT to handle this for you is to write a project file for the test program and have it with your DLL’s project:
with "HAGutils";
project Test_Ada_Dll is
for Main use ("test_ada_dll.adb");
for Exec_Dir use ".";
for Source_Files use ("test_ada_dll.adb");
for Object_Dir use ".build";
end Test_Ada_Dll;
This then makes the interfaces of HAGlib visible to test_ada_dll, so you can change it to say
with Text_IO; use Text_IO;
with String_Utils;
procedure test_ada_dll is
input_val : Integer := 0;
Spec_Str : String_Utils.Spec_Str := (Others => ' ');
Int_String_Ptr : String_Utils.String_Ptr_T:= null;
begin
input_val := 3;
Spec_Str := String_Utils.Spec(input_val);
Text_IO.Put_Line("The Spec is -- " & String (Spec_Str));
Text_IO.Put_Line("Calling Int_Trim_Left with --" & Integer'Image(input_val));
Int_String_Ptr := String_Utils.Int_Trim_Left(input_val);
Text_IO.Put_Line("After call --" & Int_String_Ptr.all);
end;
(note, the conversion in Text_IO.Put_Line("The Spec is -- " & String (Spec_Str)); is because Spec_Str is a derived type; I think it’s be more normal in this case to make it a subtype).
Further, you no longer need to use the pragma Exports in String_Utils’s spec.
The result of this is that the binder is aware of the properties of your HAGutils DLL, and can arrange for the necessary initializations to happen.
There is a way in which you can make your original code work, which is to use the GPR attribute Library_Auto_Init in HAGutils.gpr:
for Library_Auto_Init use “true”;
but I think you’d have to make HAGlib a proper standalone library. This is quite complex to get right, and not necessary to get the library working to start with.