getting back to null range

[anon@anon.org (anon)]

with Ada.Integer_Text_IO ;
with Ada.Text_IO ;

use Ada.Integer_Text_IO ;
use Ada.Text_IO ;

procedure t is

  -- Display String values, with a title

  procedure Put ( T : String ; B : String ) is

    begin
      Put ( T ) ;
      Put ( "'( " ) ;
      Put ( B'First ) ;
      Put ( " .. " ) ;
      Put ( B'Last ) ;
      Put ( " ) => " ) ;
      Put ( B'length ) ;
      Put ( " => " ) ;
      Put_Line ( B ) ;
    end Put ;


  N : String := "" ;
  S : String := ( "123456789" ) ;

  --  From GNAT "Feature-316" file.
  --
  --    NF-316-B412-009 Warning on values for null ranges
  --
  --      If the compiler knows that a range is null, then it knows 
  --      that no value can conform to the range and that 
  --      Constraint_Error will be raised. A warning is now generated 
  --      in this situation.

  A : Positive range -5 .. -7 ; -- Value is a nul range
                                -- Creates the compiler warning message

  --
  -- A null string
  --
  S_A : String := ( -5 .. -7 => 'Z' ) ;


  subtype B is Positive range 9 .. 7 ;
  subtype C is Positive range 7 .. 5 ;

  S_R : String := ( C => 'Y' ) ;


begin
  Put ( "N", N ) ;
  Put ( "S", S ) ;
  Put ( "null S", S ( -5 ..-7 ) ) ;
  New_Line ;

  Put ( "null S_A", S_A ) ;
  if N = S_A then 
    Put_Line ( "N equal S_A" ) ;
  else
    Put_Line ( "N not equal S_A" ) ;
  end if ;

  declare
    --  Without these pragma statements the following declaration 
    --  statement will compile but generates an C_E at run time
    pragma Suppress ( Index_Check ) ;    
    pragma Suppress ( Range_Check ) ;

    S_B : String := ( A => 'Z' ) ; -- should be equal to S_A 

  begin
    Put ( "null S_B", S_B ) ;  
    if N = S_B then                -- Gives,  N not equal S_B
      Put_Line ( "N equal S_B" ) ;
    else
      Put_Line ( "N not equal S_B" ) ;
    end if ;

    if S_A = S_B then              -- Gives, S_A not equal S_B
      Put_Line ( "S_A equal S_B" ) ;
    else
      Put_Line ( "S_A not equal S_B" ) ;
    end if ;
  end ;

  Put ( "null S_R ", S_R ) ;
  Put ( "null S_R ", S_R ( B ) ) ;

  if S_R = S_R ( B ) then 
    Put_Line ( "S_R equal S_R ( B )" ) ;
  else
    Put_Line ( "S_R not equal S_R ( B )" ) ;
  end if ;

  begin
    --
    -- will result in a C_E when ( Index - 5 ) is no longer Positive 
    -- aka ( Index - 5 ) < 1 , It seams that the upper bound can be 
    -- a legal positive or not
    --
    Put_Line ( "Scanning an String:  Upper bound Postive" ) ;
    for Index in reverse S'Range loop
      Put ( "Reverse S", S ( ( Index - 5 ).. 6 ) ) ;
    end loop ;
  exception 
    when Constraint_Error =>
     Put_Line ( "Constraint_Error: Lower bound < 1" ) ;
     null ;
  end ;
  New_Line ;

  -- checking when upper bound is not a legal member of the script type
  -- Should result in an error at the same index value as previous 
  -- block statements. but does not!
  begin
    Put_Line ( "Scanning with Upper bound swaping Negative" ) ;
    for Index in reverse S'Range loop
      begin
        Put ( "Neg S", S ( ( Index - 5 ) .. ( Index - 11 ) ) ) ;
      exception
        when Constraint_Error =>
          Put_Line ( "Constraint_Error: " & 
                   Integer'Image ( Index ) & " ( " &
                   Integer'Image ( Index - 5 ) & " .. " &
                   Integer'Image ( Index - 11 ) & " )" ) ;
          exit ;
      end ;
      --
      begin
        Put ( "    S", S ( ( Index - 5 ) .. ( Index - 4 ) ) ) ;
      exception
        when Constraint_Error =>
          Put_Line ( "Constraint_Error: " &
                   Integer'Image ( Index ) & " ( " &
                   Integer'Image ( Index - 5 ) & " .. " &
                   Integer'Image ( Index - 4 ) & " )" ) ;
          exit ;
      end ;
    end loop ;
  end ;
  New_line ;
end t ;