pastojs: external class const

git-svn-id: trunk@38077 -

packages/pastojs/src/fppas2js.pp

@@ -2275,12 +2275,14 @@ begin
     RaiseVarModifierNotSupported(ClassFieldModifiersAllowed);
     if TPasClassType(El.Parent).IsExternal then
       begin
-      // external class -> make variable external
-      if El.Expr<>nil then
-        RaiseMsg(20180127111830,nIllegalQualifier,sIllegalQualifier,
-          ['='],El.Expr);
+      // external class
+      if El.Visibility=visPublished then
+        // Note: an external class has no typeinfo
+        RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished,
+          [],El);
       if not (vmExternal in El.VarModifiers) then
         begin
+        // make variable external
         if (El.ClassType=TPasVariable) or (El.ClassType=TPasConst) then
           begin
           if El.ExportName<>nil then
@@ -2290,10 +2292,9 @@ begin
           end;
         Include(El.VarModifiers,vmExternal);
         end;
-      if El.Visibility=visPublished then
-        // Note: an external class has no typeinfo
-        RaiseMsg(20170413221516,nSymbolCannotBePublished,sSymbolCannotBePublished,
-          [],El);
+      if (El.ClassType=TPasConst) and (TPasConst(El).Expr<>nil) then
+        // external const with expression is not writable
+        TPasConst(El).IsConst:=true;
       end;
     end
   else if ParentC=TPasRecordType then
@@ -4970,6 +4971,27 @@ begin
     Result:=CreateArgumentAccess(TPasArgument(Decl),AContext,El);
     exit;
     end
+  else if Decl.ClassType=TPasConst then
+    begin
+    if TPasConst(Decl).IsConst and (TPasConst(Decl).Expr<>nil) then
+      begin
+      Value:=AContext.Resolver.Eval(TPasConst(Decl).Expr,[refConst]);
+      if (Value<>nil)
+          and (Value.Kind in [revkNil,revkBool,revkInt,revkUInt,revkFloat,revkEnum]) then
+        try
+          Result:=ConvertConstValue(Value,AContext,El);
+          exit;
+        finally
+          ReleaseEvalValue(Value);
+        end;
+      if vmExternal in TPasConst(Decl).VarModifiers then
+        begin
+        // external constant are always added by value, not by reference
+        Result:=ConvertElement(TPasConst(Decl).Expr,AContext);
+        exit;
+        end;
+      end;
+    end
   else if Decl.ClassType=TPasResString then
     begin
     // read resourcestring -> rtl.getResStr($mod,"name")
@@ -9758,6 +9780,11 @@ end;
 
 function TPasToJSConverter.ConvertConstValue(Value: TResEvalValue;
   AContext: TConvertContext; El: TPasElement): TJSElement;
+var
+  Ranges: TResEvalSet.TItems;
+  Range: TResEvalSet.TItem;
+  Call: TJSCallExpression;
+  i: Integer;
 begin
   Result:=nil;
   if Value=nil then
@@ -9783,7 +9810,35 @@ begin
       {$IFDEF VerbosePas2JS}
       writeln('TPasToJSConverter.ConvertConstValue Value=',Value.AsDebugString,' IdentEl=',GetObjName(Value.IdentEl));
       {$ENDIF}
-      RaiseNotSupported(El,AContext,20171221125842);
+      // rtl.createSet()
+      Call:=CreateCallExpression(El);
+      try
+        Call.Expr:=CreateMemberExpression([FBuiltInNames[pbivnRTL],FBuiltInNames[pbifnSet_Create]]);
+        Ranges:=TResEvalSet(Value).Ranges;
+        for i:=0 to length(Ranges)-1 do
+          begin
+          Range:=Ranges[i];
+          {$IFDEF VerbosePas2JS}
+          writeln('TPasToJSConverter.ConvertConstValue SetLiteral ',i,' ',Range.RangeStart,'..',Range.RangeEnd);
+          {$ENDIF}
+          if Range.RangeStart=Range.RangeEnd then
+            begin
+            // add one integer
+            Call.AddArg(CreateLiteralNumber(El,Range.RangeStart));
+            end
+          else
+            begin
+            // range -> add three parameters: null,left,right
+            Call.AddArg(CreateLiteralNull(El));
+            Call.AddArg(CreateLiteralNumber(El,Range.RangeStart));
+            Call.AddArg(CreateLiteralNumber(El,Range.RangeEnd));
+            end;
+          end;
+        Result:=Call;
+      finally
+        if Result=nil then
+          Call.Free;
+      end;
       end
   else
     {$IFDEF VerbosePas2JS}

packages/pastojs/src/pas2jspparser.pp

@@ -109,7 +109,7 @@ constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;
   AFileResolver: TBaseFileResolver; AEngine: TPasTreeContainer);
 begin
   inherited Create(AScanner,AFileResolver,AEngine);
