Is there a way to specify a custom error/on failure message for pre- and postconditions, by analogy with Predicate_Failure for predicates? I can't seem to be able to find anything in the official documentation. TIA.
You could use a raise expression (see e.g here) as shown in the example below.
main.adb
pragma Assertion_Policy (Check);
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;
function Reciprocal (X : Float) return Float is (1.0 / X)
with Pre => (X /= 0.0 or else
raise Constraint_Error with "X must not be 0.");
begin
FIO.Put (Reciprocal (2.0));
TIO.New_Line;
FIO.Put (Reciprocal (0.0));
TIO.New_Line;
end Main;
output
$ ./obj/main
5.00000E-01
raised CONSTRAINT_ERROR : X must not be 0.
[2020-07-03 22:20:25] process exited with status 1, elapsed time: 00.32s
Related
In this page, John Barnes writes:
If the conditional expression is the argument of a type conversion then effectively the conversion is considered pushed down to the dependent expressions. Thus
X := Float(if P then A else B);
is equivalent to
X := (if P then Float(A) else Float(B));
So why can't I compile the following program under GNAT 10.3.0?
procedure Main is
P : Boolean := True;
X : Float;
begin
X := Float (if P then 0.5 else 32);
end Main;
Compile
[Ada] main.adb
main.adb:5:35: expected a real type
main.adb:5:35: found type universal integer
gprbuild: *** compilation phase failed
Because you’ve found a long-standing error in the compiler! (same behaviour in GCC 12.1.0).
John Barnes’ justification is at AARM 4.5.7(10ff).
thanks for providing real code and the error messages!
I was expecting this program to raise an error when I feed it 3 as a valid Scale value, but no such luck:
with Ada.Text_IO; use Ada.Text_IO;
procedure predicate is
type Scale is new Integer
with Dynamic_Predicate => Scale in 1 | 2 | 4 | 8;
GivesWarning : Scale := 3; -- gives warning
begin
Put_Line ("Hello World");
loop
Put_Line ("Gimme a value");
declare
AnyValue : Integer := Integer'Value (Get_Line);
S : Scale := Scale (AnyValue); -- no check done!
begin
Put_Line ("okay, that works" & S'Image);
end;
end loop;
end predicate;
I found this related question, but there the requirement is to use an enum., and the solution is to define an array from enum -> value.
I want something that gives me at least a warning at compile time, and allows me to check at runtime as well, and that raises an error if I try to put an invalid value in. Then, if I can use SPARK to prove that no invalid values can occur, I could turn off said checks. I was under the impression that this was how Static_ / Dynamic_ predicates work, so the example above took me by surprise.
You need to enable assertions. Either compile with -gnata or set an appropriate Assertion_Policy
pragma Assertion_Policy(Dynamic_Predicate => Check);
Issue:
How do I save an Access Pointer to a discriminant record for use later on in the program?
In main.adb (1) I demonstrate how I was able to get it to compile, but I get a runtime error:
raised PROGRAM_ERROR : main.adb:14 accessibility check failed
Note:
This is small example program based on a much larger/complex codebase.
Constraints:
i. The solution is required to be Ada95 Compatible.
ii. The solution must not change the package specification of Foo.ads as this is existing code that must be used as-is.
foo.ads
with Interfaces;
package Foo is
type Base_Class is abstract tagged limited private;
type Base_Class_Ref is access all Base_Class'Class;
for Base_Class_Ref'Storage_Size use 0;
Max_Count : constant := 6;
type Count_Type is new Interfaces.Unsigned_16 range 1 .. Max_Count;
type Foo_Class (Max : Count_Type) is new Base_Class with private;
type Foo_Class_Ref is access all Foo_Class;
for Foo_Class_Ref'Storage_Size use 0;
--
procedure Initialize (This_Ptr : Access Foo_Class);
--
function Get_Using_Pointer (This_Ptr : in Foo_Class_Ref) return Interfaces.Unsigned_16;
private
type Base_Class is abstract tagged limited null record;
type My_Data_Type is
record
X, Y, Z : Interfaces.Unsigned_16;
end record;
type My_Data_Array is
array (Count_Type range <>) of My_Data_Type;
type Foo_Class (Max : Count_Type) is new Base_Class with
record
Other_Data : Interfaces.Unsigned_16;
Data : My_Data_Array(1 .. Max);
end record;
end Foo;
foo.adb
package body Foo is
-- --------------------------------------------------------------------
procedure Initialize (This_Ptr : Access Foo_Class) is
begin
This_Ptr.Other_Data := 0;
This_Ptr.Data := (others => (0,0,0));
end Initialize;
-- --------------------------------------------------------------------
function Get_Using_Pointer (This_Ptr : in Foo_Class_Ref)
return Interfaces.Unsigned_16 is
begin
return This_Ptr.Other_Data;
end Get_Using_Pointer;
end Foo;
main.adb
-------------------------------------------------------------------------------
--
-- Issue:
-- How do I save an Access Pointer for later use (1) to a discriminent record?
--
-- Constraints:
-- i. The solution is required to be Ada95 Compatible.
-- ii. The solution must not change the package specification of Foo.ads
--
-------------------------------------------------------------------------------
--
with Interfaces;
with Foo;
procedure Main is
Foo_Count : constant := 3;
Foo_Obj : aliased Foo.Foo_Class (Max => Foo_Count);
procedure TEST (This_Ptr : access Foo.Foo_Class) is
-- (1) Save Pointer
-- **** This Line reports: ****
-- raised PROGRAM_ERROR : main.adb:14 accessibility check failed
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Access; -- This Compiles...
-- ^^^ I know that this is not correct.
-- But it was the only way I could find to get it to compile.
Data : Interfaces.Unsigned_16;
begin
-- (2) Get Data
Data := Foo.Get_Using_Pointer(This_Ptr => Foo_Ptr); -- This Compiles...
end;
begin
Foo.Initialize(This_Ptr => Foo_Obj'Access);
Test(This_Ptr => Foo_Obj'Access);
end Main;
Quick answer:
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Unchecked_Access;
Checked as far as I can with
lockheed:jerunh simon$ gnatmake main.adb -gnat95 -f
gcc -c -gnat95 main.adb
gcc -c -gnat95 foo.adb
gnatbind -x main.ali
gnatlink main.ali
lockheed:jerunh simon$ ./main
lockheed:jerunh simon$
In the line
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Access;
replace 'Access with 'Unchecked_Access.
PS. It could cause a dangling references if you destroy the object before Foo_Ptr gone.
The types Base_Class_Ref and Foo_Class_Ref are named access types and variables of this type can only refer to objects either on the heap or on package level, NOT objects on the stack. Since Storage_Size is set to zero it means the heap is out of the question.
package Main_App is
procedure Run;
end Main_App;
package body Main_App is
procedure TEST (This_Ptr : access Foo.Foo_Class) is
-- (1) Save Pointer
-- **** This Line reports: ****
-- raised PROGRAM_ERROR : main.adb:14 accessibility check failed
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Access; -- This Compiles...
-- ^^^ I know that this is not correct.
-- But it was the only way I could find to get it to compile.
Data : Interfaces.Unsigned_16;
begin
-- (2) Get Data
Data := Foo.Get_Using_Pointer(This_Ptr => Foo_Ptr); -- This Compiles...
end TEST;
Foo_Count : constant := 3;
Foo_Obj : aliased Foo.Foo_Class (Max => Foo_Count);
procedure Run is
begin
Foo.Initialize (This_Ptr => Foo_Obj'Access);
TEST (This_Ptr => Foo_Obj'Access);
end Run;
end Main_App;
with Main_App;
procedure Main is
begin
Main_App.Run;
end Main;
I hope this solution applicable to your use-case since it avoids usage of Unchecked_Access.
Ok what you're dealing with here is an anonymous access type, from the signature procedure TEST (This_Ptr : access Foo.Foo_Class). The error is telling you that this particular subprogram is in a deeper nesting than the thing it's pointing to: IOW, it could give you a dangling reference.
The proper solution, staying strictly in Ada95 would be to (A) put the TEST subprogram in the library unit [IIRC; 95 and 2005 are so similar they blur together]; or (B) put use a generic.
For a generic, IIRC, you can do this:
Generic
Object : Aliased Foo_Class'Class; -- Might not need 'Class.
with Function Operation(This_Ptr : in Foo_Class_Ref) return Interfaces.Unsigned_16;
Procedure Execute;
--...
Procedure Execute is
Result : Interfaces.Unsigned_16;
Begin
Result:= Operation( Object'Access );
End Execute;
----------------------------------------
O : Aliased Foo.Foo_Class(3);
Procedure TEST is new Foo.Execute( Operation => Foo.Get_Using_Pointer, Object => O );
This might require a little fiddling for your application, but if you put the generic inside Foo.ads/Foo.adb`, it should work. [IIRC] Aside from this, your best bet is to move your aliased object outside your main subprogram's declaration area, then it should work.
I found this question and the first answer contains some example code demonstrating how to start an executable with Ada code. The output of the executable is written to the standard output.
What options do I have to read the output of the executable for further parsing/processing in Ada (for example line by line)?
If you use GNAT, then you might want to take a look at Get_Command_Output in the GNAT.Expect package. Here's an example:
with Ada.Text_IO, GNAT.Expect;
procedure Main is
Command : constant String := "gnat";
Argument_1 : aliased String := "--version";
Input : constant String := "";
Status : aliased Integer := 0;
-- Execute the command and retrieve the output.
Output : String :=
GNAT.Expect.Get_Command_Output
(Command => Command,
Arguments => (1 => Argument_1'Unchecked_Access),
Input => Input,
Status => Status'Access,
Err_To_Out => False);
-- NOTE: Cheating with Unchecked_Access, OK for demo. You may want
-- to properly new and Free these strings (see Argument_List
-- type in package GNAT.OS_Lib).
begin
Ada.Text_IO.Put_Line (Output);
end Main;
The program returns after execution:
$ ./main
GNAT Community 2019 (20190517-83)
Copyright (C) 1996-2019, Free Software Foundation, Inc.
This is free software; see the source for copying conditions.
There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
As can be seen, the result is returned as a single string. You will have do the line splitting yourself.
Update
An update in response to some comments below.
You might also consider using the system function if you're targeting the Windows platform (see also this post on SO). Quoting from the function reference:
The system function passes command to the command interpreter, which executes the string as an operating-system command.
This is similar to what the program cmd.exe does. You can obtain the output of the command by redirecting its output to a file (i.e. using >) and then subsequently read it back. Here's an example:
with Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO;
with Ada.Strings.Unbounded;
with Interfaces.C;
with Interfaces.C.Strings;
procedure Main is
use Ada.Strings.Unbounded;
Content : Unbounded_String := Null_Unbounded_String;
begin
-- Execute.
declare
use Interfaces.C;
use Interfaces.C.Strings;
function system (command : chars_ptr) return int
with Import, Convention => C, External_Name => "system";
command : chars_ptr := New_String("gnat --version > gnat_version.out");
result : int := system (command);
begin
-- Check value of result (omitted in this example).
Free(Command);
end;
-- Read.
declare
use Ada.Text_IO;
use Ada.Text_IO.Unbounded_IO;
Fd : File_Type;
begin
Open (Fd, In_File, "./gnat_version.out");
while not End_Of_File (Fd) loop
Content := Content
& Unbounded_String'(Get_Line (Fd))
& ASCII.CR & ASCII.LF; -- Restore the line break removed by Get_Line.
end loop;
Close (fd);
end;
-- Show.
Ada.Text_IO.Unbounded_IO.Put (Content);
end Main;
I am receiving a "non-visible declaration" error on my Generator. I am converting this code from a single procedure to using multiple procedures and functions.
I have truncated the code a bit Any explanation of the non-visible declaration error would be appreciated.
The non visible declaration error is occurring in this block of code:
WITH Ada.Integer_Text_IO;
USE Ada.Integer_Text_IO;
WITH Ada.Text_IO;
USE Ada.Text_IO;
WITH Ada.Strings;
USE Ada.Strings;
WITH Ada.Numerics.Discrete_Random;
PROCEDURE Project IS
SUBTYPE Guess IS Integer RANGE 1 .. 25;
G : Generator;
CorrectAnswer : Guess;
UserGuess : Guess;
BEGIN
Reset (G);
CorrectAnswer := Random(G);
FOR I IN 1..3 LOOP
GetUserGuess(UserGuess);
PrintCorrectAns(CorrectAnswer);
IF IsCorrect(UserGuess) THEN
Put("You Win!");
ELSE
Put("You Lose!");
END IF;
END LOOP;
End Project;
The non-visible declaration at a-nudira.ads:48 and 50 (line numbers may vary with compiler release) are because Ada.Numerics.Discrete_Random, see ARM A.5.2(16), is a generic package and needs to be instantiated with whichever discrete type you need.
In your case, I guess that’s Guess:
package RNG is new Ada.Numerics.Discrete_Random (Result_Subtype => Guess);
use RNG;