From e5d4d763b39d6f659d12ca3b449e0dbd6da8a359 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 2 Oct 2017 12:56:29 +0000 Subject: [PATCH] pastojs: implemented property with index specifier git-svn-id: trunk@37383 - --- packages/pastojs/src/fppas2js.pp | 69 ++++++++++--- packages/pastojs/tests/tcmodules.pas | 140 ++++++++++++++++++++++++++- 2 files changed, 195 insertions(+), 14 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index beb731a62b..5207826fd5 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -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 diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 2848de6d9f..dee59882e9 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -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;',