pastojs: pasuseanalyzer: mark argument default value expressions

git-svn-id: trunk@37292 -

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -36,9 +36,7 @@ Working:
 - Hint: 'Function result does not seem to be set'
 
 ToDo:
-- record members
-- class members
-- Improve Call Override: e.g. A.Proc, mark only overrides of descendants of A
+- Add test: Call Override: e.g. A.Proc, mark only overrides of descendants of A
 - TPasArgument: compute the effective Access
 - calls: use the effective Access of arguments
 }
@@ -1179,9 +1177,10 @@ begin
   for i:=0 to ProcType.Args.Count-1 do
     begin
     Arg:=TPasArgument(ProcType.Args[i]);
-    // Note: argument are marked when used in code
-    // mark argument type
+    // Note: arguments are marked when used in code
+    // mark argument type and default value
     UseType(Arg.ArgType,paumElement);
+    UseExpr(Arg.ValueExpr);
     end;
   if ProcType is TPasFunctionType then
     UseType(TPasFunctionType(ProcType).ResultEl.ResultType,paumElement);

packages/pastojs/tests/tcmodules.pas

@@ -3579,7 +3579,7 @@ begin
     LinesToStr([
     'if ($mod.c.charCodeAt() in $mod.LowChars) ;',
     'if (97 in $mod.LowChars) ;',
-    'if ($mod.s.charCodeAt(1 - 1) in $mod.LowChars) ;',
+    'if ($mod.s.charCodeAt(0) in $mod.LowChars) ;',
     'if ($mod.c.charCodeAt() in $mod.Chars) ;',
     'if ($mod.c.charCodeAt() in rtl.createSet(null, 97, 122, 95)) ;',
     'if (98 in rtl.createSet(null, 97, 122, 95)) ;',

packages/pastojs/tests/tcoptimizations.pas

@@ -30,7 +30,6 @@ uses
 
 type
 
-
   { TCustomTestOptimizations }
 
   TCustomTestOptimizations = class(TCustomTestModule)
@@ -78,6 +77,7 @@ type
     procedure TestWPO_CallInherited;
     procedure TestWPO_UseUnit;
     procedure TestWPO_ProgramPublicDeclaration;
+    procedure TestWPO_ConstructorDefaultValueConst;
     procedure TestWPO_RTTI_PublishedField;
     procedure TestWPO_RTTI_TypeInfo;
   end;
@@ -776,6 +776,56 @@ begin
   CheckDiff('TestWPO_ProgramPublicDeclaration',ExpectedSrc,ActualSrc);
 end;
 
+procedure TTestOptimizations.TestWPO_ConstructorDefaultValueConst;
+var
+  ActualSrc, ExpectedSrc: String;
+begin
+  Converter.Options:=Converter.Options-[coNoTypeInfo];
+  StartProgram(true);
+  Add([
+  'const gcBlack = 0;',
+  'type',
+  '  TColor = longint;',
+  '  TObject = class',
+  '  private',
+  '    FColor: TColor;',
+  '  public',
+  '    property Color: TColor read FColor write FColor;',
+  '    constructor Create(const AColor: TColor = gcBlack);',
+  '  end;',
+  'constructor TObject.Create(const AColor: TColor = gcBlack);',
+  'begin',
+  '  FColor := AColor;',
+  'end;',
+  'var T: TObject;',
+  'begin',
+  '  T := TObject.Create;',
+  '']);
+  ConvertProgram;
+  ActualSrc:=ConvertJSModuleToString(JSModule);
+  ExpectedSrc:=LinesToStr([
+  'rtl.module("program",["system"],function () {',
+  '  var $mod = this;',
+  '  this.gcBlack = 0;',
+  '  rtl.createClass($mod,"TObject",null,function () {',
+  '    this.$init = function () {',
+  '      this.FColor = 0;',
+  '    };',
+  '    this.$final = function () {',
+  '    };',
+  '    this.Create = function (AColor) {',
+  '      this.FColor = AColor;',
+  '    };',
+  '  });',
+  '  this.T = null;',
+  '  $mod.$main = function () {',
+  '    $mod.T = $mod.TObject.$create("Create",[$mod.gcBlack]);',
+  '  };',
+  '});',
+  '']);
+  CheckDiff('TestWPO_ConstructorDefaultValueConst',ExpectedSrc,ActualSrc);
+end;
+
 procedure TTestOptimizations.TestWPO_RTTI_PublishedField;
 var
   ActualSrc, ExpectedSrc: String;