Ada programing array of records - ada

I’m new in Ada and I’m trying to create an array of records and then put some records to the array but I got error nested array aggregate expected. Here is my code:
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Integer_Text_Io;
with Ada.unchecked_conversion;
procedure main is
type Byte is range 0..255;
for Byte'Size use 8;
type Pixel is record
R:Byte;
G:Byte;
B:Byte;
end record;
for Pixel'Size use 24;
r1:Pixel := (1,2,5);
r2:Pixel := (1,2,3);
r3:Pixel := (1,2,3);
type Image is array(Positive range <>, Positive range <>) of Pixel;
Pragma Pack(Image);
Left:Image(1..3, 1..1) := (r1, r2, r3);
begin
null;
end main;

A two-dimensional array needs a two-dimensional aggregate, i.e. an aggregate where each element is also an aggregate. For example:
type Integer_Matrix is array (Positive range <>, Positive range <>) of Integer;
M : Integer_Matrix (1..2, 1..2) := ( (1, 2), (3, 4) );
When either dimension has length 1, it needs special handling, because a single value in parentheses isn't treated as an aggregate. A one-element aggregate needs to be written as (1=>Value) [use the actual index in place of 1 if necessary]. In your case, each row of Image has length 1. So you aggregate will have three elements, and each element will be another aggregate of length 1. It will need to look like this:
Left : Image (1..3, 1..1) := ( (1=>r1), (1=>r2), (1=>r3) );

Related

WRBTR field calculation inside CASE throws error for max decimal places

