In this page, John Barnes writes:
If the conditional expression is the argument of a type conversion then effectively the conversion is considered pushed down to the dependent expressions. Thus
X := Float(if P then A else B);
is equivalent to
X := (if P then Float(A) else Float(B));
So why can't I compile the following program under GNAT 10.3.0?
procedure Main is
P : Boolean := True;
X : Float;
begin
X := Float (if P then 0.5 else 32);
end Main;
Compile
[Ada] main.adb
main.adb:5:35: expected a real type
main.adb:5:35: found type universal integer
gprbuild: *** compilation phase failed
Because you’ve found a long-standing error in the compiler! (same behaviour in GCC 12.1.0).
John Barnes’ justification is at AARM 4.5.7(10ff).
thanks for providing real code and the error messages!
Related
I was reading about strong typing in Ada focused on units checking, and decided to test the naive approach out myself:
procedure Example is
type Meters is new Float;
type Meters_Squared is new Float;
function "*" (Left, Right : Meters) return Meters_Squared is
begin
return Meters_Squared(Float(Left)*Float(Right));
end;
len_a : Meters := 10.0;
len_b : Meters := 15.0;
surface : Meters_Squared;
len_sum : Meters;
begin
len_sum := len_a + len_b; -- ok
surface := len_a * len_b; -- ok
len_sum := len_a * len_b; -- invalid
end Example;
Now I know that this is not actually practical approach, I'm trying this just as a learning experience. And based on my attempts so far, I must be missing something, because when I try to compile the example listed above, I get no errors:
$ make example
gcc -c example.adb
gnatmake example.adb
gnatbind -x example.ali
gnatlink example.ali
While when I drop the function definition overloading the multiplication operator, it fails as expected:
$ make example
gcc -c example.adb
example.adb:14:20: expected type "Meters_Squared" defined at line 3
example.adb:14:20: found type "Meters" defined at line 2
make: *** [Makefile:6: example] Error 1
With this in mind, I don't understand how, with the multiplication operator overloading, the compiler could be ok with surface := len_a * len_b and len_sum := len_a * len_b at the same time.
Your "*" overloading is just that; Meters inherits
function "*" (Left, Right: Meters) return Meters;
from Float.
What you can do is suppress that inherited function:
function "*" (Left, Right: Meters) return Meters
is abstract;
In this case, marking the undesired function abstract removes it from consideration for overload resolution: in ARM 6.4(8) we have
... The name or prefix shall not resolve to denote an abstract subprogram unless it is also a dispatching subprogram.
and Meters isn’t a tagged type, so "*" isn’t dispatching.
You can also declare a non-overloaded subprogram abstract:
function "and" (Left, Right : Meters) return Meters
is abstract;
to which GNAT says cannot call abstract subprogram "and", because of ARM 3.9.3(7).
I was expecting this program to raise an error when I feed it 3 as a valid Scale value, but no such luck:
with Ada.Text_IO; use Ada.Text_IO;
procedure predicate is
type Scale is new Integer
with Dynamic_Predicate => Scale in 1 | 2 | 4 | 8;
GivesWarning : Scale := 3; -- gives warning
begin
Put_Line ("Hello World");
loop
Put_Line ("Gimme a value");
declare
AnyValue : Integer := Integer'Value (Get_Line);
S : Scale := Scale (AnyValue); -- no check done!
begin
Put_Line ("okay, that works" & S'Image);
end;
end loop;
end predicate;
I found this related question, but there the requirement is to use an enum., and the solution is to define an array from enum -> value.
I want something that gives me at least a warning at compile time, and allows me to check at runtime as well, and that raises an error if I try to put an invalid value in. Then, if I can use SPARK to prove that no invalid values can occur, I could turn off said checks. I was under the impression that this was how Static_ / Dynamic_ predicates work, so the example above took me by surprise.
You need to enable assertions. Either compile with -gnata or set an appropriate Assertion_Policy
pragma Assertion_Policy(Dynamic_Predicate => Check);
Issue:
How do I save an Access Pointer to a discriminant record for use later on in the program?
In main.adb (1) I demonstrate how I was able to get it to compile, but I get a runtime error:
raised PROGRAM_ERROR : main.adb:14 accessibility check failed
Note:
This is small example program based on a much larger/complex codebase.
Constraints:
i. The solution is required to be Ada95 Compatible.
ii. The solution must not change the package specification of Foo.ads as this is existing code that must be used as-is.
foo.ads
with Interfaces;
package Foo is
type Base_Class is abstract tagged limited private;
type Base_Class_Ref is access all Base_Class'Class;
for Base_Class_Ref'Storage_Size use 0;
Max_Count : constant := 6;
type Count_Type is new Interfaces.Unsigned_16 range 1 .. Max_Count;
type Foo_Class (Max : Count_Type) is new Base_Class with private;
type Foo_Class_Ref is access all Foo_Class;
for Foo_Class_Ref'Storage_Size use 0;
--
procedure Initialize (This_Ptr : Access Foo_Class);
--
function Get_Using_Pointer (This_Ptr : in Foo_Class_Ref) return Interfaces.Unsigned_16;
private
type Base_Class is abstract tagged limited null record;
type My_Data_Type is
record
X, Y, Z : Interfaces.Unsigned_16;
end record;
type My_Data_Array is
array (Count_Type range <>) of My_Data_Type;
type Foo_Class (Max : Count_Type) is new Base_Class with
record
Other_Data : Interfaces.Unsigned_16;
Data : My_Data_Array(1 .. Max);
end record;
end Foo;
foo.adb
package body Foo is
-- --------------------------------------------------------------------
procedure Initialize (This_Ptr : Access Foo_Class) is
begin
This_Ptr.Other_Data := 0;
This_Ptr.Data := (others => (0,0,0));
end Initialize;
-- --------------------------------------------------------------------
function Get_Using_Pointer (This_Ptr : in Foo_Class_Ref)
return Interfaces.Unsigned_16 is
begin
return This_Ptr.Other_Data;
end Get_Using_Pointer;
end Foo;
main.adb
-------------------------------------------------------------------------------
--
-- Issue:
-- How do I save an Access Pointer for later use (1) to a discriminent record?
--
-- Constraints:
-- i. The solution is required to be Ada95 Compatible.
-- ii. The solution must not change the package specification of Foo.ads
--
-------------------------------------------------------------------------------
--
with Interfaces;
with Foo;
procedure Main is
Foo_Count : constant := 3;
Foo_Obj : aliased Foo.Foo_Class (Max => Foo_Count);
procedure TEST (This_Ptr : access Foo.Foo_Class) is
-- (1) Save Pointer
-- **** This Line reports: ****
-- raised PROGRAM_ERROR : main.adb:14 accessibility check failed
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Access; -- This Compiles...
-- ^^^ I know that this is not correct.
-- But it was the only way I could find to get it to compile.
Data : Interfaces.Unsigned_16;
begin
-- (2) Get Data
Data := Foo.Get_Using_Pointer(This_Ptr => Foo_Ptr); -- This Compiles...
end;
begin
Foo.Initialize(This_Ptr => Foo_Obj'Access);
Test(This_Ptr => Foo_Obj'Access);
end Main;
Quick answer:
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Unchecked_Access;
Checked as far as I can with
lockheed:jerunh simon$ gnatmake main.adb -gnat95 -f
gcc -c -gnat95 main.adb
gcc -c -gnat95 foo.adb
gnatbind -x main.ali
gnatlink main.ali
lockheed:jerunh simon$ ./main
lockheed:jerunh simon$
In the line
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Access;
replace 'Access with 'Unchecked_Access.
PS. It could cause a dangling references if you destroy the object before Foo_Ptr gone.
The types Base_Class_Ref and Foo_Class_Ref are named access types and variables of this type can only refer to objects either on the heap or on package level, NOT objects on the stack. Since Storage_Size is set to zero it means the heap is out of the question.
package Main_App is
procedure Run;
end Main_App;
package body Main_App is
procedure TEST (This_Ptr : access Foo.Foo_Class) is
-- (1) Save Pointer
-- **** This Line reports: ****
-- raised PROGRAM_ERROR : main.adb:14 accessibility check failed
Foo_Ptr : Foo.Foo_Class_Ref := This_Ptr.all'Access; -- This Compiles...
-- ^^^ I know that this is not correct.
-- But it was the only way I could find to get it to compile.
Data : Interfaces.Unsigned_16;
begin
-- (2) Get Data
Data := Foo.Get_Using_Pointer(This_Ptr => Foo_Ptr); -- This Compiles...
end TEST;
Foo_Count : constant := 3;
Foo_Obj : aliased Foo.Foo_Class (Max => Foo_Count);
procedure Run is
begin
Foo.Initialize (This_Ptr => Foo_Obj'Access);
TEST (This_Ptr => Foo_Obj'Access);
end Run;
end Main_App;
with Main_App;
procedure Main is
begin
Main_App.Run;
end Main;
I hope this solution applicable to your use-case since it avoids usage of Unchecked_Access.
Ok what you're dealing with here is an anonymous access type, from the signature procedure TEST (This_Ptr : access Foo.Foo_Class). The error is telling you that this particular subprogram is in a deeper nesting than the thing it's pointing to: IOW, it could give you a dangling reference.
The proper solution, staying strictly in Ada95 would be to (A) put the TEST subprogram in the library unit [IIRC; 95 and 2005 are so similar they blur together]; or (B) put use a generic.
For a generic, IIRC, you can do this:
Generic
Object : Aliased Foo_Class'Class; -- Might not need 'Class.
with Function Operation(This_Ptr : in Foo_Class_Ref) return Interfaces.Unsigned_16;
Procedure Execute;
--...
Procedure Execute is
Result : Interfaces.Unsigned_16;
Begin
Result:= Operation( Object'Access );
End Execute;
----------------------------------------
O : Aliased Foo.Foo_Class(3);
Procedure TEST is new Foo.Execute( Operation => Foo.Get_Using_Pointer, Object => O );
This might require a little fiddling for your application, but if you put the generic inside Foo.ads/Foo.adb`, it should work. [IIRC] Aside from this, your best bet is to move your aliased object outside your main subprogram's declaration area, then it should work.
Is there a way to specify a custom error/on failure message for pre- and postconditions, by analogy with Predicate_Failure for predicates? I can't seem to be able to find anything in the official documentation. TIA.
You could use a raise expression (see e.g here) as shown in the example below.
main.adb
pragma Assertion_Policy (Check);
with Ada.Text_IO;
with Ada.Float_Text_IO;
procedure Main is
package TIO renames Ada.Text_IO;
package FIO renames Ada.Float_Text_IO;
function Reciprocal (X : Float) return Float is (1.0 / X)
with Pre => (X /= 0.0 or else
raise Constraint_Error with "X must not be 0.");
begin
FIO.Put (Reciprocal (2.0));
TIO.New_Line;
FIO.Put (Reciprocal (0.0));
TIO.New_Line;
end Main;
output
$ ./obj/main
5.00000E-01
raised CONSTRAINT_ERROR : X must not be 0.
[2020-07-03 22:20:25] process exited with status 1, elapsed time: 00.32s
I am learning Ada (by trying https://adventofcode.com/2018/ problems). To start with, I am trying to develop a number of "utility" packages that will help with text processing etc.
I have successfully written a function that will read from stdin and return an array of Unbounded_Strings for each input line.
I am trying to modify that function to do the same, but instead convert each Unbounded_String to an Integer before insertion into the array.
Here is my package:
get_stdin.ads:
with Ada.Strings.Unbounded;
package get_stdin is
type IntegerArray is array (Natural range <>) of Integer;
function get_ints return IntegerArray;
end get_stdin;
get_stdin.adb:
with Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO;
with Ada.Strings.Unbounded;
with Ada.Strings;
package body get_stdin is
function get_ints return IntegerArray is
Counter : Natural := 0;
Str : Ada.Strings.Unbounded.Unbounded_String;
Arr : IntegerArray(0..10000);
begin
while not Ada.Text_IO.End_Of_File loop
Str := Ada.Text_IO.Unbounded_IO.Get_Line;
Arr(Counter) := Integer'Value(Ada.Strings.Unbounded.To_String(Str));
Counter := Counter + 1;
end loop;
return Arr(0..Counter-1);
end get_ints;
end get_stdin;
I am calling using this package inside this procedure:
procedure d1 is
StdinArr : get_stdin.IntegerArray := get_stdin.get_ints;
begin
null; -- Array processing to follow
end;
This successfully compiles, and I then pipe in my input text file:
me#mypc /cygdrive/c/Users/me/aoc2018
$ cat d1.txt
-6
-1
-18
-10
...etc
me#mypc /cygdrive/c/Users/me/aoc2018
$ cat d1.txt | ./d1.exe
raised CONSTRAINT_ERROR : bad input for 'Value: "-6"
"-6" is the first value in the text file. My string-to-integer conversion code was essentially copied from this question.
I am not sure why a bad input error is raised.
It raises the same error if I replace -6 with a positive integer in the file
This is running under Cygwin on Windows 10.
Compiled/linked with gnatmake version 7.3.0
Note: I'm just getting started with Ada so there's probably lots of issues with my code in general.
What am I doing wrong and how can I fix this function/package to return my IntegerArray type correctly filled with Integers?
This was a line endings issue. I was running under cygwin on Windows 10. My text file has Windows-style line endings.
Using dos2unix:
$ cat d1.txt | dos2unix.exe | ./d1.exe
was sufficient to make it work correctly.
If anyone can explain precisely why, that would be interesting. I'm guessing that Get_Line only strips off the \n character, not the \r.