❌ About FreshRSS

Normal view

There are new articles available, click to refresh the page.
Before yesterdayNewest questions tagged ada - Stack Overflow

Getting unix command CAT to work on Windows

The issue of getting the equivalent command of the Unix command cat on Windows has been discussed for example here: What is the Windows equivalent of the Unix command cat?

I have looked at the project MinGW here: MinGW - Minimalist GNU for Windows Files

I have installed the file mingw-get-setup.exe and now I have a gui with which I can retrieve necessary Unix tools by downloading from the internet. But I do not know which of these tools has/have the cat command.

I would like to use the cat command to merge Ada specifications and bodies files so as to distribute the codes as just one .ada file on which other users can use the gnatchop command to retrieve the original files again.

If there are other better projects on Windows to obtain the cat command directly in a single Windows installation unlike the MinGW project in which tools have to be installed by downloading from the internet, I am interested.

Ada input format issue

I'm new to Ada and not sure how to fix this code. It appears it is about format issue,Β but don't know what is causing this. I am trying to read two files called a.txt and b.txt then compute the inverse of it. Sorry again am just stuck.

Here is the input files

A.txt

2 -2 4 -2 2 0 
1 0 4 -3 0 0
1 1 1 1 1 1 
1 0 0 -1 0 0
3 0 0 -3 0 2
1 0 0 0 -2 4

B.txt

13
18
51
82
32
12

here is my code

with Ada.Text_IO, Ada.Float_Text_IO, Ada.Integer_Text_IO;
use Ada.Text_IO, Ada.Float_Text_IO, Ada.Integer_Text_IO;

procedure Matrix_Inverse is

   type Matrix is array (1 .. 6, 1 .. 6) of Float;
   type Vector is array (1 .. 6) of Float;
   
   function Get_Matrix_From_File(Filename : String) return Matrix is
      A : Matrix := (others => (others => 0.0));
      File : File_Type;
      Line : String (1 .. 20);
      Last : Natural;
   begin
      Open (File, In_File, Filename);
      for I in A'Range(1) loop
         Get_Line (File, Line, Last);
         for J in A'Range(2) loop
            A (I, J) := Float'Value (Line (1 .. Last));
            Get (File, Line);
            Get_Line (File, Line, Last);
         end loop;
         A (I, 6) := Float'Value (Line (1 .. Last));
      end loop;
      Close (File);
      return A;
   end Get_Matrix_From_File;
   
   function Get_Vector_From_File(Filename : String) return Vector is
      B : Vector := (others => 0.0);
      File : File_Type;
   begin
      Open (File, In_File, Filename);
      for I in B'Range loop
         Get (File, B (I));
      end loop;
      Close (File);
      return B;
   end Get_Vector_From_File;
   
   procedure Print_Matrix(A : Matrix) is
   begin
      for I in A'Range(1) loop
         for J in A'Range(2) loop
            Put (A (I, J), 6, 2);
            Put (" ");
         end loop;
         New_Line;
      end loop;
   end Print_Matrix;
   
   function Inverse(A : Matrix) return Matrix is
      Inv : Matrix := (others => (others => 0.0));
      Identity : Matrix := (others => (others => 0.0));
   begin
      for I in Identity'Range(1) loop
         Identity (I, I) := 1.0;
      end loop;
      
      for I in A'Range(1) loop
         if A (I, I) = 0.0 then
            for J in I + 1 .. A'Range(1)'Last loop
               if A (J, I) /= 0.0 then
                  for K in A'Range(2) loop
                     A (I, K) := A (I, K) + A (J, K);
                     Identity (I, K) := Identity (I, K) + Identity (J, K);
                  end loop;
                  exit;
               end if;
            end loop;
         end if;
    for J in A'Range(1) loop
      if J /= I then
          declare
            Factor : constant Float := A (J, I) / A (I, I);
          begin
            for K in A'Range(2) loop
                A (J, K) := A (J, K) - Factor * A (I, K);
                Identity (J, K) := Identity (J, K) - Factor * Identity (I, K);
            end loop;
          end;
      end if;
    end loop;

    for I in A'Range(1) loop
      declare
          Diagonal : constant Float := A (I, I);
      begin
          for J in A'Range(2) loop
            Identity (I, J) := Identity (I, J) / Diagonal;
          end loop;
      end;
    end loop;

      return Identity;
    end Inverse;

  function Solve(A : Matrix; B : Vector) return Vector is
    Inv_A : Matrix := Inverse(A);
    Result : Vector := (others => 0.0);
  begin
    for I in Result'Range loop
        for J in Result'Range loop
          Result (I) := Result (I) + Inv_A (I, J) * B (J);
        end loop;
    end loop;
    return Result;
  end Solve;

  A : Matrix := Get_Matrix_From_File("a.txt");
  B : Vector := Get_Vector_From_File("b.txt");

  Solution : Vector := Solve(A, B);

  begin
    Put_Line("Solution:");
    for I in Solution'Range loop
        Put(Solution(I), 6, 2);
        Put(" ");
    end loop;
    New_Line;
end Matrix_Inverse;

Variable arglists in Ada

Why does not Ada support variable function/procedure argument lists? Is it hard to implement or does it somehow go against "we should keep things secure" philosophy of the language?

Varargs were over there at least as early as C and allow very handy things like printf, the likes of which can also be found in other languages like Java or C#. Another neat example is logging functions where it is usual to pass information from all kinds of data types, not only strings, in separate arguments.

And even if this is considered non-secure technique, Ada could still make it better than at least in C by e.g. throwing an exception if there is some mismatch between format string and the actually passed arguments.

Ada and C++ interface, avoid duplicated code [closed]

I'm working on a C++ application, Module_A, that has to use a diverse module, Module_B_Ada and Module_B_CPP depending on configuration.

Module_A + Module_B_Language will be compiled in different OS. I want to avoid duplicating Module_A to have a Module_A for Ada compilation and a Module_A for C++ compilation.

For now, the only thing that came to my mind has been to separate the code that uses the Ada module and exclude it from compilation when is compiled for C++ to avoid linking errors for unresolved symbols.

Another thing I'm thinking about is to comment the "extern" statement on the Module_A and define the Ada services to a void implementation when compiling for C++.

Have yoy ever faced a similar problem? How have you solved it?

Ada: Convert float to decimal

This post is linked to this one Ada 2005 access type. The goal is to use Ada decimal type to get similar results as to hand (and calculator) computations in which 6 decimal places have been used in each intermediate step.

As can be seen from the table below, the values obtained with the Ada code starts to differ from the hand calculation in the last digit when further iterations with the Euler method are taken.