I have following select:
SELECT FROM bseg
LEFT JOIN aufk ON ( ltrim( aufk~aufnr, '0' ) = bseg~zuonr )
JOIN bkpf ON bkpf~belnr = bseg~belnr AND bkpf~gjahr = bseg~gjahr AND bkpf~bukrs = bseg~bukrs
FIELDS bseg~bukrs, bseg~bschl, bseg~wrbtr, bseg~h_hwaer
INTO TABLE #DATA(output).
When the select is complete I loop over the output table making a calculation when bschl = '50'.
LOOP AT output ASSIGNING FIELD-SYMBOL(<output>) WHERE bschl = '50'.
<output>-wrbtr = <output>-wrbtr * ( -1 ).
ENDLOOP.
Since ABAP 7.4 I could use CASE statements in the SQL select.
This is what I want to use to get rid of the loop.
SELECT FROM bseg
LEFT JOIN aufk ON ( ltrim( aufk~aufnr, '0' ) = bseg~zuonr )
JOIN bkpf ON bkpf~belnr = bseg~belnr AND bkpf~gjahr = bseg~gjahr AND bkpf~bukrs = bseg~bukrs
FIELDS bseg~bukrs,
CASE
WHEN bseg~bschl = '50' THEN bseg~wrbtr * ( -1 )
ELSE bseg~wrbtr
END AS bseg~wrbtr, bseg~h_hwaer
INTO TABLE #DATA(output).
This is on how I would deal with the requirements described above.
Unfortunately I get an error message:
The maximum possible number of places in the expression starting with WRBTR is 34 places with 2 decimal places.
There can be, however, no more than 31 places and 14 decimal places.`
I also tried to cast bseg~wrbtr:
WHEN bseg~bschl = '50' THEN CAST( bseg~wrbtr * ( -1 ) )
-> ")" is invalid here (due to grammar).
Or
WHEN bseg~bschl = '50' THEN CAST( bseg~wrbtr AS test ) * ( -1 )
-> "TEST" is invalid here (due to grammar).
Does someone know how to deal with this?
My answer is specific to setting a sign via * -1. It doesn't apply to multiplications with other numbers.
In ABAP 7.52 and S/4HANA 1709, BSEG-WRBTR is still a packed-7-bytes number including 2 decimals, and except END AS bseg~wrbtr which leads to the error "~" is invalid here (due to grammar) and must be replaced with END AS wrbtr, the syntax is valid in my system.
In my system, the inline declaration of the output table chooses a packed-13-bytes number including 2 decimals. It's the multiplication that makes the number of digits in the output table multiplied by 2 (from 7 bytes to 13 bytes). As a comparison, an addition would only declare a packed-8-bytes number.
I guess you have a more recent S/4HANA version with BSEG-WRBTR having many more digits (feature called "Amount Field Length Extension"), it's why the multiplication makes the inline declaration produces an invalid type with too many digits.
Workaround: if you sign without multiplying, it will keep the same number of digits (packed-7-bytes number in my case), and this syntax should also work in your case:
CASE bseg~bschl
WHEN '50' THEN - bseg~wrbtr "<=== negative sign, is not the same logic as * -1
ELSE bseg~wrbtr
END AS wrbtr
EDIT Dec 30th - I didn't find a clear reference in the ABAP documentation how the inline types are calculated for arithmetic SQL expressions, it's by searching "up" from the behavior I experienced that I could find a logical way "down":
SELECT, INTO target - #DATA(dobj):
The ABAP type to which the result type of an SQL expression is assigned is used for this expression.
sql_exp - sql_arith (it concerns +, -, * and /):
Alongside any integer operands (see above), decimal expression have at least one operand with the type DEC, CURR, or QUAN or p with decimal places. The operator / is not allowed in decimal expressions. The result has the type DEC with the length 31 and a maximum of 14 decimal places. Using the associated assignment rule, it can be assigned to all numeric ABAP types whose value range is large enough, except for decimal floating point numbers.
SELECT, Assignment Rules:
If the target field has a numeric data type, the value of the result field is converted to this data type and the value range of the target field must be large enough. Here, any surplus decimal places in result fields of the type CURR, DEC, or QUAN (numbers in the BCD format) are cut off.
The proper CASE syntax:
CASE bseg~bschl
WHEN '50' THEN bseg~wrbtr * ( -1 )
ELSE bseg~wrbtr
END AS bseg~wrbtr
Move bseg~bschl right after case and after WHEN mention only the values for equality
The results of the calculation of CAST( bseg~wrbtr AS D34N ) * CAST( -1 AS D34N ) in your CASE are put into data object of type calculation type.
According to the docu, the calculation type for the WRBTR (ABAP type P) is also P, but with important remark:
A calculation type p in assignments to an inline declaration can produce the data type p with length 8 and no decimal places and this can produce unexpected results and raise exceptions
SOLUTION: remove the inline declaration INTO TABLE #DATA(output) from your select query and declare your itab in advance with a proper accuracy.
Here is my working solution for this problem.
CASE bseg~bschl
WHEN '50' THEN CAST( bseg~wrbtr AS D34N ) * CAST( -1 AS D34N )
ELSE CAST( bseg~wrbtr AS D34N )
END AS wrbtr, bseg~h_hwaer,

Fortran doesn't keep lower/upper array bounds after copy to another allocatable array

This doesn't work
program main
implicit none
integer :: nx = 3
integer :: ny = 5
integer :: nz = 8
real, allocatable, dimension(:,:,:) :: A
real, allocatable, dimension(:,:) :: B
allocate(A(nx,0:ny,nz) )
! ...do something with array A and at some point cope a slice of A to B:
B = A(:,:,1)
! in this case B is (1:nx, 1: ny+1)
end program main
The code above automatically allocates B and copies A(:,:,1) to B. However it doesn't keep the lower/upper bound of 0/ny, instead B has its lower bound to 1 and upper bound to ny+1.
The only way I found to keep the lower/upper bound of A 2dn-dim is by explicitly allocate B as:
allocate(B(nx, 0:ny))
B = A(:,:,1)
! in this case B is (1:nx, 0:ny)
Given that I have many more variables than in this simple example, is there a way to assign like B=A(:,:,1) and also keep the bounds of A without explicitly allocating B?
A(:,:,1) is an expression. It has bounds (1:nx, 1:ny), BOTH ranks start at 1. It is not the original array, it is a new expression.
However, even if it was an array that had some other lower bounds, automatic allocation always allocates indexes starting from 1. Basically, the right hand side is an expression again.
For your case you do have to allocate explicitly.
You can use:
allocate(B(lbound(A,1):ubound(A,1), lbound(A,2):ubound(A,2)))

How to check equality of two FStar.Set's

How can you check whether two sets are equal in FStar? The following expression is of type Type0 not Tot Prims.bool so I'm not sure how to use it to determine if the sets are equal (for example in a conditional). Is there a different function that should be used instead of Set.equal?
Set.equal (Set.as_set [1; 2; 3]) Set.empty
The sets defined in FStar.Set are using functions as representation.
Therefore, a set s of integers for instance, is nothing else than a function mapping integers to booleans.
For instance, the set {1, 2} is represented as the following function:
// {1, 2}
fun x -> if x = 1 then true
else (
if x = 2 then true
else false
)
You can add/remove value (that is, crafting a new lambda), or asks for a value being a member (that is, applying the function).
However, when it comes to comparing two sets of type T, you're out of luck : for s1 and s2 two sets, s1 = s2 means that for any value x : T, s1 x = s2 x. When the set of T's inhabitants is inifinite, this is not computable.
Solution The function representation is not suitable for you. You should have a representation whose comparaison is computable. FStar.OrdSet.fst defines sets as lists: you should use that one instead.
Note that this OrdSet module requires a total order on the values held in the set. (If you want have set of non-ordered values, I implemented that a while ago, but it's a bit hacky...)

comparing of mix,max values of two sub types in Ada using ASIS

I want to compare min, max of values of two subtypes. In Ada language it is possible to assign between two different subtypes, for example
procedure Example_1 is
subtype Type_1 is Integer range 0 .. 10;
subtype Type_2 is Integer range 0 .. 30;
A : Type_1 := 0;
B : Type_2 := 12;
begin
A := B;
end Example_1;
At run time A := B can give range overflow error. In ASIS, is it possible to compare subtypes, min/max values of subtypes (integer, real, enumeration types) so that I can identify overflow problem before run-time?
The compiler detects this problem when compiled with -gnatVa -gnat12
Yes, it is possible to check this with ASIS.
See the answer to this question for how to extract 'First and 'Last for a subtype.

Ada array aggregate initialization

I am trying to initialize a simple Ada array using an aggregate, and I would like the compiler to determine the array bounds. However, When trying to use Test_2 below, I cannot simply use integer subscripts. Is there a way to allow the compiler to determine the array bounds arrays, and yet access them using the simple "Test_2(0)" notation?
I am using gnat.
Thanks.
with Interfaces; use Interfaces;
procedure Test_Init is
type U16_a is array(Integer range <>) of Unsigned_16;
-- array aggregate initialization
Test_1 : U16_a(0..1) := (16#1234#, 16#5678#); -- ok, but...
Test_2 : U16_a := (16#8765#, 16#4321#); -- let compiler create bounds
Test_3 : Unsigned_16;
begin
-- Test_1 obviously works
Test_3 := Test_1(0);
-- warning: value not in range of subtype of "Standard.Integer" defined at line 8
-- This produces a constraint.
-- What is the subtype that is defined at line 8? It is not Integer (0..1)
Test_3 := Test_2(0);
-- this works though
Test_3 := Test_2(Test_2'First);
-- and this works
Test_3 := Test_2(Test_2'Last);
-- and this works
Test_3 := Test_2(Test_2'First + 1);
end Test_Init;
If you don't specify the bounds, the lower bound of the array is the lower bound of the index type. (You may be accustomed to languages like C, where arrays always have a lower bound of 0. That's not the case in Ada.)
In this case, the lower bounds is Integer'First, which is probably -2147483648.
If you want the array bounds to start at 0, you can use the subtype Natural:
type U16_a is array(Natural range <>) of Unsigned_16;
Or you can use the subtype Positive to set the array's lower bound to 1.
You can also specify the index of each element:
Test_2 : U16_a := (0 => 16#8765#, 1 => 16#4321#);
but that may not scale as well; if there are a large number of elements, you have to specify the index for each one, since positional associations can't follow named associations.
Instead of using positional or named aggregate initializers you can use array concatenation to specify the first index:
Test_3 : U16_a := (0 => 0) & (1, 2, 3, 4, 5, 6, 7);
The reference manual states:
If the ultimate ancestor of the array type was defined by an
unconstrained_array_definition, then the lower bound of the result is
that of the left operand.
It's cleaner to pick an index subtype with the desired lower bound.

Resources