Browse Source

* new bugs

peter 21 years ago
parent
commit
0f17fe1bd3
3 changed files with 115 additions and 0 deletions
  1. 20 0
      tests/webtbs/tw2897.pp
  2. 31 0
      tests/webtbs/tw2899.pp
  3. 64 0
      tests/webtbs/tw2911.pp

+ 20 - 0
tests/webtbs/tw2897.pp

@@ -0,0 +1,20 @@
+{ Source provided for Free Pascal Bug Report 2897 }
+{ Submitted by "C Western" on  2004-01-17 }
+{ e-mail: [email protected] }
+program stackerr;
+
+{$S+}
+
+procedure Show(v: Integer);
+begin
+  WriteLn(v);
+  if v<>27 then
+    begin
+      writeln('Error!');
+      halt(1);
+    end;
+end;
+
+begin
+  Show(27)
+end.

+ 31 - 0
tests/webtbs/tw2899.pp

@@ -0,0 +1,31 @@
+{ Source provided for Free Pascal Bug Report 2899 }
+{ Submitted by "Mattias Gaertner" on  2004-01-17 }
+{ e-mail: [email protected] }
+program StringCallByRef;
+
+{$ifdef fpc}{$mode objfpc}{$H+}{$endif}
+
+uses
+  Classes, SysUtils;
+
+procedure DoSomething(const AString: string);
+
+  procedure NestedProc(var Dummy: string);
+  begin
+    Dummy:=Dummy; // dummy statement, no change
+  end;
+
+var
+  s: String;
+begin
+  s:=copy(AString,5,11);
+  writeln('Before NestedProc: "',s,'"');
+  NestedProc(s);
+  writeln('After NestedProc: "',s,'"'); // s is now emtpy
+  if s<>'WhatAStrangeBug' then
+    halt(1);
+end;
+
+begin
+  DoSomething('WhatAStrangeBug');
+end.

+ 64 - 0
tests/webtbs/tw2911.pp

@@ -0,0 +1,64 @@
+{ Source provided for Free Pascal Bug Report 2911 }
+{ Submitted by "Chris Hilder" on  2004-01-19 }
+{ e-mail: [email protected] }
+program bug_demo;
+{$LONGSTRINGS ON}
+
+{$ifdef fpc}{$Mode objfpc}{$endif}
+
+type
+        RecordWithStrings =
+                record
+                        one,
+                        two : string;
+                end;
+
+var
+        onestring,
+        twostring : string;
+        ARecordWithStrings : RecordWithStrings;
+
+procedure RefCount(const s : string;expect:longint);
+type
+        PLongint = ^Longint;
+var
+        P : PLongint;
+        rc : longint;
+begin
+        P := PLongint(s);
+        rc:=0;
+        if (p = nil)
+        then writeln('Nil string.')
+        else
+{$ifdef  fpc}
+         rc:=(p-1)^;
+{$else}
+         rc:=plongint(pchar(p)-8)^);
+{$endif}
+  writeln('Ref count is ',rc,' expected ',expect);
+  if rc<>expect then
+    halt(1);
+end;
+
+function FunctionResultIsRecord(a : RecordWithStrings) : RecordWithStrings;
+begin
+        result := a;
+end;
+
+begin
+        writeln('All reference counts should be 1 for the following...');
+        onestring := 'one';
+        twostring := 'two';
+        ARecordWithStrings.one := onestring + twostring;
+        twostring := onestring + twostring;
+        RefCount(ARecordWithStrings.one,1);
+        ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
+        twostring := onestring + twostring;
+        RefCount(ARecordWithStrings.one,2);
+        ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
+        twostring := onestring + twostring;
+        RefCount(ARecordWithStrings.one,3);
+        ARecordWithStrings := FunctionResultIsRecord(ARecordWithStrings);
+        twostring := onestring + twostring;
+        RefCount(ARecordWithStrings.one,4);
+end.