+ range checking tests

tests/test/range.pp

@@ -0,0 +1,232 @@
+{$mode objfpc}
+uses sysutils;
+
+var
+  error: boolean;
+
+{$r+}
+function testlongint_int64(i: int64; shouldfail: boolean): boolean;
+var
+  l: longint;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+function testlongint_qword(i: qword; shouldfail: boolean): boolean;
+var
+  l: longint;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+function testdword_int64(i: int64; shouldfail: boolean): boolean;
+var
+  l: dword;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+function testdword_qword(i: qword; shouldfail: boolean): boolean;
+var
+  l: dword;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+{$r-}
+
+var
+  i: int64;
+  q: qword;
+begin
+  error := false;
+{ *********************** int64 to longint ********************* }
+  writeln('int64 to longint');
+  i := $ffffffffffffffff;
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test1 failed');
+  i := i and $ffffffff00000000;
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test2 failed');
+  inc(i);
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test3 failed');
+  longint(i) := $80000000;
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test4 failed');
+  i := 0;
+  longint(i) := $80000000;
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test5 failed');
+  dec(i);
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test6 failed');
+  i := 0;
+  longint(i) := $ffffffff;
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test7 failed');
+  i := 0;
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test8 failed');
+
+{ *********************** qword to longint ********************* }
+  writeln;
+  writeln('qword to longint');
+  q := $ffffffffffffffff;
+  writeln(q);
+  if not testlongint_qword(q,true) then
+    writeln('test1 failed');
+  q := q and $ffffffff00000000;
+  writeln(q);
+  if not testlongint_qword(q,true) then
+    writeln('test2 failed');
+  inc(q);
+  writeln(q);
+  if not testlongint_qword(q,true) then
+    writeln('test3 failed');
+  longint(q) := $80000000;
+  writeln(q);
+  if not testlongint_qword(q,true) then
+    writeln('test4 failed');
+  q := 0;
+  longint(q) := $80000000;
+  writeln(q);
+  if not testlongint_qword(q,true) then
+    writeln('test5 failed');
+  dec(q);
+  writeln(q);
+  if not testlongint_qword(q,false) then
+    writeln('test6 failed');
+  q := 0;
+  longint(q) := $ffffffff;
+  writeln(q);
+  if not testlongint_qword(q,true) then
+    writeln('test7 failed');
+  q := 0;
+  writeln(q);
+  if not testlongint_qword(q,false) then
+    writeln('test8 failed');
+
+{ *********************** int64 to dword ********************* }
+  writeln;
+  writeln('int64 to dword');
+  i := $ffffffffffffffff;
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test1 failed');
+  i := i and $ffffffff00000000;
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test2 failed');
+  inc(i);
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test3 failed');
+  longint(i) := $80000000;
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test4 failed');
+  i := 0;
+  longint(i) := $80000000;
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test5 failed');
+  dec(i);
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test6 failed');
+  i := 0;
+  longint(i) := $ffffffff;
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test7 failed');
+  i := 0;
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test8 failed');
+
+{ *********************** qword to dword ********************* }
+  writeln;
+  writeln('qword to dword');
+  q := $ffffffffffffffff;
+  writeln(q);
+  if not testdword_qword(q,true) then
+    writeln('test1 failed');
+  q := q and $ffffffff00000000;
+  writeln(q);
+  if not testdword_qword(q,true) then
+    writeln('test2 failed');
+  inc(q);
+  writeln(q);
+  if not testdword_qword(q,true) then
+    writeln('test3 failed');
+  longint(q) := $80000000;
+  writeln(q);
+  if not testdword_qword(q,true) then
+    writeln('test4 failed');
+  q := 0;
+  longint(q) := $80000000;
+  writeln(q);
+  if not testdword_qword(q,false) then
+    writeln('test5 failed');
+  dec(q);
+  writeln(q);
+  if not testdword_qword(q,false) then
+    writeln('test6 failed');
+  q := 0;
+  longint(q) := $ffffffff;
+  writeln(q);
+  if not testdword_qword(q,false) then
+    writeln('test7 failed');
+  q := 0;
+  writeln(q);
+  if not testdword_qword(q,false) then
+    writeln('test8 failed');
+
+  if error then
+    begin
+      writeln;
+      writeln('still range check problems!');
+      halt(1);
+    end;
+end.