One of the issues with the Ada code was with the line in the main code diff.adb: return 2 * Real(XY)*; It doesn't matter if I leave it as return 2 * X * Y as well.

The differential equation (O.D.E.) is being solved using the basic Euler method (which is an approximate method which is not that accurate). The D.E. is dy/dx = 2xy. The initial condition is at y0(x=x0=1) = 1. The analytical solution is y = e^((x^2)-1). The objective is to obtain y(x=1.5).

We start with the point (x0,y0) = (1,1). We use a step size h = 0.1 i.e. x is increased with each iteration in the Euler method to 1.1, 1.2, 1.3,..etc. and the corresponding value of y (the variable whose solution is being sought) is determined from the Euler algorithm which is:

y(n) = y(n-1) + h * f(x(n-1), y(n-1))

Here y(n-1) when we start the algorithm is y(0) = 1. Also x(n-1) is our starting x(0) = 1. The function f is the derivative function dy/dx given above as dy/dx = 2xy.

Briefly, h * f(x(n-1), y(n-1)) is the "horizontal distance between two successive x values" multiplied by the gradient. The gradient formula is dy/dx = delta y /delta x which gives delta y or (the change in y) as

delta y = delta x * dy/dx.

In the Euler formula h is the delta x and dy/dx is the gradient. So h * f(x(n-1), y(n-1)) gives delta y which is the change in the value of y i.e. delta y. This change in y is then added to the previous value of y. The Euler method is basically a first order Taylor approximation with a small change in x. A gradient line is drawn to the curve and the next value of the solution variable y is on this tangent line at the successive value of x i.e. xnew = xold + h where h is the step.

The table next shows the solution values for the variable y by the Euler method when calculated by hand (and calculator), by my Ada code and finally in the last column the exact solution.

x y (hand) Ada code y (exact)
1.1 1.200000 1.200000 1.233678
1.2 1.464000 1.464000 1.552707
1.3 1.815360 1.815360 1.993716
1.4 2.287354 2.287353 2.611696
1.5 2.927813 2.927811 3.490343

By hand and calculator for instance, y(x=1.1) i.e y(1) at x = x(1) is calculated as y(x=1.1) = y(0) + h * f(x=1,y=1) = 1 + 0.1 * (2 * 1* 1) = 1.200000 to 6 d.p.

y(2) is calculated at x = x(2) as y(x=1.2) = y(1) + h * f(x=1.1,y=1.200000) = 1.200000 + 0.1 * (2 * 1.1* 1.200000) = 1.464000 to 6 d.p.

y(3) is calculated at x = x(3) as y(x=1.3) = y(2) + h * f(x=1.2,y=1.464000) = 1.464000 + 0.1 * (2 * 1.2* 1.464000) = 1.815360 to 6 d.p.

y(4) is calculated at x = x(4) as y(x=1.4) = y(3) + h * f(x=1.3,y=1.815360) = 1.815360 + 0.1 * (2 * 1.3* 1.815360) = 2.287354 to 6 d.p.

y(5) is calculated at x = x(5) as y(x=1.5) = y(4) + h * f(x=1.4,y=2.287354) = 2.287354 + 0.1 * (2 * 1.4* 2.287354) = 2.927813 to 6 d.p.

Now I want to modify the codes so that they work with a fixed number of decimal places which is 6 here after the decimal place.

The main code is diff.adb:

with Ada.Text_IO;
with Euler;
procedure Diff is

  type Real is delta 0.000001 digits 9;
  type Vector is array(Integer range <>) of Real;
  type Ptr is access function (X: Real; Y: Real) return Real;
   
  package Real_IO is new Ada.Text_IO.Decimal_IO(Num => Real); 
  use Real_IO; 

  procedure Solve is new Euler(Decimal_Type => Real, Vector_Type => Vector, Function_Ptr => Ptr);

  function Maths_Func(X: Real; Y: Real) return Real is
  begin
    return 2 * Real(X*Y);
  end Maths_Func;

  
  Answer: Vector(1..6);

