{$mode objfpc}

uses
  sysutils;

var
  ExceptionCount: Integer = 0;
  WrongValueCount: Integer = 0;


procedure Fail(E: Exception);
begin
  Inc(ExceptionCount);
  writeln('FAIL !! : ',E.ToString);
end;

procedure Fail(Value: QWord);
begin
  Inc(WrongValueCount);
  writeln('FAIL !!  [',Value,']')
end;

var
  B: Byte;
  W: Word;
  DW: DWORD;
  QW: QWord;
  Err: Integer;
  AStr: AnsiString;
  SStr: ShortString;
begin
  AStr := '256';
  SStr := '256';
  {$PUSH}
  {$R+}
  writeln('Val(AnsiString,Byte)');
  writeln('RangeCheck ON');
  try
    Val(AStr, B, Err);
    if (Err=0) then Fail(B) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$R-}
  writeln('RangeCheck OFF');
  try
    Val(AStr, B, Err);
    if (Err=0) then Fail(B) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$POP}
  writeln;
  {$PUSH}
  {$R+}
  writeln('Val(ShortString,Byte)');
  writeln('RangeCheck ON');
  try
    Val(SStr, B, Err);
    if (Err=0) then Fail(B) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$R-}
  writeln('RangeCheck OFF');
  try
    Val(SStr, B, Err);
    if (Err=0) then Fail(B) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$POP}



//---------------------------------

  AStr := '65536';
  SStr := '65563';
  {$PUSH}
  {$R+}
  writeln;
  writeln('Val(AnsiString,Word)');
  writeln('RangeCheck ON');
  try
    Val(AStr, W, Err);
    if (Err=0) then Fail(W) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$R-}
  writeln('RangeCheck OFF');
  try
    Val(AStr, W, Err);
    if (Err=0) then Fail(W) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$POP}
  writeln;
  {$PUSH}
  {$R+}
  writeln('Val(ShortString,Word)');
  writeln('RangeCheck ON');
  try
    Val(SStr, W, Err);
    if (Err=0) then Fail(W) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$R-}
  writeln('RangeCheck OFF');
  try
    Val(SStr, W, Err);
    if (Err=0) then Fail(W) else writeln('Err=',Err);
  except
    on E: Exception do Fail(E);
  end;
  {$POP}




  //---------------------------------

    AStr := '4294967296';
    SStr := '4294967296';
    {$PUSH}
    {$R+}
    writeln;
    writeln('Val(AnsiString,DWord)');
    writeln('RangeCheck ON');
    try
      Val(AStr, DW, Err);
      if (Err=0) then Fail(DW) else writeln('Err=',Err);
    except
      on E: Exception do Fail(E);
    end;
    {$R-}
    writeln('RangeCheck OFF');
    try
      Val(AStr, DW, Err);
      if (Err=0) then Fail(DW) else writeln('Err=',Err);
    except
      on E: Exception do Fail(E);
    end;
    {$POP}
    writeln;
    {$PUSH}
    {$R+}
    writeln('Val(ShortString,DWord)');
    writeln('RangeCheck ON');
    try
      Val(SStr, DW, Err);
      if (Err=0) then Fail(DW) else writeln('Err=',Err);
    except
      on E: Exception do Fail(E);
    end;
    {$R-}
    writeln('RangeCheck OFF');
    try
      Val(SStr, DW, Err);
      if (Err=0) then Fail(DW) else writeln('Err=',Err);
    except
      on E: Exception do Fail(E);
    end;
    {$POP}





    //---------------------------------

      AStr := '18446744073709551616';
      SStr := '18446744073709551616';
      {$PUSH}
      {$R+}
      writeln;
      writeln('Val(AnsiString,QWord)');
      writeln('RangeCheck ON');
      try
        Val(AStr, QW, Err);
        if (Err=0) then Fail(QW) else writeln('Err=',Err);
      except
        on E: Exception do Fail(E);
      end;
      {$R-}
      writeln('RangeCheck OFF');
      try
        Val(AStr, QW, Err);
        if (Err=0) then Fail(QW) else writeln('Err=',Err);
      except
        on E: Exception do Fail(E);
      end;
      {$POP}
      writeln;
      {$PUSH}
      {$R+}
      writeln('Val(ShortString,QWord)');
      writeln('RangeCheck ON');
      try
        Val(SStr, QW, Err);
        if (Err=0) then Fail(QW) else writeln('Err=',Err);
      except
        on E: Exception do Fail(E);
      end;
      {$R-}
      writeln('RangeCheck OFF');
      try
        Val(SStr, QW, Err);
        if (Err=0) then Fail(QW) else writeln('Err=',Err);
      except
        on E: Exception do Fail(E);
      end;
      {$POP}

  writeln;
  writeln('ExceptionCount : ',ExceptionCount);
  writeln('WrongValueCount: ',WrongValueCount);

  ExitCode := WrongValueCount + ExceptionCount;

end.
