Ada SPARK read binary file - ada

I have this code in utils-file.ads,
package Utils.File with
SPARK_Mode
is
procedure Read_Content (File_Name : String);
end Utils.File;
and the corresponding utils-file.adb
with Interfaces;
with Ada.Sequential_IO;
package body Utils.File with
SPARK_Mode => Off
is
package Seq is new Ada.Sequential_IO (Interfaces.Unsigned_8);
procedure Read_Content (File_Name : String) with
SPARK_Mode => Off
is
Handle : Seq.File_Type;
Item : Interfaces.Unsigned_8 := 0;
begin
Seq.Open (Handle, Seq.In_File, File_Name);
Seq.Read (Handle, Item);
Seq.Close (Handle);
end Read_Content;
end Utils.File;
I try to call it from my main program,
with Utils.File;
procedure Main with
SPARK_Mode => On
is
begin
Utils.File.Read_Content ("foo.bin");
end Main;
When I run gnatprove, I get this error
main.adb:7:15: medium: "memory accessed through objects of access type" might not be initialized after elaboration of main program "Main"
It doesn't give that error if I use Text_IO instead of Sequential_IO, but I want to read it as binary and not text. What is it complaining about and how do I fix it?

Related

How to save an Access type of a Discriminant record for later use

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.

Ada: Manipulate a private type