tests/test/range2.pp

@@ -0,0 +1,30 @@
+{$mode objfpc}
+uses sysutils;
+{$r+}
+
+var
+  l: longint;
+  c: cardinal;
+  n: longint;
+begin
+  n := 0;
+  l := -1;
+  try
+    c := l;
+  except
+    writeln('caught 1!');
+    inc(n);
+  end;
+  longint(c) := $ffffffff;
+  try
+    l := c;
+  except
+    writeln('caught 2!');
+    inc(n);
+  end;
+  if n <> 2 then
+    begin
+      writeln('Still problems with range checking between longint/cardinal');
+      halt(1);
+    end;
+end.

tests/test/range3.pp

@@ -0,0 +1,134 @@
+{$mode objfpc}
+uses sysutils;
+
+{$r+}
+
+var
+  a1: array[-5..6] of byte;
+  a2: array[-12..-1] of byte;
+  a3: array[0..6] of byte;
+  a4: array[1..12] of byte;
+  
+  c: cardinal;
+  l: longint;
+  b: byte;
+  finalerror: boolean;
+
+function check_longint(l: longint; res1, res2, res3, res4: boolean): boolean;
+var
+  caught,
+  error: boolean;
+begin
+  result := false;
+
+  caught := false;
+  try
+    b := a1[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res1;
+  if error then writeln('long 1 failed for ',l);
+  result := result or error;
+  
+  caught := false;
+  try
+    b := a2[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res2;
+  if error then writeln('long 2 failed for ',l);
+  result := result or error;
+
+  caught := false;
+  try
+    b := a3[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res3;
+  if error then writeln('long 3 failed for ',l);
+  result := result or error;
+
+  caught := false;
+  try
+    b := a4[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res4;
+  if error then writeln('long 4 failed for ',l);
+  result := result or error;
+  writeln;
+end;
+
+function check_cardinal(l: cardinal; res1, res2, res3, res4: boolean): boolean;
+var
+  caught,
+  error: boolean;
+begin
+  result := false;
+
+  caught := false;
+  try
+    b := a1[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res1;
+  if error then writeln('card 1 failed for ',l);
+  result := result or error;
+  
+  caught := false;
+  try
+    b := a2[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res2;
+  if error then writeln('card 2 failed for ',l);
+  result := result or error;
+
+  caught := false;
+  try
+    b := a3[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res3;
+  if error then writeln('card 3 failed for ',l);
+  result := result or error;
+
+  caught := false;
+  try
+    b := a4[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res4;
+  if error then writeln('card 4 failed for ',l);
+  result := result or error;
+  writeln;
+end;
+
+
+begin
+  finalerror :=
+    check_longint(-1,false,false,true,true);
+  finalerror :=
+    check_longint(-6,true,false,true,true) or finalerror;
+  finalerror :=
+    check_longint(0,false,true,false,true) or finalerror;
+  finalerror :=
+    check_cardinal(0,false,true,false,true);
+  finalerror :=
+    check_cardinal(cardinal($ffffffff),true,true,true,true) or finalerror;
+  finalerror :=
+    check_cardinal(5,false,true,false,false) or finalerror;
+  if finalerror then
+    begin
+      writeln('Still errors in range checking for array indexes');
+      halt(1);
+    end;
+end.

tests/test/readme.txt

@@ -39,3 +39,8 @@ Inline ................ inline01.pp    tests recursive inlining, inlining
 Finalize .............. testfi1.pp     tests the procedure system.finalize
 TypeInfo .............. testti1.pp     test the function system.typeinfo
 Resourcestrings ....... testrstr.pp    tests a simple resource string
+Range checking ........ range.pp       range checking when converting int64/
+                                       qword to longint/cardinal
+                        range2.pp      range checking when converting
+                                       between longint and cardinal
+                        range3.pp      range checking for arrays