paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 01:29:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added possibility to force use of setter/getter for properties.

Browse Source 
* Added possibility to add a line of text in the property setter. (%PROPNAME%)
* Fixed TCodeOptions.Assign, missing a couple of properties.
* Fixed name of setter routine

git-svn-id: trunk@23439 -
This commit is contained in:
michael 2013-01-18 14:42:13 +00:00
parent 7c663af588
commit 49e3d2734e
1 changed files with 33 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
packages/fcl-db/src/codegen/fpddcodegen.pp
View File

@ -38,6 +38,8 @@ Type
TVisibility = (vPrivate,vProtected,vPublic,vPublished);
TVisibilities = Set of TVisibility;
TPropAccess = (paReadWrite,paReadonly,paWriteonly);
TPropSetter = (psRead,psWrite);
TPropSetters = set of TPropSetter;
TFieldPropDefs = Class;
@ -51,6 +53,7 @@ Type
FFieldType: TFieldType;
FPropAccess: TPropAccess;
FPropDef: String;
FPropSetters: TPropSetters;
FPropType : TPropType;
FPRopSize: Integer;
FPropName : String;
@ -66,8 +69,8 @@ Type
Constructor Create(ACollection : TCollection) ; override;
Procedure Assign(ASource : TPersistent); override;
Function FieldPropDefs : TFieldPropDefs;
Function HasGetter : Boolean; Virtual; // Always false.
Function HasSetter : Boolean; Virtual; // True for streams/strings
Function HasGetter : Boolean; Virtual; // Checks Propsetters for psRead
Function HasSetter : Boolean; Virtual; // True for streams/strings or if Propsetters has pswrite
Function ObjPasTypeDef : String; virtual; // Object pascal definition of type
Function ObjPasReadDef : String; virtual; // Object pascal definition of getter
Function ObjPasWriteDef : String; virtual; // Object pascal definition of setter
@ -81,6 +84,7 @@ Type
Property PropertyDef : String Read FPropDef Write FPropDef;
Property PropertyVisibility : TVisibility Read FPropVis Write FPropVis;
Property PropertyAccess : TPropAccess Read FPropAccess Write FPropAccess;
Property PropSetters : TPropSetters Read FPropSetters Write FPropSetters;
end;
{ TFieldPropDefs }
@ -113,6 +117,7 @@ Type
FInterfaceUnits: String;
FOptions: TCodeOptions;
FUnitName: String;
FExtraSetterLine : string;
procedure SetImplementationUnits(const AValue: String);
procedure SetInterfaceUnits(const AValue: String);
procedure SetUnitname(const AValue: String);
@ -122,9 +127,15 @@ Type
Constructor create; virtual;
Procedure Assign(ASource : TPersistent); override;
Published
// Line of code that will be added to each property setter. Use %PROPNAME% to include property name in the line.
Property ExtraSetterLine : String Read FExtraSetterLine Write FExtraSetterLine;
// options
Property Options : TCodeOptions Read FOptions Write SetOPtions;
// Name of unit if a unit is generated.
Property UnitName : String Read FUnitName Write SetUnitname;
// Comma-separated list of units that will be put in the interface units clause
Property InterfaceUnits : String Read FInterfaceUnits Write SetInterfaceUnits;
// Comma-separated list of units that will be put in the implementation units clause
Property ImplementationUnits : String Read FImplementationUnits Write SetImplementationUnits;
end;
TCodeGeneratorOptionsClass = Class of TCodeGeneratorOptions;
@ -539,13 +550,13 @@ end;
function TFieldPropDef.HasGetter: Boolean;
begin
Result:=False;
Result:=psRead in PropSetters;
end;
function TFieldPropDef.HasSetter: Boolean;
begin
Result:=(PropertyAccess in [paReadWrite,paWriteOnly])
and (PropertyType in [ptStream,ptTStrings]);
and ((PropertyType in [ptStream,ptTStrings]) or (psWrite in Propsetters));
end;
function TFieldPropDef.ObjPasTypeDef: String;
@ -832,7 +843,7 @@ begin
For I:=0 to Fields.Count-1 do
begin
F:=Fields[i];
if AllowPropertyDeclaration(F,[]) and F.HasGetter then
if AllowPropertyDeclaration(F,[]) and F.HasSetter then
begin
If not B then
begin
@ -867,22 +878,33 @@ Procedure TDDClassCodeGenerator.WritePropertySetterImpl(Strings : TStrings; F :
Var
S : String;
L : Integer;
begin
S:=PropertyGetterDeclaration(F,True);
S:=PropertySetterDeclaration(F,True);
BeginMethod(Strings,S);
AddLn(Strings,'begin');
IncIndent;
Try
AddLn(Strings,Format('if (F%s=AValue) then exit;',[F.PropertyName]));
Case F.PropertyType of
ptTStrings :
S:=Format('F%s.Assign(AValue);',[F.PropertyName]);
ptStream :
S:=Format('F%s.CopyFrom(AValue,0);',[F.PropertyName]);
else
S:=Format('F%s:=AValue',[F.PropertyName]);
S:=Format('F%s:=AValue;',[F.PropertyName]);
end;
AddLn(Strings,S);
S:=CodeOptions.ExtraSetterLine;
L:=Length(S);
if (L>0) then
begin
S:=StringReplace(S,'%PROPNAME%',F.PropertyName,[rfReplaceAll,rfIgnoreCase]);
if (S[L]<>';') then
S:=S+';';
AddLn(Strings,S);
end;
Finally
DecIndent;
end;
@ -1093,7 +1115,7 @@ begin
Result:='Procedure ';
If Impl then
Result:=Result+ClassOptions.ObjectClassName+'.';
Result:=Result+Def.ObjPasReadDef+' (AValue : '+Def.ObjPasTypeDef+');';
Result:=Result+Def.ObjPasWriteDef+' (AValue : '+Def.ObjPasTypeDef+');';
end;
function TDDClassCodeGenerator.NeedsConstructor: Boolean;
@ -1478,8 +1500,11 @@ begin
If ASource is TCodeGeneratorOptions then
begin
CG:=ASource as TCodeGeneratorOptions;
FInterfaceUnits:=CG.InterfaceUnits;
FImplementationUnits:=CG.ImplementationUnits;
FOptions:=CG.FOptions;
FUnitName:=CG.UnitName;
FExtraSetterLine:=CG.ExtraSetterLine;
end
else
inherited Assign(ASource);