begin
  Solve(F => Maths_Func'Access, Initial_Value => 1.0, Increment => 0.1, Result => Answer);
  for N in Answer'Range loop
    Put(1.0 + 0.1 * Real(N-1), Exp => 0);
    Put( Answer(N), Exp => 0);
    Ada.Text_IO.New_Line;
  end loop;
end Diff;

Then comes euler.ads:

generic
  type Decimal_Type is delta <> digits <>;
  type Vector_Type is array(Integer range <>) of Decimal_Type;
  type Function_Ptr is access function (X: Decimal_Type; Y: Decimal_Type) return Decimal_Type;
procedure Euler(
  F: in Function_Ptr; Initial_Value, Increment: in Decimal_Type; Result: out Vector_Type);

and the package body euler.adb

procedure Euler
  (F : in Function_Ptr; Initial_Value, Increment : in Decimal_Type; Result : out Vector_Type)
is
   Step : constant Decimal_Type := Increment;
   Current_X : Decimal_Type := 1.0;

begin
   Result (Result'First) := Initial_Value;
   for N in Result'First + 1 .. Result'Last loop
      Result (N) := Result (N - 1) + Step * F(Current_X, Result (N - 1));
      Current_X := Current_X + Step;
   end loop;
end Euler;

On compilation, I get the messages pointing to diff.adb:

type cannot be determined from context

explicit conversion to result type required

for the line return 2.0 times X times Y;

Perhaps the 2.0 is causing the trouble here. How to convert this Float number to Decimal?

I believe that further down in diff.adb, I will get the same issue with the line:

Solve(F => Maths_Func'Access, Initial_Value => 1.0, Increment => 0.1, Result => Answer);

for it contains Floating point numbers as well.

The compilation was done on Windows with the 32-bit GNAT community edition of year 2011. Why 2011? This is because I like the IDE better for that year rather than the pale ones which come in the recent years.

The revised codes based on trashgod codes which work are given next:

The main file diff.adb

with Ada.Numerics.Generic_Elementary_Functions; use Ada.Numerics;
with Ada.Text_IO;                               use Ada.Text_IO;
with Euler;

procedure Diff is

   type Real is digits 7;
   type Vector is array (Positive range <>) of Real;
   type Ptr is access function (X : Real; Y : Real) return Real;
   type Round_Ptr is access function (V : Real) return Real;

   procedure Solve is new Euler (Float_Type => Real, Vector => Vector, Function_Ptr => Ptr, Function_Round_Ptr => Round_Ptr);
   package Real_Functions is new Generic_Elementary_Functions (Real);
   use Real_Functions;
   package Real_IO is new Ada.Text_IO.Float_IO (Real);
   use Real_IO;

   function DFDX (X, Y : Real) return Real is (2.0 * X * Y);
   function F (X : Real) return Real is (Exp (X**2.0 - 1.0));
   function Round (V : in Real) return Real is (Real'Rounding (1.0E6 * V) / 1.0E6);

   XI      : constant Real := 1.0;
   YI      : constant Real := 1.0;
   Step    : constant Real := 0.1;
   Result  : Vector (Positive'First .. 6); --11 if step = 0.05
   X_Value : Real;

begin
   Solve (DFDX'Access, Round'Access, XI, YI, Step, Result);
   Put_line("        x      calc     exact     delta");
   for N in Result'Range loop
      X_Value := 1.0 + Step * Real (N - 1);
      Put (X_Value, Exp => 0);
      Put (" ");
      Put (Result (N), Exp => 0);
      Put (" ");
      Put (F (X_Value), Exp => 0);
      Put (" ");
      Put (Result (N) - F (X_Value), Exp => 0);
      Ada.Text_IO.New_Line;
   end loop;
end Diff;

The file euler.ads

generic
   type Float_Type is digits <>;
   type Vector is array (Positive range <>) of Float_Type;
   type Function_Ptr is access function (X, Y : Float_Type) return Float_Type;
   type Function_Round_Ptr is access function (V : Float_Type) return Float_Type;
procedure Euler
  (DFDX : in Function_Ptr; Round : Function_Round_Ptr; XI, YI, Step : in Float_Type; Result : out Vector);

The file euler.adb

procedure Euler
  (DFDX : in Function_Ptr; Round : Function_Round_Ptr; XI, YI, Step : in Float_Type; Result : out Vector)
is
   H : constant Float_Type := Step;
   X : Float_Type          := XI;
begin
   Result (Result'First) := YI;
   for N in Result'First + 1 .. Result'Last loop
       Result (N) :=  Round(Result (N - 1)) + Round(H * DFDX (X, Result (N - 1)));
       X          := X + Step;
   end loop;
end Euler;

giving the output with **step h = 0.1 **

x calc (Ada) exact delta
1.1 1.200000 1.233678 1.233678
1.2 1.464000 1.552707 -0.033678
1.3 1.815360 1.993716 -0.088707
1.4 2.287354 2.611696 -0.178356
1.5 2.927813 3.490343 -0.562530

The calc (Ada) results agree with hand (and calculator) computations.

Ada visitor design pattern and generics

I'm implementing a visitor pattern and I have some elements that I could implement using generics, but the GNAT compiler complains with the generic type. I have a solution using generic mix-ins but its less intuitive.

How can I solve it?

I provide the following minimal reproducibable example:

  1. visitors.ads
with ConcreteElements;
with Instantiation;

package Visitors is

  type Visitor_t is interface;

  procedure pVisit (this : in Visitor_t;
                    element : ConcreteElements.ConcreteElement_t) is abstract;

  procedure pVisit (this : in Visitor_t;
                    element : Instantiation.GenericElement_t) is abstract;

end Visitors;
  1. elements.ads
limited with Visitors;

package Elements is

  type Element_t is abstract tagged null record;

  procedure pAccept
    (this : in Element_t;
     visitor : in Visitors.Visitor_t'Class) is abstract;

end Elements;
  1. concreteelements.ads/adb
limited with Visitors;
with Elements;

package ConcreteElements is

  type ConcreteElement_t is new Elements.Element_t with null record;

  overriding
  procedure pAccept
    (this : in ConcreteElement_t;
     visitor : in Visitors.Visitor_t'Class);

end ConcreteElements;
with Visitors;

package body ConcreteElements is

  procedure pAccept
    (this : in ConcreteElement_t;
     visitor : in Visitors.Visitor_t'Class) is
  begin
    visitor.pVisit(this);
  end pAccept;

end ConcreteElements;
  1. genericelements.ads/adb
with Elements;
limited with Visitors;

generic
  type Parent_t (<>) is abstract new Elements.Element_t with private;
package GenericElements is

  type GenericElement_t is new Parent_t with null record;

  overriding
  procedure pAccept (this : in GenericElement_t;
                     visitor : in Visitors.Visitor_t'Class);

end GenericElements;
with Visitors;

package body GenericElements is

  procedure pAccept (this : in GenericElement_t;
                     visitor : in Visitors.Visitor_t'Class) is
  begin
    visitor.pVisit(this);
  end pAccept;

end GenericElements;
  1. instantiation.ads
with GenericElements;
with Elements;

package instantiation is new GenericElements
  (Parent_t => Elements.Element_t);

The compiler complains in the body of 4), at line 9:

expected type "instantiation.GenericELement_t" defined at genericelements.ads:8

found type "GenericElements.GenericElement_t" defined at genericelements.ads:8

My solution is to perform a mix-in, making GenericElement_t abstract, thus this would be 1), 4) and 5):

1)

with ConcreteElements;
with Instantiation;

package Visitors is

  type Visitor_t is interface;

  procedure pVisit (this : in Visitor_t;
                    element : ConcreteElements.ConcreteElement_t) is abstract;

  procedure pVisit (this : in Visitor_t;
                    element : Instantiation.Instantiation_t) is abstract;

end Visitors;
with Elements;

generic
  type Parent_t (<>) is abstract new Elements.Element_t with private;
package GenericElements is

  type GenericElement_t is abstract new Parent_t with null record;

end GenericElements;
private with GenericElements;
limited with Visitors;
with Elements;

package instantiation is 

  type Instantiation_t is new Elements.Element_t with private;

  overriding
  procedure pAccept (this : in Instantiation_t;
                     visitor : Visitors.Visitor_t'Class);

private

  package instantiation_pck is new GenericElements 
    (Parent_t => Elements.Element_t);

  type Instantiation_t is new instantiation_pck.GenericElement_t with null record;

end instantiation;
with Visitors;

package body instantiation is

  procedure pAccept (this : in Instantiation_t;
                     visitor : Visitors.Visitor_t'Class) is
  begin
    visitor.pVisit(this);
  end pAccept;


end instantiation;

Can I implement correctly the first option or I shall implement it using mix-ins?

Thank you in advance and sorry for the ammount of code.

Ada: fixed decimal place

I am doing some numerical calculations dealing with iterations and I would like to know how to force Ada work only to a certain number of decimal places say 6. If I write

type Real is digits 6;

my understanding tells me that this forces the precision to be 6 Significant figures. But I am more interested in the number of decimal places after the decimal point as in 238.345891 and 0.297568 in which both numbers contain 6 decimal places.

The point of working with a fixed number of decimal places is that with numerical computations, I normally do the checking by hand and a calculator and I keep all calculations to a fixed number of decimal places, here 6. I would like to get the same results which I get by hand calculations and those from the Ada program.

I agree that working with significant figures makes more sense since a number such as 4 x 10^-7 will amount to just zeros if I work with 6 d.p. but I want to know if Ada offers the possibility to work with a fixed number of decimal places.

Is there a way to disable arithmetic operators on a specific type in Ada?

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?

Access type and procedures

I am writing with reference to my earlier post here:

Ada 2005 access type

In the first code diff.adb, there is the line:

procedure Solve is new Euler(Real, Vector, Ptr);

I don't understand how come the arguments of Euler area Real, Vector and Ptr because further down in the same code we have

Solve(Ident'Access, 1.0, 0.1, Answer);

with 4 arguments.

The original codes at the previous link are OK and are working.

matrix function not able to compile ada "declarations must come before "begin"

Hi so I'm very new to ada but it doesn't seem to like this code that I wrote, I keep having this error even though it looks fine.

Compile
   [Ada]          main.adb
main.adb:17:09: error: declarations must come before "begin"
gprbuild: *** compilation phase failed

here is the code:

with Ada.Text_IO;  use Ada.Text_IO;
with Ada.Numerics.Linear_Algebra;

procedure main is

  type Square_Matrix is array(Integer range <>, Integer range <>) of Float;
  
  function Determinant(matrix : in Square_Matrix) return Float is
    (Ada.Numerics.Linear_Algebra.Determinant(matrix));

  function Adjoint(matrix : in Square_Matrix) return Square_Matrix is
    result : Square_Matrix := matrix;
    dimension : Integer := matrix'Length;
  begin
    for i in 1 .. dimension loop
      for j in 1 .. dimension loop
        temp : Square_Matrix(dimension - 1, dimension - 1);
        for m in 1 .. dimension - 1 loop
          for n in 1 .. dimension - 1 loop
            if m < i and n < j then
              temp(m, n) := matrix(m, n);
            elsif m < i and n >= j then
              temp(m, n) := matrix(m, n + 1);
            elsif m >= i and n < j then
              temp(m, n) := matrix(m + 1, n);
            else
              temp(m, n) := matrix(m + 1, n + 1);
            end if;
          end loop;
        end loop;
        sign : Integer := (if (i + j) mod 2 = 0 then 1 else -1);
        result(j, i) := sign * Determinant(temp);
      end loop;
    end loop;
    return result;
  end Adjoint;

  matrix : Square_Matrix(1 .. 6, 1 .. 6) := ((2.0, -2.0, 4.0, -2.0, 0.0, 2.0),
                                             (1.0, 0.0, 4.0, -3.0, 0.0, 0.0),
                                             (1.0, 1.0, 1.0, 1.0, 1.0, 1.0),
                                             (1.0, 0.0, 0.0, -1.0, 0.0, 0.0),
                                             (3.0, 0.0, 0.0, -3.0, 0.0, 2.0),
                                             (1.0, 0.0, 0.0, -2.0, 0.0, 4.0));
  adjoint_matrix : Square_Matrix(1 .. 6, 1 .. 6);

begin
  adjoint_matrix := Adjoint(matrix);
  
  Put_Line("Original Matrix:");
  for i in matrix'Range(1) loop
    for j in matrix'Range(2) loop
      Put(Float'Image(matrix(i, j)), 4, 2);
    end loop;
    New_Line;
  end loop;
  
  Put_Line("Adjoint Matrix:");
  for i in adjoint_matrix'Range(1) loop
    for j in adjoint_matrix'Range(2) loop
      Put(Float'Image(adjoint_matrix(i, j)), 6, 2);
    end loop;
    New_Line;
  end loop;
  
end main;

Penultimate array index retrieval

Suppose the following generic procedure to print the elements of an array indexed by a discreet type (note the slight logic added to prevent the printing of an extra , past the end of the last element):

with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;

procedure Array_Printer is
   
   generic
      type Index is (<>);
      type Int_Array is array (Index range <>) of Integer;
   procedure Print(IA: Int_Array); 
   
   procedure Print(IA: Int_Array) is
      -- Penultimate: Index := Index'Pred(IA'Last); -- raises CONSTRAINT_ERROR for IA'Length = 1
   begin
      Put("[");
      for I in IA'First .. Index'Pred(IA'Last) loop
         Put(IA(I), 0);Put(",");
      end loop;
      Put(IA(IA'Last), 0);
      Put("]");      
   end Print;
   
   type Int_Array is array(Positive range <>) of Integer;
   
   IA: Int_Array := (-3, -2, -1, 0, 1, 2, 3);
   IA2: Int_Array := (1 => 0);
   
   procedure Print_Int_Array is new Print(Index => Positive,
                                          Int_Array => Int_Array);
   
   begin
      Print_Int_Array(IA);   
end Array_Printer;

When this procedure runs with an array of length > 1 (e.g. IA) it correctly prints the array ([-3,-2,-1,0,1,2,3]). However, when it is given an array of length = 1 (e.g. IA2) then, perhaps surprisingly, the penultimate index calculation in the for-loop doesn't raise a CONSTRAINT_ERROR (due to a predecessor not existing) and the expected result ([0]) gets printed.

When that calculation is done elsewhere however (e.g. in the declarative section of the procedure) then that exception is raised, indeed.

Is the compiler smart enough to figure-out there's only one element in the array and hence generates a null range for the for loop?

Gnatstudio seems to be invoking gprbuild with -cargs -g -O0

Any thoughts? - Thanks

Ada 2005 access type

I am trying to solve a differential equation with Euler's method using the technique employed with the access type shown in Ben Ari second editions of Ada for Software Engineers, Section 13.6.1 starting on Page 263.

I have modified the differential equation given in the book to dy/dx = 2xy with Initial Condition y(x=1) = 1. The increment is h = 0.1 and I have to find output the values of y(1), y(1.1), y(1.2), y(1.3), y(1.4) and y(1.5).

There are 3 Ada files: diff.adb which is the main file, euler.ads and euler.adb.

The file diff.adb is

with Ada.Text_IO;
with Euler;
procedure Diff is

  type Real is digits 6;
  type Vector is array(Integer range <>) of Real;
  type Ptr is access function (X: Real; Y: Real) return Real;

  procedure Solve is new Euler(Real, Vector, Ptr);

  function Ident(X: Real; Y: Real) return Real is
  begin
    return 2.0*X*Y;
  end Ident;

  package Real_IO is new Ada.Text_IO.Float_IO(Real);
  use Real_IO;

  Answer: Vector(1..10);

begin
  Solve(Ident'Access, 1.0, 0.1, Answer);
  for N in Answer'Range loop
    Put(1.0 + 0.1 * Real(N-1), Exp => 0);
    Put( Answer(N), Exp => 0);
    Ada.Text_IO.New_Line;
  end loop;
end Diff;


The file euler.ads is

--
-- Solving a differential equation.
-- Demonstrates generic floating point type.
--
generic
  type Float_Type is digits <>;
  type Vector is array(Integer range <>) of Float_Type;
  type Function_Ptr is access function (X: Float_Type; Y: Float_Type) return Float_Type;
procedure Euler(
  F: in Function_Ptr; Init, H: in Float_Type; Result: out Vector);

And the file euler.adb is

procedure Euler(
  F: in Function_Ptr; Init, H: in Float_Type; Result: out Vector) is
begin
  Result(Result'First) := Init;
  for N in Result'First+1..Result'Last loop
    Result(N) := Result(N-1) + H * F(Result(N-1));
  end loop;
end Euler;

When I compile diff.adb, I get the error message:

euler.adb: Builder results euler.adb:6:36 missing argument for parameter Y

As I don't understand access types well, I would be very grateful if I can get help making the above codes work.

PS: The results to be outputtted should be as follows when worked out by hand and a calculator:

x y
1 1
1.1 1.2
1.2 1.464
1.3 1.815360
1.4 2.287354
1.5 2.927813

The first column gives the x values (with an increment of 0.1) and the second column gives the ouput of the Euler method (y values).

After Simon's help:

I used Simon's code for euler.adb:

This was changed to Simon's code:

procedure Euler
  (F : in Function_Ptr; Init, H : in Float_Type; Result : out Vector)
is
      Step : constant Float_Type := H;
   
     Current_X : Float_Type := 1.0;
begin
   Result (Result'First) := Init;
   for N in Result'First + 1 .. Result'Last loop
      Current_X := Current_X + Step;
      Result (N) := Result (N - 1) + Step * F (Current_X, Result (N - 1));
   end loop;
end Euler;

The initial value of X is 1.0 and it is 1.0 as well for Y. In diff.adb, the output line Put(0.1 * Real(N-1), Exp => 0) has been changed to Put(1.0 + 0.1 * Real(N-1), Exp => 0) so as to get the sequence 1.0 to 1.5 (with also the line Answer: Vector(1..6) accordingly modified from 10 to 6).

When I run the corrected code I now get:

x y
1 1.00000
1.1 1.22000
1.2 1.51280
1.3 1.90613
1.4 2.43984
1.5 3.17180

The Y values from the above table are not OK as compared with the values from the table given up earlier. For instance by hand calculation, Y(1.1)= 1 + 0.1 * 2.0 * 1 * 1 = 1.2 where I am using the equation Y1 = Y0 + h*f(X0, Y0) with Y0 and X0 as the initial values of 1 both and h is the X increment of 0.1. Then Y(1.2) = 1.2 + 0.1 * 2 * 1.1 * 1.2 = 1.464000 where I used the equation Y2 = Y1 + h * f(X1, Y1) with X1 = X0 + h = 1 + 0.1 = 1.1 and Y1 has been calculated in the previous iteration as Y(X=1.1)=1.2. Then we can continue calculating for Y(X=1.3), Y(X=1.4) and Y(X=1.5) in a similar manner.

How to retrieve colors with GtkAda?

I use Glade with GtkAda.

-I can't retrieve the color data in the associate callback (window1_callbacks.adb).

-The Gtk.Color_Chooser.Get_RGBA procedure needs Gtk_Color_Chooser type. And Gtk_Color_Chooser function returns returns GObjet, so we need to convert data from GObject type to Gtk_Color_Chooser type.

And I don' see any function doing this. Thanks Mark

    -- Glade_8.adb
    
    -- units from Gtk
    with Gtk.Main;
    with Glib.Error;     use Glib.Error;
    with Gtk.Widget;     use Gtk.Widget;
    with Gtk.Builder;    use Gtk.Builder;
    with Gtkada.Builder; use Gtkada.Builder;
    
    -- Ada predefined units
    with Ada.Text_IO;    use Ada.Text_IO;
    with Ada.Exceptions;
    
    -- Application specific units
    with Window1_Callbacks; use Window1_Callbacks;
    
    procedure Glade_8 is
    
      Builder       : Gtkada_Builder;
      Error         : aliased Glib.Error.GError;
      FileName      : constant String := "glade_8";
      GladeFileName : constant String := FileName & ".glade";
      use type Glib.Guint;
         
      begin
        -- AppelΓ© dans toutes les applications GtkAda.
        -- Arguments ligne de commande sont analysΓ©s & retournΓ©s Γ  l'application.
        Gtk.Main.Init;
    
        -- Etape 1 : crΓ©er un Builder 
        --         & lui donner accès à la fenetre maitre du fichier XML.
        Gtk_New (Builder);
        if Add_From_File (Gtk_Builder(Builder), GladeFileName, Error'Access) = 0 then
          Put_Line ("Error : " & Get_Message (Error));
          Error_Free (Error);
          return;
        end if;
        Put_Line (FileName & " : loading of builder OK ");
       
        -- Etape 2 : crΓ©er les handlers ("poignΓ©es") des events
        --             (de façon à préparer les callback).
        Register_Handler (Builder, "on_color1_color_set",    On_Color1_Color_Set'Access);  --Ajout
        
        -- Etape 3 : Do_Connect connecte tous les handlers enregistrΓ©s en une fois.
        Do_Connect (Builder);
      --Put_Line ("Booleen du Switch : " & boolean'Image (On_Switch1_State_Set (Builder)));
    
        -- Etape 4 : Afficher la fenetre avec ses dΓ©pendances
        Show_All (Gtk_Widget (Get_Object (GTK_Builder (Builder), "window")));
    
        -- Etape 5 : Lancer la boucle infinie.
        Gtk.Main.Main;
    
        -- Etape 6 : appeler Unref quand l'application se termine
        --             pour libΓ©rer la memoire associΓ©e au Builder.
        Unref (Builder);
        Put_Line ("Program " & FileName & " is finished !");
    
      exception
        when Error : others =>
          Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (Error));
      end Glade_8;
    
    
    -- Glade_8
    
    with Gtkada.Builder; use Gtkada.Builder;
    
    package Window1_Callbacks is
          
      Procedure On_Color1_Color_Set (Builder : access Gtkada_Builder_Record'Class);  -- Ajout
    
    end Window1_Callbacks;
    
     
    
    -- Glade_8
    
    -- units from Gtk
    with Gtk.Label;          use Gtk.Label;
    with Gtk.Check_Button;   use Gtk.Check_Button;
    with Gtk.Toggle_Button;  use Gtk.Toggle_Button;
    with Gtk.Spin_Button;    use Gtk.Spin_Button;
    with Gtk.Switch;         use Gtk.Switch;
    with Gtk.Combo_Box;      use Gtk.Combo_Box;
    with Gtk.GEntry;         use Gtk.GEntry;
    
    with Gtk.Color_Button;            use Gtk.Color_Button;           --Ajout
    with Gtk.Color_Chooser;           use Gtk.Color_Chooser;          --Ajout
    with Gtk.Color_Chooser_Dialog;    use Gtk.Color_Chooser_Dialog;   --Ajout
    with Gtk.Color_Chooser_Widget;    use Gtk.Color_Chooser_Widget;   --Ajout
    with Gtk.Color_Selection;         use Gtk.Color_Selection;        --Ajout
    with Gtk.Color_Selection_Dialog;  use Gtk.Color_Selection_Dialog; --Ajout
    
    with Gdk.RGBA;                    use Gdk.RGBA;                   --Ajout
    
    with Glib;              use Glib;
    
    with Ada.Text_IO;       use Ada.Text_IO;
    
    
    package body Window1_Callbacks  is
        
      ---------------------------------
      -- On_Color1_Color_Set  -- AJOUT
      ---------------------------------
      procedure On_Color1_Color_Set (Builder : access Gtkada_Builder_Record'Class) is
        pragma Unreferenced (Builder);
        Color : Gdk_RGBA;
        begin
    --      void on_color1_color_set(GtkColorButton *c)   // To translate from C to Ada.
    --           {
    --           GdkRGBA color;
    --           gtk_color_chooser_get_rgba (GTK_COLOR_CHOOSER(c), &color); // RΓ©cupΓ©rer la couleur
    --           printf("red %f\n", color, red);
    --           printf("green %f\n", color, green);     
    --           printf("blue %f\n", color, blue);    
    --           printf("alpha %f\n", color, alpha);    
    --           }
    
    --  window1_callbacks.adb:189:35: error: "GObject_To_Gtk_Color_Chooser" is undefined
          Gtk.Color_Chooser.Get_RGBA (
                                      To_Gtk_Color_Chooser
                                                          (Gtk_Color_Chooser (Get_Object (Builder, "color1"))),
                                                                                                                Color);
      
    --      put_line ("Red : ",   Float'Image (Color.Red));
    --      put_line ("Green : ", Float'Image (Color.Green));     
    --      put_line ("Blue : ",  Float'Image (Color.Blue));    
    --      put_line ("Alpha : ", Float'Image (Color.Alpha));   
          
        end On_Color1_Color_Set;
    
    end Window1_Callbacks;


    <?xml version="1.0" encoding="UTF-8"?>
    <!-- Generated with glade 3.40.0 -->
    <interface>
      <requires lib="gtk+" version="3.24"/>
      <object class="GtkAdjustment" id="adjustment1">
        <property name="upper">100</property>
        <property name="step-increment">1</property>
        <property name="page-increment">10</property>
      </object>
      <object class="GtkListStore" id="liststore1">
        <columns>
          <!-- column-name Col_1 -->
          <column type="gchararray"/>
        </columns>
        <data>
          <row>
            <col id="0">Ligne-1</col>
          </row>
          <row>
            <col id="0">bbb</col>
          </row>
          <row>
            <col id="0">dddd</col>
          </row>
          <row>
            <col id="0">eeeeeeee</col>
          </row>
          <row>
            <col id="0">ligne-5</col>
          </row>
          <row>
            <col id="0">ligne-6</col>
          </row>
        </data>
      </object>
      <object class="GtkWindow" id="window">
        <property name="name">window</property>
        <property name="width-request">89</property>
        <property name="height-request">3</property>
        <property name="can-focus">False</property>
        <property name="hexpand">True</property>
        <property name="vexpand">True</property>
        <property name="border-width">0</property>
        <property name="window-position">center</property>
        <property name="gravity">center</property>
        <child>
          <object class="GtkFixed" id="fixed1">
            <property name="name">fixed1</property>
            <property name="visible">True</property>
            <property name="can-focus">False</property>
            <child>
              <object class="GtkButton" id="button1">
                <property name="name">button1</property>
                <property name="width-request">100</property>
                <property name="height-request">80</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">True</property>
                <property name="tooltip-text" translatable="yes"> Click Me!</property>
                <property name="always-show-image">True</property>
                <signal name="clicked" handler="on_button1_clicked" swapped="no"/>
                <child>
                  <object class="GtkImage" id="harddisk">
                    <property name="visible">True</property>
                    <property name="can-focus">False</property>
                    <property name="stock">gtk-harddisk</property>
                    <property name="icon_size">6</property>
                  </object>
                </child>
              </object>
              <packing>
                <property name="x">36</property>
                <property name="y">40</property>
              </packing>
            </child>
            <child>
              <object class="GtkLabel" id="label1">
                <property name="width-request">200</property>
                <property name="height-request">40</property>
                <property name="visible">True</property>
                <property name="can-focus">False</property>
                <property name="tooltip-text" translatable="yes">I am a label hiding here.</property>
                <property name="label" translatable="yes">label</property>
                <attributes>
                  <attribute name="font-desc" value="Sans Bold Italic 15"/>
                  <attribute name="foreground" value="#efef29292929"/>
                </attributes>
              </object>
              <packing>
                <property name="x">150</property>
                <property name="y">170</property>
              </packing>
            </child>
            <child>
              <object class="GtkLabel" id="label2">
                <property name="width-request">200</property>
                <property name="height-request">40</property>
                <property name="visible">True</property>
                <property name="can-focus">False</property>
                <property name="xpad">0</property>
                <property name="ypad">17</property>
                <property name="label" translatable="yes">label2</property>
                <property name="xalign">0.5</property>
                <property name="yalign">0.5</property>
              </object>
              <packing>
                <property name="x">150</property>
                <property name="y">220</property>
              </packing>
            </child>
            <child>
              <object class="GtkRadioButton" id="radio1">
                <property name="label" translatable="yes">radio button 1</property>
                <property name="width-request">100</property>
                <property name="height-request">22</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="halign">start</property>
                <property name="active">True</property>
                <property name="draw-indicator">True</property>
                <signal name="toggled" handler="on_radio1_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">30</property>
              </packing>
            </child>
            <child>
              <object class="GtkRadioButton" id="radio2">
                <property name="label" translatable="yes">radio button 2</property>
                <property name="width-request">100</property>
                <property name="height-request">22</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="active">True</property>
                <property name="draw-indicator">True</property>
                <property name="group">radio1</property>
                <signal name="toggled" handler="on_radio2_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">60</property>
              </packing>
            </child>
            <child>
              <object class="GtkRadioButton" id="radio3">
                <property name="label" translatable="yes">radio button3</property>
                <property name="width-request">100</property>
                <property name="height-request">22</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="active">True</property>
                <property name="draw-indicator">True</property>
                <property name="group">radio1</property>
                <signal name="toggled" handler="on_radio3_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">90</property>
              </packing>
            </child>
            <child>
              <object class="GtkCheckButton" id="check1">
                <property name="label" translatable="yes">check button1</property>
                <property name="width-request">100</property>
                <property name="height-request">30</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">False</property>
                <property name="draw-indicator">True</property>
                <signal name="toggled" handler="on_check1_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">190</property>
                <property name="y">120</property>
              </packing>
            </child>
            <child>
              <object class="GtkToggleButton" id="toggle1">
                <property name="label" translatable="yes">toggle button</property>
                <property name="width-request">123</property>
                <property name="height-request">36</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">True</property>
                <signal name="toggled" handler="on_toggle1_toggled" swapped="no"/>
              </object>
              <packing>
                <property name="x">25</property>
                <property name="y">174</property>
              </packing>
            </child>
            <child>
              <object class="GtkSpinButton" id="spin1">
                <property name="width-request">118</property>
                <property name="height-request">34</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="max-width-chars">2</property>
                <property name="adjustment">adjustment1</property>
                <property name="wrap">True</property>
                <signal name="value-changed" handler="on_spin1_value_changed" swapped="no"/>
              </object>
              <packing>
                <property name="x">25</property>
                <property name="y">218</property>
              </packing>
            </child>
            <child>
              <object class="GtkSwitch" id="switch1">
                <property name="use-action-appearance">True</property>
                <property name="name">switch</property>
                <property name="width-request">100</property>
                <property name="height-request">35</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="active">True</property>
                <signal name="state-set" handler="on_switch1_state_set" swapped="no"/>
              </object>
              <packing>
                <property name="x">27</property>
                <property name="y">284</property>
              </packing>
            </child>
            <child>
              <object class="GtkComboBox" id="combo1">
                <property name="width-request">176</property>
                <property name="visible">True</property>
                <property name="can-focus">False</property>
                <property name="model">liststore1</property>
                <property name="active">0</property>
                <property name="has-entry">True</property>
                <property name="entry-text-column">0</property>
                <property name="id-column">0</property>
                <property name="active-id">0</property>
                <signal name="changed" handler="on_combo1_changed" swapped="no"/>
                <child internal-child="entry">
                  <object class="GtkEntry" id="entry1">
                    <property name="can-focus">False</property>
                    <signal name="changed" handler="on_gentry1_changed" swapped="no"/>
                  </object>
                </child>
              </object>
              <packing>
                <property name="x">38</property>
                <property name="y">357</property>
              </packing>
            </child>
            <child>
              <object class="GtkColorButton" id="color1">
                <property name="width-request">100</property>
                <property name="height-request">33</property>
                <property name="visible">True</property>
                <property name="can-focus">True</property>
                <property name="receives-default">True</property>
                <signal name="color-set" handler="on_color1_color_set" swapped="no"/>
              </object>
              <packing>
                <property name="x">298</property>
                <property name="y">303</property>
              </packing>
            </child>
          </object>
        </child>

  </object>
</interface>

How do you handle resourece release while handling an exception in ADA?

Does ADA have an equivalent of C++'s destructors or Java's try-with-resources? That is, a technique where I can say that a resource acquired in this function is released when this function exits: whether normally or due to the handling of an exception. Is there a way to express such concept in ADA?

Different Values of Attribute 'Address on arm-none-eabi-gcc (cortex m0 / stm32f03)

On arm-none-eabi-gcc (cortex m0 / stm32f03), I see address values from Attribute'Address that seem to differ between those inserted at compile time and those which should be real. As an example, I look at the address of Hardfault_Handler.

This is my code:

 procedure Hardfault_Handler is
      SP : Address         := Get_Stack_Pointer; -- save sp after handler entry
      PC                 : Address := Get_Program_Counter; -- save current pc
      PC_Offset          : Storage_Offset  := PC - Hardfault_Handler'Address;
      Num_Of_Pushed_Regs : Natural         := 0;
      SP_Calc            : Integer_Address := To_Integer (SP);
      package Thumb_Ins_Pnt is new System.Address_To_Access_Conversions
        (Push_Instruction);
      use Thumb_Ins_Pnt;
      Temp_Ins : Object_Pointer;
   begin
      --loop over program code at start of hardfaulthandler
      for I in 0 .. PC_Offset when (I mod 2 = 0) loop
         Temp_Ins := To_Pointer (Hardfault_Handler'Address + I);
         -- is this a push instruction?
         if Temp_Ins.Mask = PUSH_Ins_Mask then
            -- yes, count number of regs we pushed to stack
            for Bit of Temp_Ins.Regs when Bit = True loop
               Num_Of_Pushed_Regs := Num_Of_Pushed_Regs + 1;
            end loop;
            -- alter back SP to Point before push (+ because stack grows down)
            SP_Calc := SP_Calc + 4 * Integer_Address (Num_Of_Pushed_Regs);

            declare
               Old_Regs : constant Stacked_Registers with
                 Import, Address => To_Address (SP_Calc + Stacked_Reg_Offset);
               Old_PC_Content : constant Thumb_Instruction with
                 Import, Address => Old_Regs.PC;
            begin
               if Old_PC_Content = Break_Point_Instruction then
                  -- Hardfault happend because no Debugger is connected,
                  -- just return
                  return;
               end if;
            end;
         end if;
      end loop;

      Put_Line ("Hard Fault");
      -- fault handling to be done
   end Hardfault_Handler;

Output of objdump:

 08000754 <m0__startup__hardfault_handler>:
   procedure Hardfault_Handler is
 8000754:       b5f8            push    {r3, r4, r5, r6, r7, lr}

   function Get_Stack_Pointer return Address is
      Result : Address;
   begin
      Asm
 8000756:       46ec            mov     ip, sp
   end Get_Stack_Pointer;

   function Get_Program_Counter return Address is
      Result : Address;
   begin
      Asm
 8000758:       467d            mov     r5, pc
      PC_Offset          : Storage_Offset  := PC - Hardfault_Handler'Address;
 800075a:       4e2a            ldr     r6, [pc, #168]  ; (8000804 <m0__startup__hardfault_h
andler+0xb0>)
   end "-";

Here the value for Hardfault_Handler"Address stored @8000804

    8000802:       bdf8            pop     {r3, r4, r5, r6, r7, pc}
 8000804:       08000755        stmdaeq r0, {r0, r2, r4, r6, r8, r9, sl}
 8000808:       08002a88        stmdaeq r0, {r3, r7, r9, fp, sp}
 800080c:       7fffffff        svcvc   0x00ffffff
 8000810:       0000beab        andeq   fp, r0, fp, lsr #29
 8000814:       08002a28        stmdaeq r0, {r3, r5, r9, fp, sp}
 8000818:       08002ad8        stmdaeq r0, {r3, r4, r6, r7, r9, fp, sp}

from inside gdb it looks like this:

gdb

also this is my vector table, the addresses are different too. But the reset handler, gets called and runs fine :

 Vector_Table : constant Address_Array :=
     (Sram_Stack_Start, Reset_Handler'Address, NMI_Handler'Address,
      Hardfault_Handler'Address, MemManage_Handler'Address,
      Bus_Fault_Handler'Address, Usage_Fault_Handler'Address, Reserved,
      Reserved, Reserved, Reserved, SVCall_Handler'Address,
      Debug_Handler'Address, Reserved, PendSV_Handler'Address,    
      Systick_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address, Default_Handler'Address,
      Default_Handler'Address);
   --Default_Handler'Address);
   pragma Linker_Section (Vector_Table, "_vector_table");

08000000 <m0__startup__vector_table>:
 8000000:       20001000        andcs   r1, r0, r0
 8000004:       080005b1        stmdaeq r0, {r0, r4, r5, r7, r8, sl}
 8000008:       08000699        stmdaeq r0, {r0, r3, r4, r7, r9, sl}
 800000c:       08000755        stmdaeq r0, {r0, r2, r4, r6, r8, r9, sl}
 8000010:       080006b1        stmdaeq r0, {r0, r4, r5, r7, r9, sl}
 8000014:       080006c9        stmdaeq r0, {r0, r3, r6, r7, r9, sl}
 8000018:       080006e1        stmdaeq r0, {r0, r5, r6, r7, r9, sl}
        ...

080005b0 <Reset_Handler>:

   -------------------
   -- Reset_Handler --
   -------------------

   procedure Reset_Handler is
 80005b0:       b570            push    {r4, r5, r6, lr}
      Data_L : Storage_Element with
        Volatile, Import, External_Name => "__data_size";

      Data_Length : constant Storage_Offset := Addr2SO (Data_L'Address);

      Data_Load_Array : Storage_Array (1 .. Data_Length) with
 80005b2:       4c16            ldr     r4, [pc, #88]   ; (800060c <Reset_Handler+0x5c>)
      Bss_L : Storage_Element with
        Volatile, Import, Convention => Asm, External_Name => "__bss_size";

Can someone explain this behavior?

Why can't I use subtypes from limited withed packages in subprogram declarations?

In Ada 2012, a limited with can be used from one file (for example, User) to import types from another package (for example, Provider), even when that package needs to import the current file. This is useful in cases where you have two mutually dependent types, such as the following, but you have them in two different packages, so you can't just use an incomplete type declaration like this:

    type Point;
    type Line;    -- incomplete types

    type Point is
        record
            L, M, N: access Line;
    end record;

    type Line is
        record
            P, Q, R: access Point;
    end record;

(the above example is from John Barnes' Programming in Ada 2012, section 13.5 Mutually dependent types)

However, my question doesn't even need mutually dependent types. I'm trying to compile some Ada code that was autogenerated using gcc -fdump-ada-spec -C some_c_header.h, which happens to contain some procedures and/or functions that have parameters being passed as access constant (const * in C), and I see no reason this shouldn't work using limited with, as fdump-ada-spec generates for me.

Why can't I use any subtypes from Provider inside a subprogram declaration? Using regular types is fine, but when trying to use subtypes gcc complains they do not exist in that package.

provider.ads

package Provider is

   type Fine_Type is range 0 .. 10_000;
   subtype Bad_Type is Fine_Type;

end Provider;

user.ads:

limited with Provider;

package User is

   procedure Do_It (A : access constant Provider.Bad_Type);

end User;

For completeness, here are stubs for the rest of the files you would need:

user.adb

package body User is

   procedure Do_It (A : access constant Provider.Bad_Type) is
   begin
      null;
   end Do_It;

end User;

limited_with_test.gpr

project limited_with_test is

   for Source_Dirs use ("src");
   for Main use ("main.adb");

   for Exec_Dir use "bin";
   for Object_Dir use "obj";
   for Create_Missing_Dirs use "True";

end limited_with_test;

If you put the sources into a directory called src, you can call gprbuild in the directory containing that directory and the gpr file, and you get:

$ gprbuild
using project file limited_with_test.gpr
Compile
   [Ada]          main.adb
user.ads:5:49: error: "Bad_Type" not declared in "Provider"
gprbuild: *** compilation phase failed

Avoiding warning 8-bit Ada Boolean return type, use Char

I have been working on cleaning up warnings on pedantic code, and we treat warnings as errors. I have interface code between Ada and C++, which looks like this:

Ada manager.ads:

function Foo(ID_Type : in Integer) return Boolean;
pragma Import(CPP, Foo, "Foo");

C++ Adamanager.cpp:

extern "C" bool Foo(int32_t ID)
{
  return Manager::GetManager()->Bar(ID);
}

C++ Adamanager.h:

extern "C" bool Foo(int32_t ID);

C++ manager.cpp:

bool Manager::Bar(int32_t ID)
{
   //function body
   return answer;
}

C++ manager.h

static bool Bar(int32_t ID);

gcc -c output for manager.ads:

warning: return type of "Foo" is an 8-bit Ada Boolean
warning: use appropriate corresponding type in C (e.g. char)

I have a bunch of these cases.

To get rid of the warnings, do I need to replace all of the bools with char or some other 8-bit type and then do an explicit type conversion in the Ada body code? Why would the compiler choose to have the boolean be 8-bit?

Can the gnat compiler find unused specification procedures/functions/variables?

Is there a warning option switch that will identify spec-level procedures, functions, or variables that are not called or referenced anywhere? I've tried the switches below without luck.

This is what I'm currently using: -gnatwfilmopuvz -- m turn on warnings for variable assigned but not read -- u turn on warnings for unused entity -- v turn on warnings for unassigned variable

When I move unused variables from the spec to the body, the compiler correctly identifies them as not referenced. I would like to understand why the compiler won't identify unused code in the spec, and if there is a way to get it to do so. An excessive number of warnings isn't a concern, because I use the filter field in gnat studio to only look at a few files at a time, and I can easily filter to ignore library packages.

Any help is very appreciated.

❌
❌