Prevent Ada 202x Use in GNAT - ada

GNAT allows the following code due to Random(Generator, First, Last) being implemented in the runtime, but it's not part of Ada 2012. Can I cause this to generate a compile error since it shouldn't be available?
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Numerics.Discrete_Random;
procedure Main is
package Positive_Random is new Ada.Numerics.Discrete_Random
(Result_Subtype => Positive);
Generator : Positive_Random.Generator;
-- This should fail, since function isn't part of Ada 2012.
Value : Positive := Positive_Random.Random (Generator, 1, 10);
begin
Put_Line (Value'Image);
end Main;
This is my gpr file:
project Default is
for Source_Dirs use ("src");
for Object_Dir use "obj";
for Main use ("main.adb");
package Compiler is
for Switches ("ada") use ("-gnat12");
end Compiler;
end Default;

In my point of view, the standard way to do this is to add a global restriction:
pragma Restrictions (No_Implementation_Identifiers);
No_Implementation_Identifiers
There are no usage names that denote declarations with implementation-defined identifiers that occur within language-defined packages or instances of language-defined generic packages.
But this doesn't work in GNAT Community Edition 2021 (nor in GCC 11, I guess).
You can create a custom GNAT run-time and delete this subprogram or mark it with aspect Implementation_Defined to make the restriction work.

Related

Deep copy of function arguments for polymorphic types

I use an object based on a base package roughly defined as:
package Base is
type T_Base is abstract tagged null record;
-- This performs a deep copy. Shallow copies may lead to STORAGE_ERROR.
-- This shall be implemented by every derived type.
function Copy (From : in T_Base) return T_Base'Class is abstract;
end package Base;
This package is derived by several packages which are further derived
package Foo is
type T_Foo is new T_Base with record
A_Data : Natural; -- Of course, in the real code, these are types by far more complex.
end record;
procedure do_something (Foo_Object : in T_Foo);
-- This implements the deep copy
function Copy (From : in T_Foo) return T_Base'Class is abstract;
end package Foo;
On calling the procedure do_something, I do get a storage_error:
procedure handle_received_foo (Foo_In: in Foo.T_Foo) is
begin
Foo.do_something (Foo_Object => Foo_In); -- The storage error does happen here.
end main;
When running the code with gdb, I get a segfault on entering the function and I get:
Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread 39 (LWP 39)]
0x033c9828 in foo.do_something (foo_object=...) at ./foo.adb:67
67 procedure do_something (Foo_Object : in T_Foo);
(gdb) p foo_object
$1 (null)
So I guess I get a storage_error when doing the shallow copy of the argument Foo_Object.
I am aware that this is no MWE and that there might be a mistake in one of the types present used in the derived types.
I can't find any good option:
Making T_Foo a Controlled type to call Copy in Adjust seems not to be possible without greatly changing its definition as I can't derive T_Foo both from T_Base and Ada.Finalization.Controlled since none of them is an interface types
Defining T_Base as
type T_Base is abstract new Ada.Finalization.Controlled with null record;
and override Adjust here seems to induce a hell lot too much modifications on the existing code base as gnat yields in multiple places
type of aggregate has private ancestor "Controlled" must use extension aggregate.
So I'm low on solutions to either investigate the problem further or to solve it with a hammer.
The problem was not in the Copy function. The comments I saw in the code base were misleading.
The fact that introducing new variables changed the location of the exception made me consider some stack overflow problems.
Indeed the Storage_Size allocated for the task was not sufficient. Increasing the pragma Storage_Size(<value>) solved the problem.
Since the code base is compiled with -fstack-check, this led to the aforementioned STORAGE_ERROR.
More infos on Adacore's documentation.
This could probably have been seen with Gem #95: Dynamic Stack Analysis in GNAT but I am not currently able to see any result with the binding option suggested therein.

How to stop console window from closing immediately | GNAT - GPS