I'm kinda new with Ada and recently got an error that I don't seem to know how to solve.
I have the following code:
data.ads
with Text_IO; use text_io;
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
package data is
type file is private;
type file_set is array (Integer range <>) of file;
procedure file_Print (T : in out file); --Not used
private
type file is record
start, deadline : integer;
end record;
end data;
Main.adb
with ada.Integer_Text_IO; use ada.Integer_Text_IO;
procedure Main is
Num_files: integer:=3;
Files:file_set(1..Num_files);
begin
Files(1):=(2,10); -- Expected private type "file" defined at data.ads
for i in 1..Num_Files loop
Put(integer'Image(i));
New_Line;
data.File_Print(Files(i));
But I'm getting this error Expected private type "file" defined at data.ads
How can I access the file type and declare a new array of values in main?
That's right - you don't get to see or manipulate what's inside a private type. That would be breaking encapsulation. Bugs and security risks follow.
You can only interact with a private type via its methods : functions and procedures declared in the package where it's declared.
Now file_set is NOT a private type (you might consider making it private later, for better encapsulation, but for now ....) you can index it to access a file within it (using one of those procedures).
Files(1):=(2,10);
As you want to create a file here, you need a method to create a file ... a bit similar to a constructor in C++, but really more like the Object Factory design pattern. Add this to the package:
function new_file(start, deadline : integer) return file;
And implement it in the package body:
package body data is
function new_file(start, deadline : integer) return file is
begin
-- check these values are valid so we can guarantee a proper file
-- I have NO idea what start, deadline mean, so write your own checks!
-- also there are better ways, using preconditions in Ada-2012
-- without writing explicit checks, but this illustrates the idea
if deadline < NOW or start < 0 then
raise Program_Error;
end if;
return (start => start, deadline => deadline);
end new_file;
procedure file_Print (T : in out file) is ...
end package body;
and that gives the users of your package permission to write
Files(1):= new_file(2,10);
Files(2):= new_file(start => 3, deadline => 15);
but if they attempt to create garbage to exploit your system
Files(3):= new_file(-99,-10); -- Oh no you don't!
this is the ONLY way to create a file, so they can't bypass your checks.

Ada elaboration not occurring at all

I have an unusual situation in which elaboration code is simply not being executed at all. This is not an elaboration order issue, but rather an elaboration at all issue.
The problem is that I don't "with" the unit in question whatsoever, yet in theory it should still be accessible, as long as its elaboration occurs.
Of course I could just add a useless "with" for the unit in question, but in my real use case there are a large number of units that I would have to do that with.
My question is if there is any way either in the code, through pragmas, in the gpr project file, or through command-line switches that I could force the compiler to include a file even though it thinks the file isn't referenced?
Here is a minimal working example:
as.ads:
package As is
type A is tagged null record;
type Nothing is null record;
function Create (Ignored : not null access Nothing) return A;
function Image (From : A) return String;
end As;
as.adb:
package body As is
function Create (Ignored : not null access Nothing) return A is
(null record);
function Image (From : A) return String is ("A");
end As;
finder.ads:
with Ada.Tags;
package Finder is
procedure Register (Name : String; Tag : Ada.Tags.Tag);
function Find (Name : String; Default : Ada.Tags.Tag) return Ada.Tags.Tag;
end Finder;
finder.adb:
with Ada.Containers.Indefinite_Vectors;
package body Finder is
type Name_Tag (Size : Natural) is
record
Name : String (1 .. Size);
To : Ada.Tags.Tag;
end record;
package Name_Tag_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Name_Tag);
Name_Tags : Name_Tag_Vectors.Vector := Name_Tag_Vectors.Empty_Vector;
procedure Register (Name : String; Tag : Ada.Tags.Tag) is begin
Name_Tags.Append ((Name'Length, Name, Tag));
end Register;
function Find (Name : String; Default : Ada.Tags.Tag) return Ada.Tags.Tag is begin
for Tag of Name_Tags loop
if Tag.Name = Name then
return Tag.To;
end if;
end loop;
return Default;
end Find;
end Finder;
bs.ads:
with As;
package Bs is
type B is new As.A with null record;
function Create (Ignored : not null access As.Nothing) return B;
function Image (From : B) return String;
end Bs;
bs.adb:
with Finder;
package body Bs is
function Create (Ignored : not null access As.Nothing) return B is
(As.Create (Ignored) with null record);
function Image (From : B) return String is ("B");
begin
Finder.Register ("B", B'Tag);
end Bs;
test.adb:
with As; use As;
-- with Bs; -- (uncommenting this line solves my problem, but what if I had the rest of the alphabet?)
with Finder;
with Ada.Tags.Generic_Dispatching_Constructor;
with Ada.Text_IO;
procedure Test is
function Constructor is new Ada.Tags.Generic_Dispatching_Constructor (
T => A,
Parameters => Nothing,
Constructor => Create);
Nada : aliased Nothing := (null record);
What : A'Class := Constructor (Finder.Find ("B", A'Tag), Nada'Access);
begin
Ada.Text_IO.Put_Line (What.Image);
end Test;
The compiler thinks your package Bs isn't referenced because it isn't. You don't have a with clause for it, so it's not part of your program.
A simple example:
a.ads
package A is
procedure Blah;
end A;
a.adb
with Ada.Text_IO;
package body A is
procedure Blah is begin null; end Blah;
begin
Ada.Text_IO.Put_Line("Elaborate A");
end A;
b.ads
package B is
procedure Blah;
end B;
b.adb
with Ada.Text_IO;
package body B is
procedure Blah is begin null; end Blah;
begin
Ada.Text_IO.Put_Line("Elaborate B");
end B;
main.adb
with Ada.Text_IO;
with A;
procedure Main is
begin
Ada.Text_IO.Put_Line("Main");
end Main;
When I run main, it prints
Elaborate A
Main
It doesn't print Elaborate B because that package isn't part of the program; it's just a couple of source files in the same directory.
The obvious solution is to add the with clauses.
I don't know whether there's a less obvious solution. If there is, it's probably compiler-specific. But I'm not sure why a compiler would have a feature that lets you incorporate an otherwise unused package into a program.
What I’ve done (e.g. here ff) is to actually reference the units in the main program (with pragma Unreferenced to prevent warnings).
Alternatively, you could have a package e.g. Required_Units with all the necessary withs included, and then with that from the main program.
Even if there was some alternative process, you’d have to tell it what units you need to have included; might as well go with the flow and do it in Ada!
Since the package Bs is invisible to your program, so is the type B.
So the next question is: why do you need to register type B if it is not used anywhere?
If an Ada compiler did elaborate all units (packages or standalone subprograms) that are irrelevant to a main program, but are visible through source path, it would become really messy!...

Ada compilation confusion

I am trying to get my head around OOP in Ada. In order to do so, I need to understand how to name, compile and link package files with gnatmake.
This website (http://www.infres.enst.fr/~pautet/Ada95/chap22.htm) has good examples, but I don't understand how to compile the various bits of the program.
I am looking at e_c22_p2.ada and e_c22_p3.ada. From these I created a file called Conveyance1.ads and added the content of e_c22_p2 into this, and a file called Vehicle1.adb and added the content of e_c22_p3.ada in there. I used gnatmake Vehicle1.adb, but there are compilation errors.
e_c22_p2.ada contains:
-- Chapter 22 - Program 2
package Conveyance1 is
-- This is a very simple transportation type.
type TRANSPORT is
record
Wheels : INTEGER;
Weight : FLOAT;
end record;
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER;
Weight_In : FLOAT);
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER;
function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT;
-- This CAR type extends the functionality of the TRANSPORT type.
type CAR is new TRANSPORT;
function Tire_Loading(Vehicle_In : CAR) return FLOAT;
end Conveyance1;
package body Conveyance1 is
-- Subprograms for the TRANSPORT record type.
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER;
Weight_In : FLOAT) is
begin
Vehicle_In.Wheels := Wheels_In;
Vehicle_In.Weight := Weight_In;
end Set_Values;
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER is
begin
return Vehicle_In.Wheels;
end Get_Wheels;
function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT is
begin
return Vehicle_In.Weight;
end Get_Weight;
-- Subprogram for the CAR record type.
function Tire_Loading(Vehicle_In : CAR) return FLOAT is
begin
return Vehicle_In.Weight / FLOAT(Vehicle_In.Wheels);
end Tire_Loading;
end Conveyance1;
-- Results of execution
--
-- (This package cannot be executed alone.)
The file e_c22_p2.ada contains two program units, the spec and the body of package Conveyance1.
Many Ada compilers would be quite happy with this, and it is possible with some difficulty to persuade GNAT to accept it as-is, but GNAT’s default is to expect one program unit per file, with the file name equal to the unit name in lower case (dots replaced by hyphens), and .ads for the spec, .adb for the body.
GNAT comes with a tool gnatchop (see here) which takes input files like your e_c22_p2.ada and splits them up into the source files that GNAT expects (conveyance1.ads and conveyance1.adb).
As mentioned by Simon, this .ada file has two sections : specs and body.
So create two files as below:
Conveyance1.ads - it contains the declarations of functions, procedures, variables
Conveyance1.adb - it contains the bodies of the functions, procedures
The first file
-- Conveyance1.ads
---------------------------------------------------------------------------------
package Conveyance1 is
-- This is a very simple transportation type.
type TRANSPORT is
record
Wheels : INTEGER;
Weight : FLOAT;
end record;
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER;
Weight_In : FLOAT);
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER;
function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT;
-- This CAR type extends the functionality of the TRANSPORT type.
type CAR is new TRANSPORT;
function Tire_Loading(Vehicle_In : CAR) return FLOAT;
end Conveyance1;
And second file,
-- Conveyance1.adb
------------------------------------------------------------------
package body Conveyance1 is
-- Subprograms for the TRANSPORT record type.
procedure Set_Values(Vehicle_In : in out TRANSPORT;
Wheels_In : INTEGER;
Weight_In : FLOAT) is
begin
Vehicle_In.Wheels := Wheels_In;
Vehicle_In.Weight := Weight_In;
end Set_Values;
function Get_Wheels(Vehicle_In : TRANSPORT) return INTEGER is
begin
return Vehicle_In.Wheels;
end Get_Wheels;
function Get_Weight(Vehicle_In : TRANSPORT) return FLOAT is
begin
return Vehicle_In.Weight;
end Get_Weight;
-- Subprogram for the CAR record type.
function Tire_Loading(Vehicle_In : CAR) return FLOAT is
begin
return Vehicle_In.Weight / FLOAT(Vehicle_In.Wheels);
end Tire_Loading;
end Conveyance1;
These 2 are ada package files.
In order to use these you need to create another .adb (say demo.adb) file as below.
Then 'with' and 'use' these files in demo.adb
-- demo.adb
------------------------------------------------------------------
with Conveyance1; use Conveyance1;
with Ada.Text_IO; use Ada.Text_IO;
procedure demo is
my_scooter : TRANSPORT;
begin
Set_Values(my_scooter, 3, 250.00); -- it has a sidecar as well !!!!
end demo;
and then finally compile your code with
gnatmake demo.adb
it will compile your included packages as well.

