mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 18:47:52 +02:00
pastojs: implemented property with index specifier
git-svn-id: trunk@37383 -
This commit is contained in:
Mattias Gaertner
parent
6148ba8c31
commit
e5d4d763b3
@ -458,6 +458,7 @@ type
|
||||
pbivnRTTIProcFlags,
|
||||
pbivnRTTIProcVar_ProcSig,
|
||||
pbivnRTTIPropDefault,
|
||||
pbivnRTTIPropIndex,
|
||||
pbivnRTTIPropStored,
|
||||
pbivnRTTISet_CompType,
|
||||
pbivnSelf,
|
||||
@ -560,6 +561,7 @@ const
|
||||
'flags',
|
||||
'procsig',
|
||||
'Default',
|
||||
'index',
|
||||
'stored',
|
||||
'comptype',
|
||||
'Self',
|
||||
@ -1348,6 +1350,8 @@ type
|
||||
pfStoredFalse = 4; // stored false, never
|
||||
pfStoredField = 8; // stored field, field name is in Stored
|
||||
pfStoredFunction = 12; // stored function, function name is in Stored
|
||||
pfHasIndex = 16; { if getter is function, append Index as last param
|
||||
if setter is function, append Index as second last param }
|
||||
type
|
||||
TMethodKind = (
|
||||
mkProcedure, // 0 default
|
||||
@ -2242,6 +2246,7 @@ var
|
||||
Arg: TPasArgument;
|
||||
ArgResolved: TPasResolverResult;
|
||||
ParentC: TClass;
|
||||
IndexExpr: TPasExpr;
|
||||
begin
|
||||
inherited FinishPropertyOfClass(PropEl);
|
||||
|
||||
@ -2263,16 +2268,17 @@ begin
|
||||
GetterIsBracketAccessor:=IsExternalBracketAccessor(Getter);
|
||||
Setter:=GetPasPropertySetter(PropEl);
|
||||
SetterIsBracketAccessor:=IsExternalBracketAccessor(Setter);
|
||||
IndexExpr:=GetPasPropertyIndex(PropEl);
|
||||
if GetterIsBracketAccessor then
|
||||
begin
|
||||
if PropEl.Args.Count<>1 then
|
||||
if (PropEl.Args.Count<>1) or (IndexExpr<>nil) then
|
||||
RaiseMsg(20170403001743,nBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
sBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
[],PropEl);
|
||||
end;
|
||||
if SetterIsBracketAccessor then
|
||||
begin
|
||||
if PropEl.Args.Count<>1 then
|
||||
if (PropEl.Args.Count<>1) or (IndexExpr<>nil) then
|
||||
RaiseMsg(20170403001806,nBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
sBracketAccessorOfExternalClassMustHaveOneParameter,
|
||||
[],PropEl);
|
||||
@ -4573,6 +4579,7 @@ var
|
||||
ResolvedEl: TPasResolverResult;
|
||||
ProcType, TargetProcType: TPasProcedureType;
|
||||
ArrLit: TJSArrayLiteral;
|
||||
IndexExpr: TPasExpr;
|
||||
begin
|
||||
Result:=nil;
|
||||
if not (El.CustomData is TResolvedReference) then
|
||||
@ -4644,6 +4651,9 @@ begin
|
||||
Call:=CreateCallExpression(El);
|
||||
AssignContext.Call:=Call;
|
||||
Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
|
||||
IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop);
|
||||
if IndexExpr<>nil then
|
||||
Call.AddArg(ConvertElement(IndexExpr,AContext));
|
||||
Call.AddArg(AssignContext.RightSide);
|
||||
AssignContext.RightSide:=nil;
|
||||
Result:=Call;
|
||||
@ -4653,8 +4663,26 @@ begin
|
||||
caRead:
|
||||
begin
|
||||
Decl:=AContext.Resolver.GetPasPropertyGetter(Prop);
|
||||
if (Decl is TPasFunction) and (Prop.Args.Count=0) then
|
||||
ImplicitCall:=true;
|
||||
if Decl is TPasFunction then
|
||||
begin
|
||||
IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop);
|
||||
if IndexExpr<>nil then
|
||||
begin
|
||||
// call function with index specifier
|
||||
Call:=CreateCallExpression(El);
|
||||
try
|
||||
Call.Expr:=CreateReferencePathExpr(Decl,AContext,false,Ref);
|
||||
Call.AddArg(ConvertElement(IndexExpr,AContext));
|
||||
Result:=Call;
|
||||
finally
|
||||
if Result=nil then
|
||||
Call.Free;
|
||||
end;
|
||||
exit;
|
||||
end
|
||||
else if (Prop.Args.Count=0) then
|
||||
ImplicitCall:=true;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
RaiseNotSupported(El,AContext,20170213212623);
|
||||
@ -5380,6 +5408,7 @@ var
|
||||
AccessEl: TPasElement;
|
||||
AssignContext: TAssignContext;
|
||||
OldAccess: TCtxAccess;
|
||||
IndexExpr: TPasExpr;
|
||||
begin
|
||||
Result:=nil;
|
||||
AssignContext:=nil;
|
||||
@ -5434,6 +5463,10 @@ var
|
||||
Elements.AddElement.Expr:=Arg;
|
||||
inc(i);
|
||||
end;
|
||||
// add index specifier
|
||||
IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop);
|
||||
if IndexExpr<>nil then
|
||||
Elements.AddElement.Expr:=ConvertElement(IndexExpr,ArgContext);
|
||||
// finally add as last parameter the value
|
||||
if AssignContext<>nil then
|
||||
begin
|
||||
@ -9834,9 +9867,9 @@ var
|
||||
GetterPas, SetterPas, DeclEl: TPasElement;
|
||||
ResultTypeInfo, DefValue: TJSElement;
|
||||
VarType: TPasType;
|
||||
StoredExpr: TPasExpr;
|
||||
StoredExpr, IndexExpr: TPasExpr;
|
||||
StoredResolved, VarTypeResolved: TPasResolverResult;
|
||||
StoredValue, PasValue: TResEvalValue;
|
||||
StoredValue, PasValue, IndexValue: TResEvalValue;
|
||||
begin
|
||||
Result:=nil;
|
||||
OptionsEl:=nil;
|
||||
@ -9857,8 +9890,10 @@ begin
|
||||
SetterPas:=AContext.Resolver.GetPasPropertySetter(Prop);
|
||||
if SetterPas is TPasProcedure then
|
||||
inc(Flags,pfSetProcedure);
|
||||
|
||||
StoredExpr:=AContext.Resolver.GetPasPropertyStoredExpr(Prop);
|
||||
IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop);
|
||||
if IndexExpr<>nil then
|
||||
inc(Flags,pfHasIndex);
|
||||
if StoredExpr<>nil then
|
||||
begin
|
||||
AContext.Resolver.ComputeElement(StoredExpr,StoredResolved,[rcNoImplicitProc]);
|
||||
@ -9869,7 +9904,8 @@ begin
|
||||
begin
|
||||
if (StoredResolved.BaseType=btBoolean) and (StoredResolved.ExprEl<>nil) then
|
||||
begin
|
||||
// try evaluating const boolean
|
||||
// could be a const boolean
|
||||
// -> try evaluating const boolean
|
||||
StoredValue:=AContext.Resolver.Eval(StoredExpr,[]);
|
||||
if StoredValue<>nil then
|
||||
try
|
||||
@ -9913,6 +9949,19 @@ begin
|
||||
else
|
||||
Call.AddArg(CreateLiteralString(Prop,GetAccessorName(SetterPas)));
|
||||
|
||||
// add option "index"
|
||||
IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop);
|
||||
if IndexExpr<>nil then
|
||||
begin
|
||||
IndexValue:=AContext.Resolver.Eval(IndexExpr,[refConst]);
|
||||
try
|
||||
AddOption(FBuiltInNames[pbivnRTTIPropIndex],
|
||||
ConvertConstValue(IndexValue,AContext,Prop));
|
||||
finally
|
||||
ReleaseEvalValue(IndexValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
// add option "stored"
|
||||
if StoredExpr<>nil then
|
||||
begin
|
||||
@ -9928,9 +9977,7 @@ begin
|
||||
try
|
||||
DefValue:=nil;
|
||||
if VarTypeResolved.BaseType=btSet then
|
||||
begin
|
||||
DefValue:=CreateValInit(VarType,Prop.DefaultExpr,Prop.DefaultExpr,AContext);
|
||||
end;
|
||||
if DefValue=nil then
|
||||
DefValue:=ConvertConstValue(PasValue,AContext,Prop);
|
||||
AddOption(FBuiltInNames[pbivnRTTIPropDefault],DefValue);
|
||||
@ -10045,8 +10092,6 @@ function TPasToJSConverter.ConvertProperty(El: TPasProperty;
|
||||
|
||||
begin
|
||||
Result:=Nil;
|
||||
if El.IndexExpr<>nil then
|
||||
RaiseNotSupported(El.IndexExpr,AContext,20170215103010,'property index expression');
|
||||
if El.ImplementsFunc<>nil then
|
||||
RaiseNotSupported(El.ImplementsFunc,AContext,20170215102923,'property implements function');
|
||||
if El.DispIDExpr<>nil then
|
||||
|
||||
@ -356,6 +356,7 @@ type
|
||||
Procedure TestClass_Property;
|
||||
Procedure TestClass_Property_ClassMethod;
|
||||
Procedure TestClass_Property_Indexed;
|
||||
Procedure TestClass_Property_IndexSpec;
|
||||
Procedure TestClass_PropertyOfTypeArray;
|
||||
Procedure TestClass_PropertyDefault;
|
||||
Procedure TestClass_PropertyOverride;
|
||||
@ -504,6 +505,7 @@ type
|
||||
Procedure TestRTTI_PublishedClassPropertyFail;
|
||||
Procedure TestRTTI_PublishedClassFieldFail;
|
||||
Procedure TestRTTI_PublishedFieldExternalFail;
|
||||
Procedure TestRTTI_IndexModifier;
|
||||
Procedure TestRTTI_StoredModifier;
|
||||
Procedure TestRTTI_DefaultValue;
|
||||
Procedure TestRTTI_DefaultValueSet;
|
||||
@ -513,7 +515,6 @@ type
|
||||
Procedure TestRTTI_Class_MethodArgFlags;
|
||||
Procedure TestRTTI_Class_Property;
|
||||
Procedure TestRTTI_Class_PropertyParams;
|
||||
// ToDo: property default value
|
||||
Procedure TestRTTI_OverrideMethod;
|
||||
Procedure TestRTTI_OverloadProperty;
|
||||
// ToDo: array argument
|
||||
@ -7400,6 +7401,63 @@ begin
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_Property_IndexSpec;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TEnum = (red, blue);',
|
||||
' TObject = class',
|
||||
' function GetIntBool(Index: longint): boolean; virtual; abstract;',
|
||||
' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
|
||||
' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
|
||||
' procedure SetEnumBool(Index: TEnum; b: boolean); virtual; abstract;',
|
||||
' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
|
||||
' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
|
||||
' property B1: boolean index 1 read GetIntBool write SetIntBool;',
|
||||
' property B2: boolean index TEnum.blue read GetEnumBool write SetEnumBool;',
|
||||
' property I1[A: String]: boolean index 2 read GetStrIntBool write SetStrIntBool;',
|
||||
' end;',
|
||||
'procedure DoIt(b: boolean); begin end;',
|
||||
'var',
|
||||
' o: TObject;',
|
||||
'begin',
|
||||
' o.B1:=o.B1;',
|
||||
' o.B2:=o.B2;',
|
||||
' o.I1[''a'']:=o.I1[''b''];',
|
||||
' doit(o.b1);',
|
||||
' doit(o.b2);',
|
||||
' doit(o.i1[''c'']);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestClass_Property_IndexSpec',
|
||||
LinesToStr([ // statements
|
||||
'this.TEnum = {',
|
||||
' "0": "red",',
|
||||
' red: 0,',
|
||||
' "1": "blue",',
|
||||
' blue: 1',
|
||||
'};',
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
'});',
|
||||
'this.DoIt = function (b) {',
|
||||
'};',
|
||||
'this.o = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.o.SetIntBool(1, $mod.o.GetIntBool(1));',
|
||||
'$mod.o.SetEnumBool(TEnum.blue, $mod.o.GetEnumBool(TEnum.blue));',
|
||||
'$mod.o.SetStrIntBool("a", 2, $mod.o.GetStrIntBool("b", 2));',
|
||||
'$mod.DoIt($mod.o.GetIntBool(1));',
|
||||
'$mod.DoIt($mod.o.GetEnumBool(TEnum.blue));',
|
||||
'$mod.DoIt($mod.o.GetStrIntBool("c", 2));',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_PropertyOfTypeArray;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -13450,6 +13508,85 @@ begin
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRTTI_IndexModifier;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TEnum = (red, blue);',
|
||||
' TObject = class',
|
||||
' FB: boolean;',
|
||||
' procedure SetIntBool(Index: longint; b: boolean); virtual; abstract;',
|
||||
' function GetBoolBool(Index: boolean): boolean; virtual; abstract;',
|
||||
' procedure SetBoolBool(Index: boolean; b: boolean); virtual; abstract;',
|
||||
' function GetEnumBool(Index: TEnum): boolean; virtual; abstract;',
|
||||
' function GetStrIntBool(A: String; I: longint): boolean; virtual; abstract;',
|
||||
' procedure SetStrIntBool(A: String; I: longint; b: boolean); virtual; abstract;',
|
||||
' published',
|
||||
' property B1: boolean index 1 read FB write SetIntBool;',
|
||||
' property B2: boolean index TEnum.blue read GetEnumBool write FB;',
|
||||
' property I1[A: String]: boolean index 2 read GetStrIntBool write SetStrIntBool;',
|
||||
' end;',
|
||||
'begin']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestRTTI_IndexModifier',
|
||||
LinesToStr([ // statements
|
||||
'this.TEnum = {',
|
||||
' "0": "red",',
|
||||
' red: 0,',
|
||||
' "1": "blue",',
|
||||
' blue: 1',
|
||||
'};',
|
||||
'$mod.$rtti.$Enum("TEnum", {',
|
||||
' minvalue: 0,',
|
||||
' maxvalue: 1,',
|
||||
' ordtype: 1,',
|
||||
' enumtype: this.TEnum',
|
||||
'});',
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' this.FB = false;',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' var $r = this.$rtti;',
|
||||
' $r.addProperty(',
|
||||
' "B1",',
|
||||
' 18,',
|
||||
' rtl.boolean,',
|
||||
' "FB",',
|
||||
' "SetIntBool",',
|
||||
' {',
|
||||
' index: 1',
|
||||
' }',
|
||||
' );',
|
||||
' $r.addProperty(',
|
||||
' "B2",',
|
||||
' 17,',
|
||||
' rtl.boolean,',
|
||||
' "GetEnumBool",',
|
||||
' "FB",',
|
||||
' {',
|
||||
' index: $mod.TEnum.blue',
|
||||
' }',
|
||||
' );',
|
||||
' $r.addProperty(',
|
||||
' "I1",',
|
||||
' 19,',
|
||||
' rtl.boolean,',
|
||||
' "GetStrIntBool",',
|
||||
' "SetStrIntBool",',
|
||||
' {',
|
||||
' index: 2',
|
||||
' }',
|
||||
' );',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRTTI_StoredModifier;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
@ -13461,7 +13598,6 @@ begin
|
||||
' TObject = class',
|
||||
' private',
|
||||
' FB: boolean;',
|
||||
//' FI: longint;',
|
||||
' function IsBStored: boolean; virtual; abstract;',
|
||||
' published',
|
||||
' property BoolA: boolean read FB stored true;',
|
||||
|
||||
Loading…
Reference in New Issue
Block a user