I would like to define HTML response status code numbers as a type but disallow arithmetic operators because it wouldn't make sense for them.

type Status_Code is range 100 .. 599;

function "+" (Left, Right : Status_Code) return Status_Code is
begin
      pragma Assert (1 = -1);
      return Left + Right;
end;

The code snippet above on GNAT will give an error saying assertion will fail on runtime, but that is false when I add two of the numbers together. Is there a way to force a compiler error or at least a warning when arithmetic attempted on a type like this?

This article discusses various issues rebuilding a demonstrator intended for the BBC micro:bit (version 1.3b) after an interval of several years.

Trying to compile example /opt/gnatstudio/share/examples/training/games/bouncing/bouncing.gpr

There are no problems when compiling, but when running -

Error setting the video mode
UNCAUGHT EXCEPTION ===
raised STORAGE_ERROR : s-intman.adb:136 explicit raise

Code sample, which I used (it had been moved to another folder, because it does not want to compile in /opt/ - no rights).

with Display; use Display;
with Display.Basic; use Display.Basic;
with Ada.Numerics; use Ada.Numerics;
with Ada.Numerics.Generic_Elementary_Functions;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Float_Random; use Ada.Numerics.Float_Random;

procedure Bouncing is
Seed : Generator;
Buffer_Size : constant := 1_200;

package F_Numeri is new Ada.Numerics.Generic_Elementary_Functions (Float);
use F_Numeri;

Base_Immunity : constant := 500;

type Ball is record
X, Y     : Float := 0.0;
Dx, Dy   : Float := 0.0;
Size     : Float := 0.0;
Mass     : Float := 1.0;
S        : Shape_Id := Null_Shape_Id;
Immunity : Integer := Base_Immunity;
end record
with Dynamic_Predicate => Ball.Mass > 0.0;

type Shape_Array_Type is array (Integer range <>) of Shape_Id;
type Ball_Array_Type is array (Integer range <>) of Ball;

Null_Ball : constant Ball := Ball'(X      => 0.0,
Y      => 0.0,
Dx     => 0.0,
Dy     => 0.0,
Size   => 0.0,
Mass   => 1.0,
S      => Null_Shape_Id,
Immunity => Base_Immunity);
Total_Ball : Integer := 0;

function Speed (B : Ball) return Float is
     (Sqrt (B.Dx * B.Dx + B.Dy * B.Dy));

function Cynetic_Energy (B : Ball) return Float is
     (1.0 / 2.0 * B.Mass * Speed (B) * Speed (B));

function Speed (Cy : Float; Mass : Float) return Float is
     (Sqrt (Cy * 2.0 / Mass));


procedure Create_Ball
     (X : Float; Y : Float; Mass : Float; Velocity : Float; Balls : in out Ball_Array_Type; J : Integer);


type Int_Array is array (Integer range <>) of Integer range 0 .. Buffer_Size;
type Bool_Array is array (Integer range <>) of Boolean;

protected Collision_Manager is
procedure Reset;
procedure Set_Collision (J, K : Integer);
procedure Keep_Immunity (J : Integer);
function Collision_With (J : Integer) return Integer;
function Should_Keep_Immunity (J : Integer) return Boolean;
private
Collision_Vector : Int_Array (1 .. Buffer_Size);
Immunity_Vector : Bool_Array (1 .. Buffer_Size);
end Collision_Manager;

protected body Collision_Manager is
procedure Reset is
begin
Collision_Vector := (others => 0);
Immunity_Vector := (others => False);
end Reset;

procedure Set_Collision (J, K : Integer) is
begin
Collision_Vector (J) := K;
end Set_Collision;

procedure Keep_Immunity (J : Integer) is
begin
Immunity_Vector (J) := True;
end Keep_Immunity;

function Collision_With (J : Integer) return Integer is
begin
return Collision_Vector (J);
end Collision_With;

function Should_Keep_Immunity (J : Integer) return Boolean is
begin
return Immunity_Vector (J);
end Should_Keep_Immunity;

