Ada 95 :: x36_str5.ada

with Simple_io; use Simple_io;
package Class_bounded_string is
  type Bounded_string is private;

  function to_bounded_string(str:in String)
    return Bounded_string;

  function to_string(the:in Bounded_string) return String;

  function "&" (f:in Bounded_string; s:in Bounded_string)
    return Bounded_string;
  function "&" (f:in Bounded_string; s:in String)
    return Bounded_string;
  function "&" (f:in String; s:in Bounded_string)
    return Bounded_string;

  function slice( the:in Bounded_string;
                  low:in Positive; high:in Natural )
    return String;

  function "="  ( f:in Bounded_string; s:in Bounded_string )
    return Boolean;

  function ">"  ( f:in Bounded_string; s:in Bounded_string )
    return Boolean;
  function ">=" ( f:in Bounded_string; s:in Bounded_string )
    return Boolean;
  function "<"  ( f:in Bounded_string; s:in Bounded_string )
    return Boolean;
  function "<=" ( f:in Bounded_string; s:in Bounded_string )
    return Boolean;
private
  MAX_STRING: CONSTANT := 80;
  subtype Str_range is Natural range 0 .. MAX_STRING;
  type A_Bounded_string( length: Str_range := 0 ) is record
    chrs: String( 1 .. length );  -- Stored string
  end record;
  type Bounded_string is record
    v_str : A_Bounded_string;
  end record;
end Class_bounded_string;

with Simple_io; use Simple_io;
package body Class_bounded_string is

  function to_bounded_string( str:in String )
    return Bounded_string is
  begin
    return (v_str=>(str'Length, str));
  end to_bounded_string;

  function to_string(the:in Bounded_string) return String is
  begin
    return the.v_str.chrs( 1 .. the.v_str.length );
  end to_string;

  function "&" ( f:in Bounded_string; s:in Bounded_string )
    return Bounded_string is
  begin
    return (v_str=>(f.v_str.chrs'Length + s.v_str.chrs'Length,
                    f.v_str.chrs & s.v_str.chrs));
  end "&";

  function "&" ( f:in Bounded_string; s:in String )
    return Bounded_string is
  begin
    return (v_str=>(f.v_str.chrs'Length + s'Length,
                    f.v_str.chrs & s ) );
  end "&";

  function "&" ( f:in String; s:in Bounded_string )
    return Bounded_string is
  begin
    return ( v_str=>(f'Length + s.v_str.chrs'Length,
                     f & s.v_str.chrs ) );
  end "&";

  function slice( the:in Bounded_string;
                  low:in Positive; high:in Natural)
    return String is
  begin
    if low <= high and then high <= the.v_str.length then
        return the.v_str.chrs( low .. high );
     end if;
     return "";
  end slice;

  function "="  ( f:in Bounded_string; s:in Bounded_string )
    return Boolean is
  begin
    return f.v_str.chrs = s.v_str.chrs;
  end "=";

  function ">"  ( f:in Bounded_string; s:in Bounded_string )
    return Boolean is
  begin
    return f.v_str.chrs > s.v_str.chrs;
  end ">";

  function ">=" ( f:in Bounded_string; s:in Bounded_string )
    return Boolean is
  begin
    return f.v_str.chrs >= s.v_str.chrs;
  end ">=";

  function "<"  ( f:in Bounded_string; s:in Bounded_string )
    return Boolean is
  begin
    return f.v_str.chrs < s.v_str.chrs;
  end "<";

  function "<=" ( f:in Bounded_string; s:in Bounded_string )
    return Boolean is
  begin
    return f.v_str.chrs <= s.v_str.chrs;
  end "<=";

end Class_bounded_string;

package Class_container is
  procedure main1;
  procedure main2;
end Class_container;

with Simple_io, Class_bounded_string;
use  Simple_io, Class_bounded_string;
package body Class_container is

procedure main1 is
  town, county, address : Bounded_string;
begin
  town   := to_bounded_string( "Brighton" );
  county := to_bounded_string( "East Sussex" );

  address := town & " " & county;

  put( to_string(address) ); new_line;
  put( slice( county & " UK", 6, 14 ) );
  new_line;

end main1;

procedure main2 is
  text: Bounded_string;
  procedure check(b:in Boolean; str1,str2:in String) is
  begin
    if b then put(str1); else put(str2); end if;
    put(" ");
  end check;
begin
  put("=    /=   >    >=   >=   <    <=   <=    "); new_line;
  check(to_bounded_string("ABC") =  to_bounded_string("ABC") , "Pass",  "Fail");
  check(to_bounded_string("ABC") /= to_bounded_string("AB ") , "Pass",  "Fail");
  check(to_bounded_string("ABC") >  to_bounded_string("ABBB"), "Pass",  "Fail");
  check(to_bounded_string("ABC") >= to_bounded_string("ABBB"), "Pass",  "Fail");
  check(to_bounded_string("ABC") >= to_bounded_string("ABC") , "Pass",  "Fail");
  check(to_bounded_string("ABBB")<  to_bounded_string("ABC") , "Pass",  "Fail");
  check(to_bounded_string("ABBB")<= to_bounded_string("ABC") , "Pass",  "Fail");
  check(to_bounded_string("ABC") <= to_bounded_string("ABC") , "Pass",  "Fail");
  new_line;

  put("/=    =   <=   <    <    >=   >    >     "); new_line;
  check(to_bounded_string("ABC") /= to_bounded_string("ABC") , "Fail",  "Pass");
  check(to_bounded_string("ABC") =  to_bounded_string("AB ") , "Fail",  "Pass");
  check(to_bounded_string("ABC") <= to_bounded_string("ABBB"), "Fail",  "Pass");
  check(to_bounded_string("ABC") <  to_bounded_string("ABBB"), "Fail",  "Pass");
  check(to_bounded_string("ABC") <  to_bounded_string("ABC") , "Fail",  "Pass");
  check(to_bounded_string("ABBB")>= to_bounded_string("ABC") , "Fail",  "Pass");
  check(to_bounded_string("ABBB")>  to_bounded_string("ABC") , "Fail",  "Pass");
  check(to_bounded_string("ABC") >  to_bounded_string("ABC") , "Fail",  "Pass");
  new_line;

  put("Equality test"); new_line;
  for i in 1 .. 6 loop
    text := to_bounded_string("ABCDEFGH-ABCDEFGH");
    if slice(text,i,4) = slice(text,9+i,13) then
      put("Pass");
    else
      put("Fail");
    end if;
    put(" ");
  end loop;
  new_line;

end main2;

end Class_container;

with Ada.Text_io, Class_bounded_string;
use  type Class_bounded_string.Bounded_string;
procedure main3 is
  town  : Class_bounded_string.Bounded_string := 
    Class_bounded_string.to_bounded_string("Brighton");
  county: Class_bounded_string.Bounded_string := 
    Class_bounded_string.to_bounded_string("E Sussex");
begin
  Ada.Text_io.put( 
       Class_bounded_string.to_string( town & " " & county ) 
  );
end main3;

with Class_container, main3; 
use  Class_container;
procedure main is
begin
  main1; main2; main3;
end main;


© M.A.Smith University of Brighton. Created September 1995 last modified May 1997.
Comments, suggestions, etc. M.A.Smith@brighton.ac.uk * [Home page]