Ada DLL causes Seg Fault in system.secondary_stack.ss_mark

How do I fix this Seg Fault in my DLL?
I'm generating a Windows DLL (in Ada) and using the DLL from an Ada
program. I’m using AdaCore’s GNAT GPS v6.0.1 IDE for both the DLL
and an Ada program to test the DLL, running on a Windows 7 machine.
Two separate project files are used, one for the DLL, the other for
the test driver. The DLL does not have any DLLMain nor initialization
or finalization routines.
As a first step (because I've never created a DLL or used GPS prior to this, do know some Ada though), I coded two very simple functions for the DLL. One function returns a pointer to a string, the other function returns a fixed length string.
The test program successfully calls the DLL function that returns a fixed-length
string, however when calling the function that returns a string pointer, a
segmentation fault occurs. Here is the gcc debug output:
Program received signal SIGSEGV, Segmentation fault.
0x6b81dd2c in system.secondary_stack.ss_mark () from C:\GNAT\2014\bin\libgnat-2014.dll
(gdb) quit
Here is the code:
DLL Spec
with Ada.Strings.Fixed; use Ada.Strings.Fixed;
package String_Utils is
type String_Ptr_T is access String;
type Spec_Str is new String (1..7);
function Int_Trim_Left( IntToTrim : Integer) return String_Ptr_T;
pragma Export(DLL, Int_Trim_Left, "String_Utils__Int_Trim_Left");
function Spec( Input_Int : Integer) return Spec_Str;
pragma Export(DLL, Spec, "String_Utils__Spec");
end String_Utils;
DLL Body
package body String_Utils is
function Int_Trim_Left( IntToTrim : Integer) return String_Ptr_T is
String_Ptr : String_Ptr_T;
begin
Text_IO.Put_Line("About to call new String in DLL.");
String_Ptr := new String'(
Ada.Strings.Fixed.Trim(Integer'Image(IntToTrim),
Ada.Strings.Left));
return String_Ptr;
end;
--
function Spec( Input_Int : Integer) return Spec_Str
is
Result_Spec : String := "ABC-UNK";
begin
case Input_Int is
when 1 => return "ABC-STD"; -- Standard
when 2 => return "ABC-PRF"; -- Performance
when 3 => return "DEF-DTL"; -- Detailed
when Others => return "ABC-UNK";
end case;
end;
DLL Project File
project HAGUtils is
for Library_Name use "HAGUtils";
for Library_Dir use "libdir";
for Library_Version use "0.01";
for Library_Kind use "dynamic";
for Object_Dir use "obj";
for Source_Dirs use ("src");
for Source_Files use ("string_utils.adb", "string_utils.ads");
end HAGUtils;
Test Driver
-- Driver for DLL
with Text_IO; use Text_IO;
procedure test_ada_dll is
type String_Ptr_T is access String;
subtype String7 is String(1..7);
input_val : Integer := 0;
Spec_Str : String7 := (Others => ' ');
Int_String_Ptr : String_Ptr_T:= null;
-- Import
function Int_Trim_Left ( IntToTrim : Integer) return String_Ptr_T
is
function Inner_Int_Trim_Left ( IntToTrim : Integer) return String_Ptr_T;
pragma Import (DLL, Inner_Int_Trim_Left, "String_Utils__Int_Trim_Left");
begin
return Inner_Int_Trim_Left (IntToTrim);
end Int_Trim_Left;
-- Import
function Spec ( Input_Int : Integer) return String7
is
function Inner_Spec ( Input_Int : Integer) return String7;
pragma Import (DLL, Inner_Spec, "String_Utils__Spec");
begin
return Inner_Spec (Input_Int);
end Spec;
begin
input_val := 3;
Spec_Str := Spec(input_val);
Text_IO.Put_Line("The Spec is -- " & Spec_Str);
Text_IO.Put_Line("Calling Int_Trim_Left with --" & Integer'Image(input_val));
Int_String_Ptr := Int_Trim_Left(input_val);
Text_IO.Put_Line("After call --" & Int_String_Ptr.all);
end;
I think that the SEGV happened because your DLL wasn’t initialized. The Ada runtime system needs initialization, which in the absence of DLLs would be called up in the GNAT bind process (you may have seen calls to gnatbind or gprbind flashing up the screen).
However, you have a DLL that requires the RTS to be initialized (the part that deals with the secondary stack, which is where GNAT constructs temporary unconstrained objects such as strings); but the binder isn’t aware of this because of the way you’ve linked your program (you don’t say, but I suspect you’ve specified the DLL via -lHAGutils?).
The way to get GNAT to handle this for you is to write a project file for the test program and have it with your DLL’s project:
with "HAGutils";
project Test_Ada_Dll is
for Main use ("test_ada_dll.adb");
for Exec_Dir use ".";
for Source_Files use ("test_ada_dll.adb");
for Object_Dir use ".build";
end Test_Ada_Dll;
This then makes the interfaces of HAGlib visible to test_ada_dll, so you can change it to say
with Text_IO; use Text_IO;
with String_Utils;
procedure test_ada_dll is
input_val : Integer := 0;
Spec_Str : String_Utils.Spec_Str := (Others => ' ');
Int_String_Ptr : String_Utils.String_Ptr_T:= null;
begin
input_val := 3;
Spec_Str := String_Utils.Spec(input_val);
Text_IO.Put_Line("The Spec is -- " & String (Spec_Str));
Text_IO.Put_Line("Calling Int_Trim_Left with --" & Integer'Image(input_val));
Int_String_Ptr := String_Utils.Int_Trim_Left(input_val);
Text_IO.Put_Line("After call --" & Int_String_Ptr.all);
end;
(note, the conversion in Text_IO.Put_Line("The Spec is -- " & String (Spec_Str)); is because Spec_Str is a derived type; I think it’s be more normal in this case to make it a subtype).
Further, you no longer need to use the pragma Exports in String_Utils’s spec.
The result of this is that the binder is aware of the properties of your HAGutils DLL, and can arrange for the necessary initializations to happen.
There is a way in which you can make your original code work, which is to use the GPR attribute Library_Auto_Init in HAGutils.gpr:
for Library_Auto_Init use “true”;
but I think you’d have to make HAGlib a proper standalone library. This is quite complex to get right, and not necessary to get the library working to start with.

Resources