Browse Source

pastojs: property default value of set type

git-svn-id: trunk@37319 -
Mattias Gaertner 7 years ago
parent
commit
16582e5a37
2 changed files with 121 additions and 19 deletions
  1. 18 13
      packages/pastojs/src/fppas2js.pp
  2. 103 6
      packages/pastojs/tests/tcmodules.pas

+ 18 - 13
packages/pastojs/src/fppas2js.pp

@@ -241,6 +241,8 @@ Works:
     - typeinfo(class) -> class.$rtti
     - typeinfo(class) -> class.$rtti
   - WPO skip not used typeinfo
   - WPO skip not used typeinfo
   - open array param
   - open array param
+  - property stored modifier
+  - property default value
 - pointer
 - pointer
   - compare with and assign nil
   - compare with and assign nil
 - ECMAScript6:
 - ECMAScript6:
@@ -256,9 +258,7 @@ ToDos:
   - RTTI
   - RTTI
 - property index specifier
 - property index specifier
 - RTTI
 - RTTI
-  - stored false/true
   - class property
   - class property
-    - defaultvalue
   - type alias type
   - type alias type
   - documentation
   - documentation
 - move local types to unit scope
 - move local types to unit scope
@@ -9703,11 +9703,11 @@ var
   PropName: String;
   PropName: String;
   Flags: Integer;
   Flags: Integer;
   GetterPas, SetterPas, DeclEl: TPasElement;
   GetterPas, SetterPas, DeclEl: TPasElement;
-  ResultTypeInfo: TJSElement;
+  ResultTypeInfo, DefValue: TJSElement;
   VarType: TPasType;
   VarType: TPasType;
   StoredExpr: TPasExpr;
   StoredExpr: TPasExpr;
-  StoredResolved: TPasResolverResult;
-  StoredValue, Value: TResEvalValue;
+  StoredResolved, VarTypeResolved: TPasResolverResult;
+  StoredValue, PasValue: TResEvalValue;
 begin
 begin
   Result:=nil;
   Result:=nil;
   OptionsEl:=nil;
   OptionsEl:=nil;
@@ -9763,8 +9763,9 @@ begin
       end;
       end;
     Call.AddArg(CreateLiteralNumber(Prop,Flags));
     Call.AddArg(CreateLiteralNumber(Prop,Flags));
 
 
-    // add resulttype
+    // add type
     VarType:=AContext.Resolver.GetPasPropertyType(Prop);
     VarType:=AContext.Resolver.GetPasPropertyType(Prop);
+    AContext.Resolver.ComputeElement(VarType,VarTypeResolved,[rcType]);
     ResultTypeInfo:=CreateTypeInfoRef(VarType,AContext,Prop);
     ResultTypeInfo:=CreateTypeInfoRef(VarType,AContext,Prop);
     if ResultTypeInfo<>nil then
     if ResultTypeInfo<>nil then
       Call.AddArg(ResultTypeInfo)
       Call.AddArg(ResultTypeInfo)
@@ -9794,18 +9795,21 @@ begin
     // add option "defaultvalue"
     // add option "defaultvalue"
     if Prop.DefaultExpr<>nil then
     if Prop.DefaultExpr<>nil then
       begin
       begin
-      Value:=AContext.Resolver.Eval(Prop.DefaultExpr,[refConst],false);
+      PasValue:=AContext.Resolver.Eval(Prop.DefaultExpr,[refConst],false);
       try
       try
-        AddOption(FBuiltInNames[pbivnRTTIPropDefault],
-          ConvertConstValue(Value,AContext,Prop));
+        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);
       finally
       finally
-        ReleaseEvalValue(Value);
+        ReleaseEvalValue(PasValue);
       end;
       end;
       end;
       end;
 
 
-    // add option Index
-    // ToDo
-
     Result:=Call;
     Result:=Call;
   finally
   finally
     if Result=nil then
     if Result=nil then
@@ -9919,6 +9923,7 @@ begin
   if El.DispIDExpr<>nil then
   if El.DispIDExpr<>nil then
     RaiseNotSupported(El.DispIDExpr,AContext,20170215103029,'property dispid expression');
     RaiseNotSupported(El.DispIDExpr,AContext,20170215103029,'property dispid expression');
   // does not need any declaration. Access is redirected to getter/setter.
   // does not need any declaration. Access is redirected to getter/setter.