end Collision_Manager;


procedure Create_Graphic (B : in out Ball) is
begin
B.S := New_Circle
        (B.X, B.Y, B.Size,
         (if B.Size > 15.0 then Blue
elsif B.Size > 10.0 then Green
elsif B.Size > 5.0 then Yellow
elsif B.Size > 2.0 then Magenta
else Red));
end Create_Graphic;

function Collision (B1, B2 : Ball) return Boolean is
Dx, Dy : Float;
Size : Float;
begin
if B1 = Null_Ball or else B2 = Null_Ball then
return False;
end if;

Dx := B1.X - B2.X;
Dy := B1.Y - B2.Y;
Size := B1.Size + B2.Size;

return Dx * Dx + Dy * Dy <= Size * Size;
end Collision;

procedure Bounce (B1, B2 : in out Ball) is
Dx : Float;
Dy : Float;
Length : Float;
Dvx : Float;
Dvy : Float;
Impulse : Float;
begin
Dx := B1.X - B2.X;
Dy := B1.Y - B2.Y;
Length := Sqrt (Dx * Dx + Dy * Dy);

if Length /= 0.0 then
Dx := Dx / Length;
Dy := Dy / Length;
Dvx := B1.Dx - B2.Dx;
Dvy := B1.Dy - B2.Dy;
Impulse := -2.0 *  (Dx * Dvx + Dy * Dvy);
Impulse := Impulse / (1.0 / B1.Mass + 1.0 / B2.Mass);

B1.Dx := B1.Dx + Dx * (Impulse / B1.Mass);
B1.Dy := B1.Dy + Dy * (Impulse / B1.Mass);

B2.Dx := B2.Dx - Dx * (Impulse / B2.Mass);
B2.Dy := B2.Dy - Dy * (Impulse / B2.Mass);
end if;
end Bounce;

procedure Explode (Balls : in out Ball_Array_Type; Index : Integer) is
B : Ball := Balls (Index);
V : Float;
Cy : Float;
Sub_Particles : Integer;
begin
Sub_Particles := Integer (Log (X => B.Mass, Base => 2.0) + 1.0);

Total_Ball := Total_Ball - 1;
V := Sqrt (B.Dx * B.Dx + B.Dy * B.Dy);
Cy := 1.0 / 2.0 * B.Mass * V * V;

Delete (Balls (Index).S);
Balls (Index) := Null_Ball;

for J in 1 .. Sub_Particles loop
for K in Balls'Range loop
if Balls (K) = Null_Ball then
Create_Ball
                 (X       => B.X + Random (Seed) * B.Size - B.Size / 2.0,
Y       => B.Y + Random (Seed) * B.Size - B.Size / 2.0,
Mass     => B.Mass / Float (Sub_Particles),
Velocity => Speed
                    (Cy / Float (Sub_Particles),
B.Mass / Float (Sub_Particles)),
Balls => Balls,
J => K);

Create_Graphic (Balls (K));

exit;
end if;
end loop;
end loop;
end Explode;

procedure Combine (Balls : in out Ball_Array_Type; J, K : Integer) is
B1 : Ball := Balls (J);
B2 : Ball := Balls (K);
Cy : Float := Cynetic_Energy (B1) + Cynetic_Energy (B2);
begin
Total_Ball := Total_Ball - 2;

Delete (Balls (K).S);
Balls (K) := Null_Ball;

Delete (Balls (J).S);

Create_Ball
        (B1.X + (B1.X - B2.X) / 2.0,
B1.Y + (B1.Y - B2.Y) / 2.0,
B1.Mass + B2.Mass,
Speed (Cy, B1.Mass + B2.Mass),
Balls,
J);

Create_Graphic (Balls (J));
end Combine;

procedure Create_Ball
     (X : Float; Y : Float; Mass : Float;
Velocity : Float; Balls : in out Ball_Array_Type; J : Integer)
is
B : Ball renames Balls (J);
Angle : Float := Random (Seed) * 2.0 * Pi;
begin
Total_Ball := Total_Ball + 1;
B.X := X;
B.Y := Y;


