File: teststacktrace1.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (83 lines) | stat: -rw-r--r-- 1,190 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
program TestStacktrace1;

{$mode objfpc}{$H+}

uses
  Classes, SysUtils;

type

  { TMainClass }

  TMainClass = class
  public
    type

      { TSubClass }

      TSubClass = class
      public
        constructor Create;
        destructor Destroy; override;
        procedure RaiseSomething(Msg: string);
      end;
  public
    Sub: TSubClass;
    constructor Create;
    destructor Destroy; override;
    function CallSub(i: integer): TSubClass;
  end;

procedure SimpleCall;
var
  c: TMainClass;
begin
  c:=TMainClass.Create;
  try
    c.CallSub(123);
  finally
    c.Free;
  end;
end;

{ TMainClass.TSubClass }

constructor TMainClass.TSubClass.Create;
begin

end;

destructor TMainClass.TSubClass.Destroy;
begin
  inherited Destroy;
end;

procedure TMainClass.TSubClass.RaiseSomething(Msg: string);
begin
  if (length(Msg) div (length(Msg) div 10000))=0 then ;
end;

{ TMainClass }

constructor TMainClass.Create;
begin
  Sub:=TSubClass.Create;
end;

destructor TMainClass.Destroy;
begin
  FreeAndNil(Sub);
  inherited Destroy;
end;

function TMainClass.CallSub(i: integer): TSubClass;
begin
  if i=0 then ;
  Sub.RaiseSomething('');
  Result:=nil;
end;

begin
  SimpleCall;
end.