PR ipa/83051
[official-gcc.git] / gcc / testsuite / gnat.dg / view_conversion1.adb
blobbb58c1b40c2836de30bdbde5378d38f51fd567e6
1 -- { dg-do run }
2 -- { dg-options "-gnatws" }
4 procedure View_Conversion1 is
6 type Matrix is array (Integer range <>, Integer range <>) of Float;
8 S1 : Matrix (-3 .. -2, 2 .. 3) := ((2.0, -1.0), (-1.0, 2.0));
9 S2 : Matrix (1 .. 2, 1 .. 2) := S1;
10 S3 : Matrix (2 .. 3, -3 .. -2);
11 S4 : Matrix (1 .. 2, 1 .. 2);
13 function Normal_Last (A : Matrix; N : Natural) return Boolean is
14 begin
15 if A'Last (1) = N and then A'Last (2) = N then
16 return True;
17 else
18 return False;
19 end if;
20 end;
22 procedure Transpose (A : Matrix; B : out Matrix) is
23 N : constant Natural := A'Length (1);
24 subtype Normal_Matrix is Matrix (1 .. N, 1 .. N);
25 begin
26 if not Normal_Last (A, N) or else not Normal_Last (B, N) then
27 Transpose (Normal_Matrix (A), Normal_Matrix (B));
28 return;
29 end if;
31 for J in 1 .. N loop
32 for K in 1 .. N loop
33 B (J, K) := A (K, J);
34 end loop;
35 end loop;
36 end;
38 begin
39 Transpose (S1, S3);
40 Transpose (S3, S4);
42 if S4 /= S2 then
43 raise Program_Error;
44 end if;
45 end;