-  Options:=Options+[po_asmwhole,po_resolvestandardtypes];
+  Options:=Options+[po_AsmWhole,po_ResolveStandardTypes,po_ExtClassConstWithoutExpr];
 end;
 
 procedure TPas2jsPasParser.SetLastMsg(MsgType: TMessageType;

packages/pastojs/tests/tcmodules.pas

@@ -31,7 +31,7 @@ uses
 
 const
   // default parser+scanner options
-  po_pas2js = [po_asmwhole,po_resolvestandardtypes];
+  po_pas2js = [po_asmwhole,po_resolvestandardtypes,po_ExtClassConstWithoutExpr];
   co_tcmodules = [coNoTypeInfo];
 type
 
@@ -427,7 +427,7 @@ type
 
     // external class
     Procedure TestExternalClass_Var;
-    Procedure TestExternalClass_ConstFail;
+    Procedure TestExternalClass_Const;
     Procedure TestExternalClass_Dollar;
     Procedure TestExternalClass_DuplicateVarFail;
     Procedure TestExternalClass_Method;
@@ -3144,10 +3144,10 @@ begin
   CheckSource('TestProc_ConstOrder',
     LinesToStr([ // statements
     'this.A = 3;',
-    'this.B = $mod.A + 1;',
-    'var C = $mod.A + 1;',
-    'var D = $mod.B + 1;',
-    'var E = ((D + C) + $mod.B) + $mod.A;',
+    'this.B = 3 + 1;',
+    'var C = 3 + 1;',
+    'var D = 4 + 1;',
+    'var E = ((5 + 4) + 4) + 3;',
     'this.DoIt = function () {',
     '};',
     '']),
@@ -3933,10 +3933,10 @@ begin
     'this.Enums = {};',
     '']),
     LinesToStr([
-    '$mod.Enums = rtl.includeSet($mod.Enums, $mod.Orange);',
-    '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.Orange);',
-    'if ($mod.Orange in $mod.Enums) ;',
-    'if ($mod.Orange in rtl.createSet($mod.Orange, $mod.TEnum.Red)) ;',
+    '$mod.Enums = rtl.includeSet($mod.Enums, $mod.TEnum.Red);',
+    '$mod.Enums = rtl.excludeSet($mod.Enums, $mod.TEnum.Red);',
+    'if ($mod.TEnum.Red in $mod.Enums) ;',
+    'if ($mod.TEnum.Red in rtl.createSet($mod.TEnum.Red, $mod.TEnum.Red)) ;',
     '']));
 end;
 
@@ -3977,16 +3977,16 @@ begin
     '']),
     LinesToStr([
     '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
-    '$mod.f = rtl.includeSet($mod.f, $mod.favorite);',
+    '$mod.f = rtl.includeSet($mod.f, $mod.TFlags$a.red);',
+    '$mod.i = $mod.TFlags$a.red;',
     '$mod.i = $mod.TFlags$a.red;',
-    '$mod.i = $mod.favorite;',
     '$mod.i = $mod.TFlags$a.red;',
     '$mod.i = $mod.TFlags$a.red;',
     '$mod.i = $mod.TFlags$a.red;',
     '$mod.i = $mod.TFlags$a.green;',
     '$mod.i = $mod.TFlags$a.green;',
     '$mod.i = $mod.TFlags$a.green;',
-    '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.favorite);',
+    '$mod.f = rtl.createSet($mod.TFlags$a.green, $mod.TFlags$a.red);',
     '']));
 end;
 
@@ -4301,10 +4301,10 @@ begin
     'var cB$1 = 4;',
     'this.DoIt = function () {',
     '  function Sub() {',
-    '    cB$1 = cB$1 + csA;',
-    '    cA = (cA + csA) + 5;',
+    '    cB$1 = cB$1 + 3;',
+    '    cA = (cA + 3) + 5;',
     '  };',
-    '  cA = (cA + cB) + 6;',
+    '  cA = (cA + 2) + 6;',
     '};'
     ]),
     LinesToStr([
@@ -10480,18 +10480,47 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestExternalClass_ConstFail;
+procedure TTestModule.TestExternalClass_Const;
 begin
   StartProgram(false);
   Add([
   '{$modeswitch externalclass}',
   'type',
   '  TExtA = class external name ''ExtObj''',
-  '    const Id: longint = 3;',
+  '    const Two: longint = 2;',
+  '    const Three = 3;',
+  '    const Id: longint;',
   '  end;',
-  'begin']);
-  SetExpectedPasResolverError('illegal qualifier "="',nIllegalQualifier);
+  '  TExtB = class external name ''ExtB''',
+  '    A: TExtA;',
+  '  end;',
+  'var',
+  '  A: texta;',
+  '  B: textb;',
+  '  i: longint;',
+  'begin',
+  '  i:=a.two;',
+  '  i:=texta.two;',
+  '  i:=a.three;',
+  '  i:=texta.three;',
+  '  i:=a.id;',
+  '  i:=texta.id;',
+  '']);
   ConvertProgram;
+  CheckSource('TestExternalClass_Dollar',
+    LinesToStr([ // statements
+    'this.A = null;',
+    'this.B = null;',
+    'this.i = 0;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.i = 2;',
+    '$mod.i = 2;',
+    '$mod.i = 3;',
+    '$mod.i = 3;',
+    '$mod.i = $mod.A.Id;',
+    '$mod.i = ExtObj.Id;',
+    '']));
 end;
 
 procedure TTestModule.TestExternalClass_Dollar;
@@ -11111,7 +11140,7 @@ begin
   Add('    constructor New;');
   Add('  end;');
   Add('function DoIt: longint;');
-  Add('const ExtA = 3;');
+  Add('const ExtA: longint = 3;');
   Add('begin');
   Add('  Result:=ExtA;');
   Add('end;');

packages/pastojs/tests/tcoptimizations.pas

@@ -264,7 +264,7 @@ begin
     'var d = 6;',
     'this.DoIt = function () {',
     '  var Result = 0;',
-    '  Result = b + d;',
+    '  Result = 4 + d;',
     '  return Result;',
     '};',
     '']),
@@ -819,7 +819,7 @@ begin
   '  });',
   '  this.T = null;',
   '  $mod.$main = function () {',
-  '    $mod.T = $mod.TObject.$create("Create",[$mod.gcBlack]);',
+  '    $mod.T = $mod.TObject.$create("Create",[0]);',
   '  };',
   '});',
   '']);