gcc/testsuite/gnat.dg/hardbool.adb

   1 -- { dg-do compile }
   2 -- { dg-options "-O -gnatVT -fdump-tree-optimized" }
   3
   4 --  Check that we perform the expected validity checks for
   5 --  hardbool-annotated types, even when checking of tests is disabled.
   6
   7 package body Hardbool is
   8    function T return Boolean is (Boolean (X) and then Boolean (Y));
   9
  10    procedure P1 is
  11    begin
  12       X := HBool1 (not Y);
  13    end P1;
  14
  15    procedure P2 is
  16    begin
  17       X := HBool1 (if Y then HBool2'(False) else HBool2'(True));
  18    end P2;
  19
  20    procedure P3 is
  21    begin
  22       X := (if Y then HBool1'(False) else HBool1'(True));
  23    end P3;
  24
  25    procedure Q1 is
  26    begin
  27       Y := HBool2 (not X);
  28    end Q1;
  29
  30    procedure Q2 is
  31    begin
  32       Y := HBool2 (if X then HBool1'(False) else HBool1'(True));
  33    end Q2;
  34
  35    procedure Q3 is
  36    begin
  37       Y := (if X then HBool2'(False) else HBool2'(True));
  38    end Q3;
  39
  40 end Hardbool;
  41
  42 -- One for each type's _rep_to_pos function.
  43 -- { dg-final { scan-tree-dump-times "gnat_rcheck_CE_Invalid_Data ..hardbool.ads" 2 "optimized" } }
  44
  45 -- One check for each variable used in T, one use in each P* and in each Q*.
  46 -- { dg-final { scan-tree-dump-times "gnat_rcheck_CE_Invalid_Data ..hardbool.adb" 8 "optimized" } }