B.Dx := Cos (Angle) * Velocity;
B.Dy := Sin (Angle) * Velocity;

B.Mass := Mass;
B.Size := Sqrt (B.Mass);
B.Immunity := Base_Immunity;
Collision_Manager.Keep_Immunity (J);
end Create_Ball;


Lines : constant Shape_Array_Type (1 .. 4) :=
     (New_Line (-100.0, -100.0, 100.0, -100.0, Blue),
New_Line (-100.0, -100.0, -100.0, 100.0, Blue),
New_Line (100.0, 100.0, 100.0, -100.0, Blue),
New_Line (100.0, 100.0, -100.0, 100.0, Blue));

R : Float;

Balls_Txt : Shape_Id := New_Text (110.0, 90.0, "0", White);
Explode_Txt : Shape_Id := New_Text (110.0, 80.0, "0", White);
Combine_Txt : Shape_Id := New_Text (110.0, 70.0, "0", White);

Combine_Prob : Float := 0.04;
Explode_Prob : Float := 0.02;

Ball_Array : Ball_Array_Type (1 .. Buffer_Size) := (others => Null_Ball);


task type Collision_Detection (Size, Modulus, Ind : Integer) is
entry Compute;
entry Finished;
entry Stop;
end Collision_Detection;

task body Collision_Detection is
Do_Work : Boolean := True;
J : Integer;
begin
while Do_Work loop
select
accept Compute;

J := Ind;

if J = 0 then
J := J + Modulus;
end if;

while J <= Size loop
if Ball_Array (J) /= Null_Ball then
for K in J + 1 .. Ball_Array'Last loop
if Collision (Ball_Array (J), Ball_Array (K)) then
if Ball_Array (J).Immunity = 0
and then Ball_Array (K).Immunity = 0
then
Collision_Manager.Set_Collision (J, K);
end if;

Collision_Manager.Keep_Immunity (J);
Collision_Manager.Keep_Immunity (K);
end if;
end loop;
end if;

J := J + Modulus;
end loop;

accept Finished;
or
accept Stop;

Do_Work := False;
end select;
end loop;
end Collision_Detection;

D1 : Collision_Detection (1200, 4, 0);
D2 : Collision_Detection (1200, 4, 1);
D3 : Collision_Detection (1200, 4, 2);
D4 : Collision_Detection (1200, 4, 3);
begin
for J in 1 .. 20 loop
declare
B : Ball renames Ball_Array (J);
begin
Create_Ball (0.0, 0.0, Random (Seed) * 75.0 + 4.0, 0.5, Ball_Array, J);
Create_Graphic (B);
end;
end loop;

loop
Collision_Manager.Reset;

D1.Compute;
D2.Compute;
D3.Compute;
D4.Compute;

D1.Finished;
D2.Finished;
D3.Finished;
D4.Finished;

for J in Ball_Array'Range loop
if Ball_Array (J) /= Null_Ball then
declare
K : Integer;
begin
if not Collision_Manager.Should_Keep_Immunity (J) then
Ball_Array (J).Immunity := 0;
end if;

K := Collision_Manager.Collision_With (J);

if K /= 0 and then Ball_Array (K) /= Null_Ball then
R := Random (Seed);

if R in 1.0 - Explode_Prob - Combine_Prob
1.0 - Combine_Prob
then
if Ball_Array (J).Mass > Ball_Array (K).Mass then
Explode (Ball_Array, J);
else
Explode (Ball_Array, K);
end if;
elsif R in 1.0 - Combine_Prob .. 1.0 then
Combine (Ball_Array, J, K);
else
Bounce (Ball_Array (J), Ball_Array (K));
end if;
end if;
end;
end if;
end loop;

for J in Ball_Array'Range loop
declare
B : Ball renames Ball_Array (J);
begin
if B /= Null_Ball then
if (B.X - B.Size < -100.0 and then B.Dx < 0.0)
or else (B.X + B.Size > 100.0 and then B.Dx > 0.0)
then
B.Dx := -B.Dx;
end if;

