From f6c09153c245df2cd50ffb50e346cb584bc77550 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 30 Apr 2018 22:22:05 +0000 Subject: [PATCH] pastojs: property specifier nodefault git-svn-id: trunk@38880 - --- packages/fcl-passrc/src/pasresolver.pp | 18 ++++++++++ packages/pastojs/src/fppas2js.pp | 37 ++++++++++---------- packages/pastojs/tests/tcmodules.pas | 48 ++++++++++++++++++++++++++ 3 files changed, 85 insertions(+), 18 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 8b3a6f26bc..96af1ab401 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1680,6 +1680,7 @@ type function GetPasPropertySetter(El: TPasProperty): TPasElement; function GetPasPropertyIndex(El: TPasProperty): TPasExpr; function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr; + function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr; function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType; function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer; function GetLoop(El: TPasElement): TPasImplElement; @@ -16521,6 +16522,23 @@ begin end; end; +function TPasResolver.GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr; +// search the stored expression of a property +begin + Result:=nil; + while El<>nil do + begin + if El.DefaultExpr<>nil then + begin + Result:=El.DefaultExpr; + exit; + end + else if El.IsNodefault then + exit(nil); + El:=GetPasPropertyAncestor(El); + end; +end; + function TPasResolver.CheckParamCompatibility(Expr: TPasExpr; Param: TPasArgument; ParamNo: integer; RaiseOnError: boolean; SetReferenceFlags: boolean): integer; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 38b218234b..2a68b8a5d5 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -213,6 +213,7 @@ Works: - typecast record type to JS Object, e.g. TJSObject(TPoint) - typecast interface type to JS Object, e.g. TJSObject(IUnknown) - for i in tjsobject do + - nested classes - jsvalue - init as undefined - assign to jsvalue := integer, string, boolean, double, char @@ -255,7 +256,7 @@ Works: - WPO skip not used typeinfo - open array param - property stored and index modifier - - property default value + - property default value, nodefault - pointer - compare with and assign nil - typecast class, class-of, interface, array @@ -352,10 +353,7 @@ ToDos: - static arrays - clone multi dim static array - RTTI - - inherit default value, inherit nodefault - class property - - documentation -- nested classes - asm: pas() - useful for overloads and protect an identifier from optimization - interfaces - array of interface @@ -13360,11 +13358,13 @@ var GetterPas, SetterPas, DeclEl: TPasElement; ResultTypeInfo, DefValue: TJSElement; VarType: TPasType; - StoredExpr, IndexExpr: TPasExpr; + StoredExpr, IndexExpr, DefaultExpr: TPasExpr; StoredResolved, VarTypeResolved: TPasResolverResult; StoredValue, PasValue, IndexValue: TResEvalValue; + aResolver: TPas2JSResolver; begin Result:=nil; + aResolver:=AContext.Resolver; OptionsEl:=nil; try // $r.addProperty @@ -13377,19 +13377,20 @@ begin // add flags Flags:=0; - GetterPas:=AContext.Resolver.GetPasPropertyGetter(Prop); + GetterPas:=aResolver.GetPasPropertyGetter(Prop); if GetterPas is TPasProcedure then inc(Flags,pfGetFunction); - SetterPas:=AContext.Resolver.GetPasPropertySetter(Prop); + SetterPas:=aResolver.GetPasPropertySetter(Prop); if SetterPas is TPasProcedure then inc(Flags,pfSetProcedure); - StoredExpr:=AContext.Resolver.GetPasPropertyStoredExpr(Prop); - IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop); + StoredExpr:=aResolver.GetPasPropertyStoredExpr(Prop); + IndexExpr:=aResolver.GetPasPropertyIndex(Prop); if IndexExpr<>nil then inc(Flags,pfHasIndex); + DefaultExpr:=aResolver.GetPasPropertyDefaultExpr(Prop); if StoredExpr<>nil then begin - AContext.Resolver.ComputeElement(StoredExpr,StoredResolved,[rcNoImplicitProc]); + aResolver.ComputeElement(StoredExpr,StoredResolved,[rcNoImplicitProc]); if StoredResolved.IdentEl is TPasProcedure then // stored inc(Flags,pfStoredFunction) @@ -13399,7 +13400,7 @@ begin begin // could be a const boolean // -> try evaluating const boolean - StoredValue:=AContext.Resolver.Eval(StoredExpr,[]); + StoredValue:=aResolver.Eval(StoredExpr,[]); if StoredValue<>nil then try // stored @@ -13422,8 +13423,8 @@ begin Call.AddArg(CreateLiteralNumber(Prop,Flags)); // add type - VarType:=AContext.Resolver.GetPasPropertyType(Prop); - AContext.Resolver.ComputeElement(VarType,VarTypeResolved,[rcType]); + VarType:=aResolver.GetPasPropertyType(Prop); + aResolver.ComputeElement(VarType,VarTypeResolved,[rcType]); ResultTypeInfo:=CreateTypeInfoRef(VarType,AContext,Prop); if ResultTypeInfo<>nil then Call.AddArg(ResultTypeInfo) @@ -13443,10 +13444,10 @@ begin Call.AddArg(CreateLiteralString(Prop,GetAccessorName(SetterPas))); // add option "index" - IndexExpr:=AContext.Resolver.GetPasPropertyIndex(Prop); + IndexExpr:=aResolver.GetPasPropertyIndex(Prop); if IndexExpr<>nil then begin - IndexValue:=AContext.Resolver.Eval(IndexExpr,[refConst]); + IndexValue:=aResolver.Eval(IndexExpr,[refConst]); try AddOption(FBuiltInNames[pbivnRTTIPropIndex], ConvertConstValue(IndexValue,AContext,Prop)); @@ -13464,13 +13465,13 @@ begin end; // add option "defaultvalue" - if Prop.DefaultExpr<>nil then + if DefaultExpr<>nil then begin - PasValue:=AContext.Resolver.Eval(Prop.DefaultExpr,[refConst],false); + PasValue:=aResolver.Eval(DefaultExpr,[refConst],false); try DefValue:=nil; if VarTypeResolved.BaseType=btSet then - DefValue:=CreateValInit(VarType,Prop.DefaultExpr,Prop.DefaultExpr,AContext); + DefValue:=CreateValInit(VarType,DefaultExpr,DefaultExpr,AContext); if DefValue=nil then DefValue:=ConvertConstValue(PasValue,AContext,Prop); AddOption(FBuiltInNames[pbivnRTTIPropDefault],DefValue); diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 708a277219..6cce148060 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -599,6 +599,7 @@ type Procedure TestRTTI_DefaultValue; Procedure TestRTTI_DefaultValueSet; Procedure TestRTTI_DefaultValueRangeType; + Procedure TestRTTI_DefaultValueInherit; Procedure TestRTTI_Class_Field; Procedure TestRTTI_Class_Method; Procedure TestRTTI_Class_MethodArgFlags; @@ -18787,6 +18788,53 @@ begin ''])); end; +procedure TTestModule.TestRTTI_DefaultValueInherit; +begin + Converter.Options:=Converter.Options-[coNoTypeInfo]; + StartProgram(false); + Add([ + 'type', + ' TObject = class', + ' FA, FB: byte;', + ' property A: byte read FA default 1;', + ' property B: byte read FB default 2;', + ' end;', + ' TBird = class', + ' published', + ' property A;', + ' property B nodefault;', + ' end;', + 'begin']); + ConvertProgram; + CheckSource('TestRTTI_DefaultValueInherit', + LinesToStr([ // statements + 'rtl.createClass($mod, "TObject", null, function () {', + ' this.$init = function () {', + ' this.FA = 0;', + ' this.FB = 0;', + ' };', + ' this.$final = function () {', + ' };', + '});', + 'rtl.createClass($mod, "TBird", $mod.TObject, function () {', + ' var $r = this.$rtti;', + ' $r.addProperty(', + ' "A",', + ' 0,', + ' rtl.byte,', + ' "FA",', + ' "",', + ' {', + ' Default: 1', + ' }', + ' );', + ' $r.addProperty("B", 0, rtl.byte, "FB", "");', + '});', + '']), + LinesToStr([ // $mod.$main + ''])); +end; + procedure TTestModule.TestRTTI_Class_Field; begin Converter.Options:=Converter.Options-[coNoTypeInfo];