Browse Source

* bunch of new bugs

peter 25 years ago
parent
commit
22d3553de1

+ 15 - 0
tests/tbf/tbf0352.pp

@@ -0,0 +1,15 @@
+{$ifdef fpc}{$MODE OBJFPC}{$endif}
+
+Procedure Proc1(args:array of const);
+begin
+end;
+
+Procedure Proc2(args:array of longint);
+Begin
+  { this should give an error }
+  Proc1(args);
+End;
+
+Begin
+  Proc1([0,1]);
+End.

+ 1 - 1
tests/tbs/tbs0327.pp

@@ -32,7 +32,7 @@ procedure l2(s:string);
 begin
 end;
 
-procedure l3(i:integer);
+procedure l3(i:integer);overload;
 begin
 end;
 

+ 14 - 0
tests/webtbs/tbug1104.pp

@@ -0,0 +1,14 @@
+var
+  r1,r2 : extended;
+  code : integer;
+begin
+  val('.',r1,code);
+  if r1<>0.0 then
+   writeln('error with val(".")');
+  val('.E',r2,code);
+  if r2<>0.0 then
+   writeln('error with val(".E")');
+  if (r1<>0.0) or (r2<>0.0) then
+   halt(1);
+end.
+

+ 7 - 0
tests/webtbs/tbug1111.pp

@@ -0,0 +1,7 @@
+var
+  v : 0..5;
+  sMin, sMax : 0..5;  // if top of range is less than 32, get compiler Panic
+begin
+  if v in [sMin..sMax] then ;
+end.
+

+ 27 - 0
tests/webtbs/tbug1117.pp

@@ -0,0 +1,27 @@
+{$asmmode intel}
+var
+  l1,l2 : longint;
+
+procedure DrawSprite1( spr : longint ); assembler;
+asm
+    mov eax,spr
+    mov l1, eax
+end;
+
+procedure DrawSprite2( spr : longint );
+begin
+asm
+    mov eax,spr
+    mov l2,eax
+end;
+end;
+
+begin
+  DrawSprite1(1);
+  DrawSprite2(1);
+  if l1<>l2 then
+   begin
+     Writeln('Error!');
+     halt(1);
+   end;
+end.

+ 28 - 0
tests/webtbs/tbug1132.pp

@@ -0,0 +1,28 @@
+program BugDemo2;
+
+type
+   MyRecordType =
+   record
+      RecordElement1 : word;
+      RecordElement2 : word;
+   end;
+
+var
+   MyRecord : MyRecordType;
+   MyPointer1,MyPointer2 : pointer;
+
+begin
+   with MyRecord do
+   begin
+      { next statement crashes the compiler }
+      MyPointer1 := addr(RecordElement2);
+
+      { next statement is OK }
+      MyPointer2 := addr(MyRecord.RecordElement2);
+   end;
+  if MyPointer1<>MyPointer2 then
+   begin
+     Writeln('Error with addr() and with statement');
+     halt(1);
+   end;
+end.

+ 34 - 0
tests/webtbs/tbug1133.pp

@@ -0,0 +1,34 @@
+{ $OPT=-O2 }
+type
+   float = double;
+
+
+function ConvertRealToPixel(Axis     : integer;
+                            HelpReal : real) : real;
+
+   begin   { function ConvertRealToPixel }
+      ConvertRealToPixel := HelpReal;
+   end;    { function ConvertRealToPixel }
+
+
+var
+   HelpFloat1,HelpFloat2,HelpFloat3  : float;
+   SegmentStartPos        : float;
+   SegmentLength          : float;
+
+
+begin
+   SegmentStartPos := 0.5;
+   SegmentLength := 0.5;
+   HelpFloat1 := SegmentStartPos - SegmentLength / 2;
+   HelpFloat2 := ConvertRealToPixel(1,HelpFloat1);
+   writeln('Function result = ',HelpFloat2,'  This is OK');
+
+   HelpFloat3 := ConvertRealToPixel(1,SegmentStartPos - SegmentLength / 2);
+   writeln('Function result = ',HelpFloat3,'  THIS IS WRONG !');
+   if HelpFloat2<>HelpFloat3 then
+    begin
+      Writeln('ERROR!');
+      Halt(1);
+    end;
+end.