if (B.Y - B.Size< -100.0 and then B.Dy < 0.0)
or else (B.Y + B.Size> 100.0 and then B.Dy > 0.0)
then
B.Dy := -B.Dy;
end if;

B.X := B.X + B.Dx;
B.Y := B.Y + B.Dy;

if B.Immunity > 0 then
B.Immunity := B.Immunity - 1;
end if;

Set_X (B.S, B.X);
Set_Y (B.S, B.Y);
end if;
end;
end loop;

Set_Text (Balls_Txt, "Balls:" & Total_Ball'Img);
Set_Text (Explode_Txt, "Explode Prob:" & Integer (Explode_Prob * 1000.0)'Img & " / 1000");
Set_Text (Combine_Txt, "Combine Prob:" & Integer (Combine_Prob * 1000.0)'Img & " / 1000");

declare
Last_Key : Key_Type := Current_Key_Press;
begin
if To_Character (Last_Key) = 'q' then
Explode_Prob := Explode_Prob - 0.001;
elsif To_Character (Last_Key) = 'w' then
Explode_Prob := Explode_Prob + 0.001;
elsif To_Character (Last_Key) = 'a' then
Combine_Prob := Combine_Prob - 0.001;
elsif To_Character (Last_Key) = 's' then
Combine_Prob := Combine_Prob + 0.001;
end if;
end;

delay 0.01;
end loop;
end Bouncing;

The project file itself

bouncing.gpr

with "/opt/gnatstudio/share/gpr/game_support.gpr";
with "/opt/gnatstudio/share/gpr/gnat_sdl.gpr";

project bouncing is

for Main use("bouncing.adb");

for Object_Dir use "obj";
for Source_Dirs use("src");

end Bouncing;


tually, I had been compile and run some more simple example with the same result:

with Display; use Display;
with Display.Basic; use Display.Basic;

procedure Main is
Ball : Shape_Id := New_Circle
     (X      => 0.0,
Y      => 0.0,
Radius => 10.0,
Color  => Blue);
Step : Float := 0.05;
begin
loop
if Get_X (Ball) > 100.0 then
Step := -0.05;
elsif Get_X (Ball) < -100.0 then
Step := 0.05;
end if;

Set_X (Ball, Get_X (Ball) + Step);

delay 0.001;
end loop;
end Main;

I had tried to recompile Game_Support, git cloned from here.

I had tried to reinstall GNAT, Gnat Studio, etc.

I CAN run and compile another simple projects, for example with TEXT_IO package, I can run Gnat Studio, but I cannot run this app. I can run analogue, wrote with C++, so the problem is not in my OpenGl 1.3 hardware support.

• System: Arch Linux.
• IDE: Gnat Studio. (Install from AUR).
• Dependencies (SDL, SDL2) - installed.

MCDC Coverage is not generating in "GNAT AUNIT".

Is there any way to generate MCDC coverage using "GNAT AUNIT" ? and Is there any option to Extract the test report and coverage report from "GNAT AUNIT"?

while testing generic file thruogh instance in GNAT test AUnit framework.I am getting below error. Test harness is not creating for the file under test, which has generic; instead of that it is creating all other unwanted test harness files.

pal_api-btm-commands.ads:45:3: 
    error: corresponding test FAILED: Test not implemented. 
    (pal_api-btm-commands-test_data-tests.adb:44) 

pal_api-btm-commands.ads:55:3: 
    error: corresponding test FAILED: Test not implemented. 
    (pal_api-btm-commands-test_data-tests.adb:65)

Please let me know how to generate test harness file for generics which is implemented with its instance

Summary:

I am writing a server in Ada that should listen and reply to messages received over UDP. I am using the GNAT.Sockets library and have created a socket and bound it to a port. However, I am not sure how to listen for and receive messages on the socket. The Listen_Socket function is for TCP sockets and it seems that using Stream with UDP sockets is not recommended. I have seen the receive_socket and receive_vector procedures as alternatives, but I am not sure how to use them or how to convert the output to a usable format.

More details:

I am writing a server that should reply to messages that it gets over UDP. A minimal example of what I have so far would look like this:

with GNAT.Sockets;use GNAT.Sockets;

procedure udp is
    sock: Socket_Type;
    family: Family_Type:=Family_Inet;
    port: Port_Type:=12345;
    addr: Sock_Addr_Type(family);
begin
    Create_Socket(sock,family,Socket_Datagram);
    addr.Addr:=Any_Inet_Addr;
    addr.Port:=port;
    Bind_Socket(sock,addr);
    -- Listen_Socket(sock); -- A TCP thing, not for UDP.
    -- now what?
end UDP;

For a TCP socket, I can listen, accept, then use the Stream function to get a nice way to read the data (as in 'Read and 'Input). While the Stream function still exists, I have found an archive of a ten year old comp.lang.ada thread in which multiple people say not to use streams with UDP.

Looking in g-socket.ads, I do see alternatives: the receive_socket and receive_vector procedures. However, the output of the former is a Stream_Element_Array (with an offset indicating the length), and the latter has something similar, just with some kind of length associated with each Stream_Element.

According to https://stackoverflow.com/a/40045312/7105391, the way to change these types into a stream, is to not get them in the first place, and instead get a stream, which is not particularly helpful here.

Over at this github gist I found , Unchecked_Conversion is being used to turn the arrays into strings and vice versa, but given that the reference manual (13.13.1) says that type Stream_Element is mod <implementation-defined>;, I'm not entirely comfortable using that approach.

All in all, I'm pretty confused about how I'm supposed to do this. I'm even more confused about the lack of examples online, as this should be a pretty basic thing to do.

I am trying to define a library in Ada (built on GNAT specifically) for x86 ISA extensions. (This question is specific to AVX/AVX2).

Here is some example code below:

-- 256-bit Vector of Single Precision Floating Point Numbers
type Vector_256_Float_32 is array (0 .. 7) of IEEE_Float_32 with
  Alignment => 32, Size => 256, Object_Size => 256;
pragma Machine_Attribute (Vector_256_Float_32, "vector_type");
pragma Machine_Attribute (Vector_256_Float_32, "may_alias");

-- 256-bit Vector of 32-bit Signed Integers
type Vector_256_Integer_32 is array (0 .. 7) of Integer_32 with
  Alignment => 32, Size => 256, Object_Size => 256;
pragma Machine_Attribute (Vector_256_Integer_32, "vector_type");
pragma Machine_Attribute (Vector_256_Integer_32, "may_alias");

-- 256-bit Vector of 32-bit Unsigned Integers
type Vector_256_Unsigned_32 is array (0 .. 7) of Unsigned_32 with
  Alignment => 32, Size => 256, Object_Size => 256;
pragma Machine_Attribute (Vector_256_Unsigned_32, "vector_type");
pragma Machine_Attribute (Vector_256_Unsigned_32, "may_alias");

function vblendvps
  (Left, Right, Mask : Vector_256_Float_32)
   return Vector_256_Float_32 with
  Inline_Always => True, Convention => Intrinsic, Import => True,
  External_Name => "__builtin_ia32_blendvps256";

For the sake of education, I want to know how to do this in assembly.

I have tried to define the vblendvps function using the Asm function from System.Machine_Code. However, as I am not knowledgeable about assembly programming, I am struggling to find resources on how to do this.

This is what I have so far:

with System.Machine_Code; use System.Machine_Code;

function vblendvps
(Left, Right, Mask : Vector_256_Float_32)
return Vector_256_Float_32
is
result : Vector_256_Float_32;
begin
Asm
(Template => "vblendvps %3, %0, %1, %2",
 Outputs  => Vector_256_Float_32'Asm_Output ("=g", result),
 Inputs   =>
   (Vector_256_Float_32'Asm_Input ("g", Left),
    Vector_256_Float_32'Asm_Input ("g", Right),
    Vector_256_Unsigned_32'Asm_Input ("g", Mask)));
return result;
end vblendvps;

When compiling the complete code, I get

Error: too many memory references for `vblendvps'

I believe this means that I need to move the arguments from memory to registers, but I am not sure. If there are some helpful references that explain every instruction, I would greatly appreciate that. (I had quite some trouble looking up the arguments to vblendvps).

My understanding is that the instruction is of the form (from ymm registers in my case)

vblendvps RESULT, LEFT, RIGHT, MASK

Please let me know how I would do this. Even if it is not in Ada, I'm sure I can figure out how to translate it.

Can I compile a library adding a namespace at compile time using GNAT? I have to link to a legacy library that don't use a root package and child packages, so it's very annoying having hundred of options when I have to include something.

The other option I have is to write a Python script to add the root package to all files to reduce the problem.

I am trying to write a library for AVX2 in Ada 2012 using the GNAT GCC compiler. I have currently defined a data type Vec_256_Integer_32 like so:

type Vector_256_Integer_32 is array (0 .. 7) of Integer_32;
pragma Pack(Vec_256_Integer_32);

Note that I have aligned the array according to the 32 byte boundary indicated in Intel's documentation of the _mm256_load_si256 intrinsic function from immintrin.h.

I would like to implement an operation that adds two of these arrays together using AVX2. The function prototype is as follows.

function Vector_256_Integer_32_Add (Left, Right : Vector_256_Integer_32) return Vector_256_Integer_32

My idea for implementing this function is to do this in three steps.

1. Load a and b using _mm256_load_si256 into a local variable.
2. Perform the addition operation using _mm256_add_epi32.
3. Convert the result back into the Vec_256_Unsigned_32 type using _mm256_store_si256.

Where I am confused is how I would create the __m256i data type in Ada to hold the intermediate results. Can someone please shed some light on this? Additionally, if you see any issues with my approach, any feedback is appreciated.

I have found the definition of __m256i in GCC (located at gcc/gcc/config/i386/avxintrin.h).

typedef long long __m256i __attribute__ ((__vector_size__ (32), __may_alias__));

However, here is where I am stuck as I am not sure how I would transfer this to Ada code. I have found that the __vector_size__ attribute is documented here.

Use the process of postcondition hoisting and proof rules for sequence and assignment to derive the weakest preconditions and the verification conditions for the following specification statements.

{ true }
M := X;
N := Y;
A := 2 * M + N; N := N – 1;
M := A
{ M > N}

I missed a few lectures and I have no idea on how to do this.

I don't have enough material to refer to and this is my first time studying this language. please help me.

How can the weakest preconditions and the verification conditions for the following specification statements be derived using the postcondition hoisting technique and proof rules for sequence and assignment?

{ true } 
 
M := X; 
N := Y; 
A := 2 * M + N; 
N := N – 1; 
M := A 
 
{ M > N}  

Using GNAT Studio I have a project with a Main and an input file. The latter is next to the project file. I want to pass the path to the input file as argument to Main Run. How to do that?

(In Visual Studio I'd add it to the project and set "Copy to output directory", then locate it relative the output dir.)

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;

I'm dealing with huge global lists in Ada. When building I'm getting the error during linking: relocation truncated to fit R_X86_64_PC32 and link of main.adb failed. I saw that GCC has the flag -mcmodel=medium, is there something similar for gprbuild or does anyone has a hint how to deal with huge global lists?

Thanks in advance.

I am attempting to free a heap allocated Ada tagged record from cpp. I have used the code AdacoreU as a starting place.

I receive the following error when running the code below.

20
double free or corruption (out)

raised PROGRAM_ERROR : unhandled signal

Am I overthinking things? Do I need an Ada based deallocation mechanism.

What is my real end goal? I would like to use dynamic libraries to create a plugin infrastructure where each library is its own factory for a given type. Something along the lines of boost dll but with ada based dynamic libraries.

Modified Code below:

main.cpp

  1 #include <iostream>
  2 #include "animal.h"
  3 
  4 extern "C" {
  5     void adainit (void);
  6     void adafinal (void);
  7     Animal* new_animal();
  8     void del_animal(Animal *);
  9 }
 10 
 11 int main(void) {
 12     adainit();
 13     Animal* A = new_animal();
 14     std::cout << A->age() << std::endl;
 15     //delete A;   
 16     del_animal(A);
 17     adafinal();
 18     return 0;
 19 };

alib.ads

  1 
  2 with Interfaces.C;
  3 
  4 package ALib is
  5 
  6     type Animal is tagged record
  7         The_Age : Interfaces.C.int;
  8     end record;
  9     pragma Convention (CPP, Animal);
 10 
 11     type Animal_Class_Access is access Animal'Class;
 12 
 13     function New_Animal return access Animal'Class;
 14     pragma Export(CPP, New_Animal);
 15 
 16     procedure Del_Animal (this : in out Animal_Class_Access);
 17     pragma Export(CPP, Del_Animal);
 18 
 19     function Age(X : Animal) return Interfaces.C.int;
 20     pragma Export(CPP, Age);
 21 
 22 end ALib;

alib.adb

  1 with ada.unchecked_deallocation;
  2 
  3 package body ALib is
  4 
  5     function New_Animal
  6         return access Animal'Class is
  7     begin
  8         return new Animal'(The_Age => 20);
  9     end New_Animal;
 10 
 11 
 12     procedure Del_Animal (this : in out Animal_Class_Access) is
 13         procedure Free is new ada.unchecked_deallocation(Animal'Class, Animal_Class_Access);
 14     begin
 15         Free(this);
 16         --null;
 17     end Del_Animal;
 18 
 19     function Age(X : Animal)
 20         return Interfaces.C.int is
 21     begin
 22         return X.The_Age;
 23     end Age;
 24 
 25 end ALib;
~              

other resources used as a starting point

3.11.3.5 Interfacing with C++ at the Class Level

What have I attempted:

• Used various combinations of the type and access type when attempting to create the Free procedure
  • Animal, type Animal_Access is access Animal
  • Animal'Class, type Animal_Class_Access is access Animal'Class
  • Animal, type Animal_Access is access Animal'Class
• I was at some point under the impression that I should be using system address for the pointers to the Animal object as either part of the return on New_Animal and as the argument to Del_Animal

What did I expect:

I expected to clean up Ada heap objects from Ada.

I'm rewriting C source to Ada and on some places there is conditional compilation for handling different platforms, such as windows vs posix, DEBUG, or architecture. For what I can tell neither Ada nor GPR has the notion of conditional compilation.

What's the Ada way of handling it?

Example:

/* Determine if a process is alive. */
#ifndef _WIN32
   if (kill(pid, 0) && errno == ESRCH)
      return 0; /* pid does not exist */
#else
   HANDLE h;
   if ((h = OpenProcess(PROCESS_QUERY_INFORMATION, FALSE, (DWORD)pid)) == 0)
      return 0; /* pid does not exist */
   CloseHandle(h);
#endif
   return 1;

These are notes on building GCC 12.2.0 and GNAT tools for Apple silicon.

There were two main problems:

• the base package was built on an Intel machine (lockheed - named after Shadowcat’s companion dragon), running Monterey (macOS 12).
• the build machine, an M1 mac Mini (temeraire - named after Naomi Novik’s dragon) was by this time running Ventura (macOS 13), but I wanted to make sure that users could continue to run on Monterey.

I am currently trying to run a program in GPS and this is my first time trying to use Ada and don't quite understand some things to it. I have some code that was told was supposed to run but can't seem to get it running. When I try to compile it or run the code, I keep getting an error message: "end of file expected. file can only be one compilation unit." I also included a photo to help show the problem. I'd appreciate any tips or hints on how to solve this please!

enter image description here

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 ?