gcc/testsuite/gnat.dg/boolean_subtype2.adb

   1 -- { dg-do compile }
   2 -- { dg-options "-O3 -gnata" }
   3
   4 package body Boolean_Subtype2 is
   5
   6    function Component_Type (Id : Entity_Id) return Entity_Id is
   7    begin
   8       pragma Assert (Is_String_Type (Id));
   9       return Node20 (Id);
  10    end;
  11
  12    function First_Index (Id : Entity_Id) return Node_Id is
  13    begin
  14       pragma Assert (Is_String_Type (Id));
  15       return Node20 (Id);
  16    end ;
  17
  18    function Is_Character_Type (Id : Entity_Id) return B is
  19    begin
  20       return Flag63 (Id);
  21    end;
  22
  23    function Number_Dimensions (Id : Entity_Id) return Positive is
  24       N : Integer := 0;
  25       T : Node_Id := First_Index (Id);
  26    begin
  27       if Present (T) then
  28          N := N + 1;
  29       end if;
  30       return N;
  31    end;
  32
  33    function Is_String_Type (Id : Entity_Id) return B is
  34    begin
  35       return (Id /= 0
  36               and then Number_Dimensions (Id) = 1
  37               and then Is_Character_Type (Component_Type (Id)));
  38    end;
  39
  40 end Boolean_Subtype2;