I am having a constraint error on the following situation:
Get constrained buffer from procedure:
Get_MyBuffer(data => Buffer); -- This is ok
Buffer is of type Unsigned_Byte. Want to convert it to Byte.
function To_Byte is new Unchecked_Conversion (Source => Unsigned_Byte,
Target => Byte);
MyFunction2Pass(To_Byte(Buffer)); -- Having warning 'uncheked conversion to unconstrained array subtype is not portable.
Printing inside MyFunction2Pass
function MyFunction2Pass(Data : Byte) is
begin
New_Line(integer'image(integer(Data(1)))); -- **Shoot Constrain Error**
end
That one line of yours is doing an awful lot. There's nothing wrong with that, but it is temporarily inconvienent while you are getting this exception. You might consider splitting each routine call into its own line for now, just so you can track down which call is putting out the constraint error.
Bit : constant boolean := Data(1); -- I'm guessing this is the right type
Bit_Int : constant integer := integer(Bit);
Bit_Img : constant string := integer'image(Bit_Int);
begin
New_Line (Bit_Img);
end
Now which line is giving the constraint error? (After cleaning up any compiler errors of course).
Related
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);
I'm in the process of making my own package for an Ada main program. I read a string followed by an integer and another string and the problem is I need to cut the first string at sign of first space. I don't know how to do it and I've searched stack overflow only to find solutions in other languages.
My code right now in the package body is:
Get_Line(Item.String, Item.X1)
where X1 is an integer and String is the string. This works if you define the length in the type to match the exact length of your input but of course you want to be able to insert whatever you want and thus it doesn't work.
Can somebody point me in the right direction?
Thanks
Why do you need to make a package for an Ada main program? Most compilers need them to be parameterless library-level procedures.
Anyway, this might give you some tips.
with Ada.Text_IO;
with Ada.Integer_Text_IO;
procedure Agrell is
begin
declare
Line : constant String := Ada.Text_IO.Get_Line;
This is how to deal with reading a string of unknown length. You have to work out how to preserve it for future use (maybe use an Unbounded_String?)
The_Integer : Integer;
begin
Looking_For_Space :
for J in Line'Range loop
if Line (J) = ' ' then
Everything from Line’First to J - 1 is the string you wanted.
declare
Dummy : Positive;
begin
Ada.Integer_Text_IO.Get (From => Line (J .. Line'Last),
Item => The_Integer,
Last => Dummy);
end;
OK, now we have The Integer...
...
exit Looking_For_Space;
... and we’re done with the first line.
end if;
end loop Looking_For_Space;
end;
end Agrell;
I'm attempting to pass a structure from (x86) assembler to Ada on the stack. I've been able to successfully use this pattern in C to accept to wrap a large number of arguments passed from assembly inside a struct and I'm wondering if this will work in a similar way in Ada.
Here is a (contrived, minimal) example:
When I do this, debugging the callee shows that the passed record contains uninitialised data. It appears that Ada is interpreting the C calling convention differently despite the export directive.
The RM contains information about passing structs from Ada to C, saying that it will automatically pass a record as a pointer type, but the inverse does not appear to be true. If you accept a single access type it will simply be filled with the first value on the stack, as one would expect from cdecl.
( Please excuse any minor errors, this isn't my actual code. )
#####################################################################
# Caller
#
# This pushes the values onto the stack and calls the Ada function
#####################################################################
.global __example_function
.type __example_function, #function
__example_function:
push $1
push $2
push $3
push $4
call accepts_struct
ret
----------------------------------------------------------------------------
-- Accepts_Struct
--
-- Purpose:
-- Attempts to accept arguments pass on the stack as a struct.
----------------------------------------------------------------------------
procedure Accepts_Struct (
Struct : Struct_Passed_On_Stack
)
with Export,
Convention => C,
External_Name => "accepts_struct";
----------------------------------------------------------------------------
-- Ideally the four variables passed on the stack would be accepted as
-- the values of this struct.
----------------------------------------------------------------------------
type Struct_Passed_On_Stack is
record
A : Unsigned_32;
B : Unsigned_32;
C : Unsigned_32;
D : Unsigned_32;
end record
with Convention => C;
On the other hand, this works just fine:
procedure Accepts_Struct (
A : Unsigned_32;
B : Unsigned_32;
C : Unsigned_32;
D : Unsigned_32
)
with Export,
Convention => C,
External_Name => "accepts_struct";
That's not a big deal in this minimal case, but if I'm passing 16 or more variables it gets a bit onerous. If you're wondering why I'm doing this, it's an exception handler where the processor automatically passes variables onto the stack to show register states.
Any help here would be greatly appreciated.
The record version does not work because a record is not stored on the stack. Instead 4 Unsigned_32 elements are stored on the stack. If you really want to work with a record instead of four separate unsigned integer values you can assign the four values to the members of your record within the call to "accepts_struct".
Ada expects the first entry in the stack to be a record, not an unsigned_32.
The Ada LRM, section 6.4.1 states:
For the evaluation of a parameter_association: The actual parameter is
first evaluated. For an access parameter, the access_definition is
elaborated, which creates the anonymous access type. For a parameter
(of any mode) that is passed by reference (see 6.2), a view conversion
of the actual parameter to the nominal subtype of the formal parameter
is evaluated, and the formal parameter denotes that conversion. For an
in or in out parameter that is passed by copy (see 6.2), the formal
parameter object is created, and the value of the actual parameter is
converted to the nominal subtype of the formal parameter and assigned
to the formal.
Furthermore, the passing mode for parameters is described in section 6.2:
6.2 Formal Parameter Modes
A parameter_specification declares a formal parameter of mode in, in
out, or out. Static Semantics
A parameter is passed either by copy or by reference. When a parameter
is passed by copy, the formal parameter denotes a separate object from
the actual parameter, and any information transfer between the two
occurs only before and after executing the subprogram. When a
parameter is passed by reference, the formal parameter denotes (a view
of) the object denoted by the actual parameter; reads and updates of
the formal parameter directly reference the actual parameter object.
A type is a by-copy type if it is an elementary type, or if it is a
descendant of a private type whose full type is a by-copy type. A
parameter of a by-copy type is passed by copy, unless the formal
parameter is explicitly aliased.
A type is a by-reference type if it is a descendant of one of the
following:
a tagged type;
a task or protected type;
an explicitly limited record type;
a composite type with a subcomponent of a by-reference type;
a private type whose full type is a by-reference type.
A parameter of a by-reference type is passed by reference, as is an
explicitly aliased parameter of any type. Each value of a by-reference
type has an associated object. For a parenthesized expression,
qualified_expression, or type_conversion, this object is the one
associated with the operand. For a conditional_expression, this object
is the one associated with the evaluated dependent_expression.
For other parameters, it is unspecified whether the parameter is
passed by copy or by reference.
It appears that your compiler is trying to pass the struct by reference rather than by copy. In C all parameters are passed by copy.
Maybe you already solved the problem, but if not, then you might also want to have at look at the interrupt function attribute provided by GCC (see here). I've translated a test of the GCC testsuite which pushes values to the stack (as described in section 6.12 of the Intel SDM) and reads them back in an ISR. The translated Ada version seems to work well. See here for the original C version. See the GCC ChangeLog for some additional info.
main.adb
with PR68037_1;
procedure Main is
begin
PR68037_1.Run;
end Main;
pr68037_1.ads
package PR68037_1 is
procedure Run;
end PR68037_1;
pr68037_1.adb
with System.Machine_Code;
with Ada.Assertions;
with Interfaces.C;
with GNAT.OS_Lib;
package body PR68037_1 is
-- Ada-like re-implementation of
-- gcc/testsuite/gcc.dg/guality/pr68037-1.c
subtype uword_t is Interfaces.C.unsigned_long; -- for x86-64
ERROR : constant uword_t := 16#1234567_0#;
IP : constant uword_t := 16#1234567_1#;
CS : constant uword_t := 16#1234567_2#;
FLAGS : constant uword_t := 16#1234567_3#;
SP : constant uword_t := 16#1234567_4#;
SS : constant uword_t := 16#1234567_5#;
type interrupt_frame is
record
ip : uword_t;
cs : uword_t;
flags : uword_t;
sp : uword_t;
ss : uword_t;
end record
with Convention => C;
procedure fn (frame : interrupt_frame; error : uword_t)
with Export, Convention => C, Link_Name => "__fn";
pragma Machine_Attribute (fn, "interrupt");
--------
-- fn --
--------
procedure fn (frame : interrupt_frame; error : uword_t) is
use Ada.Assertions;
use type uword_t;
begin
-- Using the assertion function here. In general, be careful when
-- calling subprograms from an ISR. For now it's OK as we will not
-- return from the ISR and not continue the execution of an interrupted
-- program.
Assert (frame.ip = IP , "Mismatch IP");
Assert (frame.cs = CS , "Mismatch CS");
Assert (frame.flags = FLAGS, "Mismatch FLAGS");
Assert (frame.sp = SP , "Mismatch SP");
Assert (frame.ss = SS , "Mismatch SS");
-- At the end of this function IRET will be executed. This will
-- result in a segmentation fault as the value for EIP is nonsense.
-- Hence, abort the program before IRET is executed.
GNAT.OS_Lib.OS_Exit (0);
end fn;
---------
-- Run --
---------
procedure Run is
use System.Machine_Code;
use ASCII;
begin
-- Mimic the processor behavior when an ISR is invoked. See also:
--
-- Intel (R) 64 and IA-32 Architectures / Software Developer's Manual
-- Volume 3 (3A, 3B, 3C & 3D) : System Programming Guide
-- Section 6.12: Exception and Interrupt Handling
--
-- Push the data to the stack and jump unconditionally to the
-- interrupt service routine.
Asm
(Template =>
"push %0" & LF &
"push %1" & LF &
"push %2" & LF &
"push %3" & LF &
"push %4" & LF &
"push %5" & LF &
"jmp __fn",
Inputs =>
(uword_t'Asm_Input ("l", SS),
uword_t'Asm_Input ("l", SP),
uword_t'Asm_Input ("l", FLAGS),
uword_t'Asm_Input ("l", CS),
uword_t'Asm_Input ("l", IP),
uword_t'Asm_Input ("l", ERROR)),
Volatile => True);
end Run;
end PR68037_1;
I compiled the program in GNAT CE 2019 with compiler options -g -mgeneral-regs-only (copied from the GCC test). Note that the parameter interrupt_frame will be passed by reference (see RM B.3 69/2).
I simply don't catch why the following does not work. Could someone help me to fix it? It complains (at runtime):
raised CONSTRAINT_ERROR : variant2.adb:21 discriminant check failed
procedure Variant2 is
type POWER is (NONE,GAS, STEAM);
type VEHICLE (Engine : POWER := NONE) is
record
Model_Year : INTEGER range 1888..1992;
case Engine is
when NONE => null;
when GAS => Cylinders : INTEGER range 1..16;
when STEAM => Boiler_Size : INTEGER range 5..22;
Coal_Burner : BOOLEAN;
end case;
end record;
Works : VEHICLE;
Works_Not : access VEHICLE := new VEHICLE;
begin
Works := (GAS,1980,4); -- (1)
Works_Not.all := (GAS,1981,8); -- (2)
end Variant2;
(1) is working, but (2) does not
Thanks in advance!
The RM explicitly states that "If the designated type is composite, [...] the created object is constrained by its initial value (even if the designated subtype is unconstrained with defaults)." (RM 4.8(6/3))
which means you have to reallocate your access type
Works_Not := new VEHICLE'(GAS,1981,8);
(of course, you should deallocate the old access value first (see RM 13.11.2 Unchecked Storage Deallocation), but I leave that as an exercise)
UPDATE: as discussed in the comments
Here's an example you can play around with:
with Ada.Text_IO;
procedure Array_Of_Aliased is
type POWER is (NONE, GAS, STEAM);
type VEHICLE(Engine : POWER := NONE) is
record
Model_Year : Integer range 1888..1992;
case Engine is
when NONE => null;
when GAS => Cylinders : INTEGER range 1..16;
when STEAM => Boiler_Size : INTEGER range 5..22;
Coal_Burner : BOOLEAN;
end case;
end record;
-- array of aliased elements
type Vehicle_Array is array(1..5) of aliased VEHICLE;
-- the access type need to be "all" or "constant" in order to access aliased values
type Vehicle_Access is access all VEHICLE;
Vehicles : Vehicle_Array;
Works : Vehicle_Access;
begin
-- access to the first element of the array. Can't change discriminant this way...
Works := Vehicles(1)'Access;
Ada.Text_IO.Put_Line(POWER'Image(Works.Engine));
-- However, using the array, we _can_ change the discriminant, since it's _not_ an access value
Vehicles(1) := (STEAM, 1890, 20, True);
Vehicles(2) := (GAS, 1981, 8);
Ada.Text_IO.Put_Line(POWER'Image(Works.Engine));
-- We can still update the record elements using the access value, as long as the discriminant stays the same
Works.all := (STEAM, 1900, 15, False);
end Array_Of_Aliased;
As egilhh said, when you allocate a discriminant record using new, you can't change the discriminant of the record you allocated, even though you could do this for a variable of the type (as opposed to an allocated record). This rule has been around since Ada 83. The rationale was, I believe, that it allows the compiler to optimize space when allocating records. In your example, if we assume all the fields (including the discriminant) are 1 word, then the record will be 2 words if ENGINE=NONE, 3 words if ENGINE=GAS, 4 words if ENGINE=STEAM. When Works_Not is initialized, it's initialized to a NONE, which means it may take only 2 words on the heap (note: it's not a requirement that compilers optimize in this way). If it uses only 2 words, then reassigning the record to one with ENGINE=GAS would be a disaster--you'd be overflowing the area that you previously allocated, and stomping on other data.
Whether this was a good language design decision or not, I can't say; I don't know how many compilers, and how many applications, needed to take advantage of this optimization. Somebody 33 years ago thought it would be useful, and they must have had some good reasons for thinking so.
The restriction is annoying but not insurmountable. I've definitely run into it before, multiple times, but the simple answer is to wrap it in another record.
type VEHICLE_DATA (Engine : POWER := NONE) is
record
Model_Year : INTEGER range 1888..1992;
case Engine is
when NONE => null;
when GAS => Cylinders : INTEGER range 1..16;
when STEAM => Boiler_Size : INTEGER range 5..22;
Coal_Burner : BOOLEAN;
end case;
end record;
type VEHICLE is record
Data : VEHICLE_DATA;
end record;
Now_Works : access VEHICLE := new VEHICLE; -- still sets ENGINE=NONE
Now_Works := (Data => (Gas, 1981, 8)); -- legal
Now_Works.Data := (Gas, 1981, 8); -- legal, does the same thing
These are OK because the allocated record is a VEHICLE, which isn't a discriminant record. It's OK to change the discriminant of a subcomponent like this. That's how I've gotten around the rule.
I have a function that returns a string for a particular item, and I need to call that function numerous times and combine those strings into one. The combined string is bounded. I've made sure to fill it when space characters when it initializes but I keep getting "length check failed" errors. Is there something basic I'm doing wrong here?
FOR I IN 1..Collection.Size LOOP
Combined_String := combined_string & Tostring(Collection.Book(I));
END LOOP;
Unbounded_String is probably the easiest way to go:
with Ada.Strings.Unbounded;
use Ada.Strings.unbounded;
...
Temp_Unbounded_String : Unbounded_String; -- Is empty by default.
...
for I in 1 .. Collection.Size loop
Append(Temp_Unbounded_String, ToString(Collection.Book(I));
end loop;
If you then need to have the result placed in your fixed length standard string:
declare
Temp_String : constant String := To_String(Temp_Unbounded_String);
begin
-- Beware! If the length of the Temp_String is greater than that of the
-- fixed-length string, a Constraint_Error will be raised. Some verification
-- of source and target string lengths must be performed!
Combined_String(Temp_String'Range) := Temp_String;
end;
Alternatively, you can use the Ada.Strings.Fixed Move() procedure to bring the Unbounded_String into the target fixed-length string:
Ada.Strings.Fixed.Move(To_String(Temp_Unbounded_String), Combined_String);
In this case, if the source string is "too long", by default a Length_Error exception is raised. There are other parameters to Move() that can modify the behavior in that situation, see the provided link on Move for more detail.
In order to assign Combined_String, you must assign the full correct length at once. You can't "build up" a string and assign it that way in Ada.
Without seeing the rest of your code, I think Ada.Strings.Unbounded is probably what you should be using.
I know this is an ancient question, but now that Ada 2012 is out I thought I'd share an idiom I've been finding myself using...
declare
function Concatenate(i: Collection'index)
is
(tostring(Collection(i) &
if (i = Collection'last) then
("")
else
(Concatenate(i+1))
);
s: string := Concatenate(Collection'first);
begin
Put_Line(s);
end;
Typed off the top of my head, so it'll be full of typos; and if you want it to work on empty collections you'll need to tweak the logic (should be obvious).
Ada 2012's expression functions are awesome!
Ada works best when you can use perfectly-sized arrays and strings. This works wonderfully for 99% of string uses, but causes problems any time you need to progressively build a string from something else.
Given that, I'd really like to know why you need that combined string.
If you really need it like that, there are two good ways I know of to do it. The first is to use "unbounded" (dynamically-sized) strings from Ada.Strings.Unbounded, as Dave and Marc C suggested.
The other is to use a bit of functional programming (in this case, recursion) to create your fixed string. Eg:
function Combined_String (String_Collection : in String_Collection_Type) return String is
begin
if String_Collection'length = 1 then
return String_Collection(String_Collection'first);
end if;
return String_Collection(String_Collection'first) &
Combined_String (String_Collection'first + 1 .. String_Collection'last);
end Combined_String;
I don't know what type you used for Collection, so I'm making some guesses. In particular, I'm assuming its an unconstrained array of fixed strings. If it's not, you will need to replace some of the above code with whatever your container uses to return its bounds, access elements, and perform slicing.
From AdaPower.com:
function Next_Line(File : in Ada.Text_IO.File_Type :=
Ada.Text_Io.Standard_Input) return String is
Answer : String(1..256);
Last : Natural;
begin
Ada.Text_IO.Get_Line(File => File,
Item => Answer,
Last => Last);
if Last = Answer'Last then
return Answer & Next_Line(File);
else
return Answer(1..Last);
end if;
end Next_Line;
As you can see, this method builds a string (using Get_Line) of unlimited* length from the file it's reading from. So what you'll need to do, in order to keep what you have is something on the order of:
function Combined_String (String_Collection : in String_Collection_Type)
Return String is
begin
if String_Collection'length = 1 then
Return String_Collection(String_Collection'First).All;
end if;
Recursion:
Declare
Data : String:= String_Collection(String_Collection'First).All;
SubType Constraint is Positive Range
Positive'Succ(String_Collection'First)..String_Collection'Last;
Begin
Return Data & Combined_String( String_Collection(Constraint'Range) );
End Recursion;
end Combined_String;
Assuming that String_Collection is defined as:
Type String_Collection is Array (Positive Range <>) of Access String;
*Actually limited by Integer'Range, IIRC