I have Ada program that runs and compile perfectly using GNAT - GPS. When I run its exe file and provide user input then instead of saying "Press any key to continue", the exe closes immediately.
I have searched for it online alot but i only found info related to c/c++/visual studio console window using system('pause'); OR Console.Readline().
Is there any way around for this in Ada lanaguage?
Apart from using Get_Line or Get, you can also use Get_Immediate from the Ada.Text_IO package. The difference is that Get_Line and Get will continue to read user input until <Enter> has been hit, while Get_Immediate will block only until a single key has been pressed when standard input is connected to an interactive device (e.g. a keyboard).
Here's an example:
with Ada.Text_IO; use Ada.Text_IO;
procedure Main is
begin
-- Do some interesting stuff here...
declare
User_Response : Character;
begin
Put_Line ("Press any key to continue...");
Get_Immediate (User_Response);
end;
end Main;
NOTES
You should run the program in an interactive terminal (Bash, PowerShell, etc.) to actually see the effect of Get_Immediate. When you run the program from within GPS, then you still have to press enter to actually exit the program.
This might be too much detail, but I think that Get still waits for <Enter> to be pressed because it uses fgetc from the C standard library (libc) under the hood (see here and here). The function fgetc reads from a C stream. C streams are initially line-buffered for interactive devices (source).
The answer from #DeeDee is more portable and only Ada and the preferable way to go, so my answer is just if you are looking for a "windows" way to do it.
I think there is a linker option for it, but I couldn't find it. A more manual way is to bind the system() command from C and give it a "pause" command and place it at the end of your program:
with Ada.Text_IO; use Ada.Text_IO;
with Interfaces.C.Strings;
procedure Main is
function System(Str : Interfaces.c.strings.chars_ptr) return Interfaces.C.int
with Import,
Convention => C,
External_Name => "system";
procedure Pause is
Command : Interfaces.c.Strings.chars_ptr
:= Interfaces.C.Strings.New_String("pause");
Result : Interfaces.C.int
:= System(Command);
begin
Interfaces.C.Strings.Free(Command);
end Pause;
begin
Put_Line("Hello World");
Pause;
end Main;
I know you mentioned seeing about pause already, but just wanted to show an example.
The same way you could use Console.Readline(), you can use Get_Line from the package Ada.Text_IO.
In this case, you will have to put the result into a String that you won't use.

How do you implement Generic_Sorting in Ada for a vector?

I'm trying to do some basic translations of old C++ code from many moons ago to learn Ada, and I have been absolutely stumped on how to sort a vector using the built-in Generic_Sorting. I haven't been able to find any concrete examples of it in action, the closest being a now-defunct Danish wiki article which looks like it would have had a full example but the archive didn't snatch it up: https://web.archive.org/web/20100222010428/http://wiki.ada-dk.org/index.php/Ada.Containers.Vectors#Vectors.Generic_Sorting
Here is the code as I thought it should work from the above link:
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Containers.Vectors; use Ada.Containers;
procedure Vectortest is
package IntegerVector is new Vectors
(Index_Type => Natural,
Element_Type => Integer);
package IVSorter is new Generic_Sorting;
IntVec : IntegerVector.Vector;
Cursor : IntegerVector.Cursor;
begin
IntVec.Append(3);
IntVec.Append(43);
IntVec.Append(34);
IntVec.Append(8);
IVSorter.Sort(Container => IntVec);
Cursor := IntegerVector.First(Input);
while IntegerVector.Has_Element(Cursor) loop
Put(IntegerVector.Element(Cursor));
IntegerVector.Next(Cursor);
end loop;
end Vectortest;
I've tried so many different combinations of use and with but all I can get are various error codes. The above code gives Generic_Sorting is not visible, but when I try to explicitly state with Ada.Containers.Vectors.Generic_Sorting I get the error "Ada.Containers.Vectors.Generic_Sorting" is not a predefined library unit. I have no idea what I'm doing wrong here, I'm sure it's a fundamental misunderstanding of the way Ada brings in packages, and I hope that nailing this down will help me understand it a bit better.
Generic_Sorting is an inner package to Ada.Containers.Vectors and cannot be explicitly withed (as you have discovered). And since Ada.Containers.Vectors is itself a generic package, Generic_Sorting is an inner package to the instantiation of Ada.Containers.Vectors. So you can reach it by prefixing with the name of the instance:
package IVSorter is new IntegerVector.Generic_Sorting;

Ada object declarations "Unsigned Not Declared in System"

