OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gnat.dg/] [biased_uc.adb] - Blame information for rev 774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 696 jeremybenn
-- { dg-do run }
2
-- { dg-options "-gnatws" }
3
 
4
with Unchecked_Conversion;
5
procedure biased_uc is
6
begin
7
    --  Case (f) target type is biased, source is unbiased
8
 
9
    declare
10
       type a is new integer range 0 .. 255;
11
       for a'size use 8;
12
 
13
       type b is new integer range 200 .. 455;
14
       for b'size use 8;
15
 
16
       av : a;
17
       bv : b;
18
 
19
       for av'size use 8;
20
       for bv'size use 8;
21
 
22
       function a2b is new Unchecked_Conversion (a,b);
23
 
24
    begin
25
       bv := a2b (200);
26
       if bv = 200 then
27
          raise Program_Error;
28
       end if;
29
    end;
30
 
31
    --  Case (g) target type is biased, source object is biased
32
 
33
    declare
34
       type a is new integer range 1 .. 256;
35
       for a'size use 16;
36
 
37
       type b is new integer range 1 .. 65536;
38
       for b'size use 16;
39
 
40
       av : a;
41
       bv : b;
42
 
43
       for av'size use 8;
44
       for bv'size use 16;
45
 
46
       function a2b is new Unchecked_Conversion (a,b);
47
 
48
    begin
49
       bv := a2b (1);
50
       if bv /= 2 then
51
          raise Program_Error;
52
       end if;
53
    end;
54
end;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.