+  // RTTI is created in CreateRTTIClassProperty
 end;
 end;
 
 
 function TPasToJSConverter.ConvertExportSymbol(El: TPasExportSymbol;
 function TPasToJSConverter.ConvertExportSymbol(El: TPasExportSymbol;

+ 103 - 6
packages/pastojs/tests/tcmodules.pas

@@ -323,9 +323,6 @@ type
     Procedure TestArray_DynArrayConst;
     Procedure TestArray_DynArrayConst;
     Procedure TestExternalClass_TypeCastArrayToExternalArray;
     Procedure TestExternalClass_TypeCastArrayToExternalArray;
     Procedure TestExternalClass_TypeCastArrayFromExternalArray;
     Procedure TestExternalClass_TypeCastArrayFromExternalArray;
-    // ToDo: static array const
-    // ToDo: SetLength(array of static array)
-    // ToDo: SetLength(dim1,dim2)
 
 
     // record
     // record
     Procedure TestRecord_Var;
     Procedure TestRecord_Var;
@@ -504,6 +501,7 @@ type
     Procedure TestRTTI_PublishedFieldExternalFail;
     Procedure TestRTTI_PublishedFieldExternalFail;
     Procedure TestRTTI_StoredModifier;
     Procedure TestRTTI_StoredModifier;
     Procedure TestRTTI_DefaultValue;
     Procedure TestRTTI_DefaultValue;
+    Procedure TestRTTI_DefaultValueSet;
     Procedure TestRTTI_Class_Field;
     Procedure TestRTTI_Class_Field;
     Procedure TestRTTI_Class_Method;
     Procedure TestRTTI_Class_Method;
     Procedure TestRTTI_Class_MethodArgFlags;
     Procedure TestRTTI_Class_MethodArgFlags;
@@ -13377,13 +13375,15 @@ end;
 
 
 procedure TTestModule.TestRTTI_DefaultValue;
 procedure TTestModule.TestRTTI_DefaultValue;
 begin
 begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
   StartProgram(false);
   StartProgram(false);
   Add([
   Add([
+  'type',
+  '  TEnum = (red, blue);',
   'const',
   'const',
   '  CB = true or false;',
   '  CB = true or false;',
   '  CI = 1+2;',
   '  CI = 1+2;',
   'type',
   'type',
-  '  TEnum = (red, blue);',
   '  TObject = class',
   '  TObject = class',
   '    FB: boolean;',
   '    FB: boolean;',
   '    FI: longint;',
   '    FI: longint;',
@@ -13401,14 +13401,19 @@ begin
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestRTTI_DefaultValue',
   CheckSource('TestRTTI_DefaultValue',
     LinesToStr([ // statements
     LinesToStr([ // statements
-    'this.CB = true || false;',
-    'this.CI = 1 + 2;',
     'this.TEnum = {',
     'this.TEnum = {',
     '  "0": "red",',
     '  "0": "red",',
     '  red: 0,',
     '  red: 0,',
     '  "1": "blue",',
     '  "1": "blue",',
     '  blue: 1',
     '  blue: 1',
     '};',
     '};',
+    '$mod.$rtti.$Enum("TEnum", {',
+    '  minvalue: 0,',
+    '  maxvalue: 1,',
+    '  enumtype: this.TEnum',
+    '});',
+    'this.CB = true || false;',
+    'this.CI = 1 + 2;',
     'rtl.createClass($mod, "TObject", null, function () {',
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  this.$init = function () {',
     '    this.FB = false;',
     '    this.FB = false;',
@@ -13494,6 +13499,98 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestRTTI_DefaultValueSet;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(false);
+  Add([
+  'type',
+  '  TEnum = (red, blue);',
+  '  TSet = set of TEnum;',
+  'const',
+  '  CSet = [red,blue];',
+  'type',
+  '  TObject = class',
+  '    FSet: TSet;',
+  '  published',
+  '    property Set1: TSet read FSet default [];',
+  '    property Set2: TSet read FSet default [red];',
+  '    property Set3: TSet read FSet default [red,blue];',
+  '    property Set4: TSet read FSet default CSet;',
+  '  end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestRTTI_DefaultValueSet',
+    LinesToStr([ // statements
+    'this.TEnum = {',
+    '  "0": "red",',
+    '  red: 0,',
+    '  "1": "blue",',
+    '  blue: 1',
+    '};',
+    '$mod.$rtti.$Enum("TEnum", {',
+    '  minvalue: 0,',
+    '  maxvalue: 1,',
+    '  enumtype: this.TEnum',
+    '});',
+    '$mod.$rtti.$Set("TSet", {',
+    '  comptype: $mod.$rtti["TEnum"]',
+    '});',
+    'this.CSet = rtl.createSet($mod.TEnum.red, $mod.TEnum.blue);',
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '    this.FSet = {};',
+    '  };',
+    '  this.$final = function () {',
+    '    this.FSet = undefined;',
+    '  };',
+    '  var $r = this.$rtti;',
+    '  $r.addProperty(',
+    '    "Set1",',
+    '    0,',
+    '    $mod.$rtti["TSet"],',
+    '    "FSet",',
+    '    "",',
+    '    {',
+    '      Default: {}',
+    '    }',
+    '  );',
+    '  $r.addProperty(',
+    '    "Set2",',
+    '    0,',
+    '    $mod.$rtti["TSet"],',
+    '    "FSet",',
+    '    "",',
+    '    {',
+    '      Default: rtl.createSet($mod.TEnum.red)',
+    '    }',
+    '  );',
+    '  $r.addProperty(',
+    '    "Set3",',
+    '    0,',
+    '    $mod.$rtti["TSet"],',
+    '    "FSet",',
+    '    "",',
+    '    {',
+    '      Default: rtl.createSet($mod.TEnum.red, $mod.TEnum.blue)',
+    '    }',
+    '  );',
+    '  $r.addProperty(',
+    '    "Set4",',
+    '    0,',
+    '    $mod.$rtti["TSet"],',
+    '    "FSet",',
+    '    "",',
+    '    {',
+    '      Default: $mod.CSet',
+    '    }',
+    '  );',
+    '});',
+    '']),
+    LinesToStr([ // $mod.$main
+    '']));
+end;
+
 procedure TTestModule.TestRTTI_Class_Field;
 procedure TTestModule.TestRTTI_Class_Field;
 begin
 begin
   Converter.Options:=Converter.Options-[coNoTypeInfo];
   Converter.Options:=Converter.Options-[coNoTypeInfo];