In some code that I inherited, I get the compile error "Unsigned" not declared in "System".
I'm trying to compile this using GNAT, but ultimately the code must compile with the original tools, which I don't have ready access to. So I'd like to understand how to resolve this from within the development environment (including the project file), and not modify the existing code.
I checked the file system.ads, and Unsigned is not defined there. Am I referring to the wrong libraries? How would I resolve this with the self imposed constraint mentioned above (to compile in the original environment)?
unsigned is the name of a predefined type in C. If what you need it an Ada type that matches the C type, what you need is Interfaces.C.unsigned. An older Ada implementation (before Interfaces.C was introduced by the 1995 standard) might have defined System.Unsigned for this purpose.
It would help to know what Ada implementation the code was originally written for.
You should examine the code to see whether it uses that type to interface to C code. If not (i.e., if it's just being used as a general unsigned integer type), you might instead consider defining your own modular type.
If I understand correctly, you need the code to compile both in the original environment and with GNAT. That might be difficult. One approach would be to define a new package with two different versions, one for the original environment and one for GNAT (or, ideally, for any modern Ada implementation). For example:
-- version for original environment
with System;
package Foo is
subtype Unsigned is System.Unsigned;
end foo;
and:
-- version for GNAT
with Interfaces.C;
package Foo is
subtype Unsigned is Interfaces.C.Unsigned;
end Foo;
Picking a better name than Foo is left as an exercise, as is determining automatically which version to use.
You could rebuild the GNAT runtime system (RTS) with a slightly modified system.ads.
There’s a Makefile.adalib in the system RTS (well, there is in GNAT GPL 2014) which lets you do this. It’s at the last directory indicated in the “Object Search Path” section of the output of gnatls -v.
The RTS source is similarly indicated in the “Source Search Path” section.
Create a directory say unsigned with subdirectories adainclude, adalib.
Copy the RTS source into unsigned/adainclude, and edit system.ads to include
type Unsigned is mod 2 ** 32;
(I’m guessing a bit, but this is probably what you want!)
Then, in unsigned/adalib,
make -f Makefile.adalib ADA_INCLUDE_PATH=../adainclude ROOT=/opt/gnat-gpl-2014
(ROOT is where you have the compiler installed; it will be different on your system, it’s one above the bin directory in which gnatls and friends are installed).
There will be several errors during this, all caused (when I tried it) by units that use System.Unsigned_Types;. Work round this by inserting this immediately after the package body in the .adb:
subtype Unsigned is System.Unsigned_Types.Unsigned;
The files I had to change were
s-expmod.adb
s-expuns.adb
s-imgbiu.adb
s-imgrea.adb
s-imguns.adb
s-imgwiu.adb
s-valint.adb
s-valuns.adb
s-vercon.adb
It may be best at this stage to remove all the .ali and .a files from unsigned/adalib and repeat, to get a clean build.
Now, you should be able to use System.Unsigned by
gnatmake --RTS=/location/of/unsigned t.adb
In my case, t.adb contained
with System;
with Ada.Text_IO; use Ada.Text_IO;
procedure T is
begin
Put_Line ("first: " & System.Unsigned'First'Img);
Put_Line ("last: " & System.Unsigned'Last'Img);
Put_Line ("42: " & System.Unsigned'Value ("42")'Img);
Put_Line ("16#42#:" & System.Unsigned'Value ("16#42#")'Img);
end T;
and the output was
$ ./t
first: 0
last: 4294967295
42: 42
16#42#: 66

Subprogram contracts in Ada

I'm reading a document on Ada programming to be more specific, Ada for C++ Java developer, or I'm in trouble and to understand and be able to use some of the examples given in the document, one of them is on pre- and postconditions
But, when I compile that program, I just got a +Inf**** message - I was expecting compilation to fail because I am trying to pass 0 as the divisor.
with Ada.Text_IO;
use Ada.Text_IO;
procedure main is
function Divisao(Left, Right : Float) return Float
with Pre => Right /= 0.0,
Post => Divisao'Result * Right < left + 0.0001
and then Divisao'Result * Right > Left - 0.0001
is
begin
return Left/Right;
end Divisao;
begin
Put_Line(Float'Image(Divisao(10.3,0.0)));
end main;
By ARM 11.4.2 (1.1), pre- and postconditions are assertions. GNAT doesn’t enable assertions by default: you need to enable them by compiling with -gnata.
If you are using gprbuild, you will need to add something like this to your project.gpr file:
package Compiler is
for Default_Switches ("Ada") use
("-gnata"); -- enable assertions
end Compiler;

Resources