← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/objpas/classes/persist.inc

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/rtl/objpas/classes/persist.inc
 
1
{
 
2
    This file is part of the Free Component Library (FCL)
 
3
    Copyright (c) 1999-2000 by the Free Pascal development team
 
4
 
 
5
    See the file COPYING.FPC, included in this distribution,
 
6
    for details about the copyright.
 
7
 
 
8
    This program is distributed in the hope that it will be useful,
 
9
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
10
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
11
 
 
12
 **********************************************************************}
 
13
 
 
14
{****************************************************************************}
 
15
{*                             TPersistent                                  *}
 
16
{****************************************************************************}
 
17
 
 
18
procedure TPersistent.AssignError(Source: TPersistent);
 
19
 
 
20
Var SourceName : String;
 
21
 
 
22
begin
 
23
  If Source<>Nil then
 
24
    SourceName:=Source.ClassName
 
25
  else
 
26
    SourceName:='Nil';
 
27
  raise EConvertError.CreateFmt (SAssignError,[SourceName,ClassName]);
 
28
end;
 
29
 
 
30
 
 
31
 
 
32
procedure TPersistent.AssignTo(Dest: TPersistent);
 
33
 
 
34
 
 
35
begin
 
36
  Dest.AssignError(Self);
 
37
end;
 
38
 
 
39
 
 
40
procedure TPersistent.DefineProperties(Filer: TFiler);
 
41
 
 
42
begin
 
43
end;
 
44
 
 
45
 
 
46
function  TPersistent.GetOwner: TPersistent;
 
47
 
 
48
begin
 
49
  Result:=Nil;
 
50
end;
 
51
 
 
52
destructor TPersistent.Destroy;
 
53
 
 
54
begin
 
55
  Inherited Destroy;
 
56
end;
 
57
 
 
58
 
 
59
procedure TPersistent.Assign(Source: TPersistent);
 
60
 
 
61
begin
 
62
  If Source<>Nil then
 
63
    Source.AssignTo(Self)
 
64
  else
 
65
    AssignError(Nil);
 
66
end;
 
67
 
 
68
function  TPersistent.GetNamePath: string;
 
69
 
 
70
Var OwnerName :String;
 
71
 
 
72
begin
 
73
 Result:=ClassNAme;
 
74
 If GetOwner<>Nil then
 
75
   begin
 
76
   OwnerName:=GetOwner.GetNamePath;
 
77
   If OwnerName<>'' then Result:=OwnerName+'.'+Result;
 
78
   end;
 
79
end;
 
80
 
 
81
 
 
82
{****************************************************************************}
 
83
{*                          TInterfacedPersistent                           *}
 
84
{****************************************************************************}
 
85
 
 
86
procedure TInterfacedPersistent.AfterConstruction;
 
87
begin
 
88
  inherited;
 
89
//  if GetOwner<>nil then
 
90
//   GetOwner.GetInterface(IUnknown,FOwnerInterface);
 
91
end;
 
92
 
 
93
 
 
94
function TInterfacedPersistent._AddRef: Integer;stdcall;
 
95
begin
 
96
  if FOwnerInterface<>nil then
 
97
    Result:=FOwnerInterface._AddRef
 
98
  else
 
99
    Result:=-1;
 
100
end;
 
101
 
 
102
 
 
103
function TInterfacedPersistent._Release: Integer;stdcall;
 
104
begin
 
105
  if FOwnerInterface <> nil then
 
106
    Result:=FOwnerInterface._Release
 
107
  else
 
108
    Result:=-1;
 
109
end;
 
110
 
 
111
 
 
112
function TInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
 
113
begin
 
114
  if GetInterface(IID, Obj) then
 
115
    Result:=0
 
116
  else
 
117
    Result:=HResult($80004002);
 
118
end;
 
119
 
 
120
 
 
121
{****************************************************************************}
 
122
{*                                TRecall                                   *}
 
123
{****************************************************************************}
 
124
 
 
125
constructor TRecall.Create(AStorage,AReference: TPersistent);
 
126
begin
 
127
  inherited Create;
 
128
  FStorage:=AStorage;
 
129
  FReference:=AReference;
 
130
  Store;
 
131
end;
 
132
 
 
133
 
 
134
destructor TRecall.Destroy;
 
135
begin
 
136
  if Assigned(FReference) then
 
137
   FReference.Assign(FStorage);
 
138
  Forget;
 
139
  inherited;
 
140
end;
 
141
 
 
142
 
 
143
procedure TRecall.Forget;
 
144
begin
 
145
  FReference:=nil;
 
146
  FreeAndNil(FStorage);
 
147
end;
 
148
 
 
149
 
 
150
procedure TRecall.Store;
 
151
begin
 
152
  if Assigned(FReference) then
 
153
    FStorage.Assign(FReference);
 
154
end;
 
155
 
 
156