gcc/testsuite/gnat.dg/boolean_expr1.adb

   1 -- PR middle-end/36554
   2 -- Origin: Laurent Guerby <laurent@guerby.net>
   3
   4 -- { dg-do compile }
   5 -- { dg-options "-O2" }
   6
   7 package body Boolean_Expr1 is
   8
   9    function Long_Float_Is_Valid (X : in Long_Float) return Boolean is
  10       Is_Nan : constant Boolean := X /= X;
  11       Is_P_Inf : constant Boolean := X > Long_Float'Last;
  12       Is_M_Inf : constant Boolean := X < Long_Float'First;
  13       Is_Invalid : constant Boolean := Is_Nan or Is_P_Inf or Is_M_Inf;
  14    begin
  15       return not Is_Invalid;
  16    end Long_Float_Is_Valid;
  17
  18    function S (V : in Long_Float) return String is
  19    begin
  20       if not Long_Float_Is_Valid (V) then
  21          return "INVALID";
  22       else
  23          return "OK";
  24       end if;
  25    exception
  26       when others =>
  27          return "ERROR";
  28    end S;
  29
  30 end Boolean_Expr1;