gcc/testsuite/gnat.dg/biased_uc.adb

   1 -- { 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;