Browse Source

pastojs: fixed empty record

git-svn-id: trunk@38510 -
Mattias Gaertner 7 years ago
parent
commit
1ae01bd41c

+ 10 - 8
packages/pastojs/src/fppas2js.pp

@@ -14093,7 +14093,8 @@ const
       // create 'this.A = s.A;'
       // create 'this.A = s.A;'
       VarAssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PasVar));
       VarAssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,PasVar));
       AddToStatementList(First,Last,VarAssignSt,PasVar);
       AddToStatementList(First,Last,VarAssignSt,PasVar);
-      if i=0 then IfSt.BTrue:=First;
+      if IfSt.BTrue=nil then
+        IfSt.BTrue:=First;
       VarAssignSt.LHS:=CreateSubDeclNameExpr(PasVar,PasVar.Name,FuncContext);
       VarAssignSt.LHS:=CreateSubDeclNameExpr(PasVar,PasVar.Name,FuncContext);
       VarDotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,PasVar));
       VarDotExpr:=TJSDotMemberExpression(CreateElement(TJSDotMemberExpression,PasVar));
       VarAssignSt.Expr:=VarDotExpr;
       VarAssignSt.Expr:=VarDotExpr;
@@ -14255,6 +14256,8 @@ const
         EqExpr.B:=CreateMemberExpression([EqualParamName,VarName]);
         EqExpr.B:=CreateMemberExpression([EqualParamName,VarName]);
         end;
         end;
       end;
       end;
+    if RetSt.Expr=nil then
+      RetSt.Expr:=CreateLiteralBoolean(El,true);
   end;
   end;
 
 
   procedure AddRTTIFields(Args: TJSArguments; var First, Last: TJSStatementList);
   procedure AddRTTIFields(Args: TJSArguments; var First, Last: TJSStatementList);
@@ -14320,11 +14323,10 @@ begin
     FuncContext:=TFunctionContext.Create(El,FD.Body,AContext);
     FuncContext:=TFunctionContext.Create(El,FD.Body,AContext);
     FuncContext.ThisPas:=El;
     FuncContext.ThisPas:=El;
     FuncContext.IsGlobal:=true;
     FuncContext.IsGlobal:=true;
+    BodyFirst:=nil;
+    BodyLast:=nil;
     if El.Members.Count>0 then
     if El.Members.Count>0 then
       begin
       begin
-      BodyFirst:=nil;
-      BodyLast:=nil;
-
       // add if(s)
       // add if(s)
       IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
       IfSt:=TJSIfStatement(CreateElement(TJSIfStatement,El));
       AddToStatementList(BodyFirst,BodyLast,IfSt,El);
       AddToStatementList(BodyFirst,BodyLast,IfSt,El);
@@ -14334,11 +14336,11 @@ begin
       AddCloneStatements(IfSt,FuncContext);
       AddCloneStatements(IfSt,FuncContext);
       // add init default statements
       // add init default statements
       AddInitDefaultStatements(IfSt,FuncContext);
       AddInitDefaultStatements(IfSt,FuncContext);
-
-      // add equal function
-      AddEqualFunction(BodyFirst,BodyLast,FuncContext);
-
       end;
       end;
+    // add equal function
+    AddEqualFunction(BodyFirst,BodyLast,FuncContext);
+    if FD.Body.A=nil then
+      FD.Body.A:=BodyFirst;
 
 
     if HasTypeInfo(El,AContext) then
     if HasTypeInfo(El,AContext) then
       begin
       begin

+ 3 - 3
packages/pastojs/src/pas2jsfiler.pp

@@ -33,12 +33,12 @@ Works:
 - store/restore/use precompiled JS of proc local const
 - store/restore/use precompiled JS of proc local const
 - store/restore/use precompiled JS of initialization plus references
 - store/restore/use precompiled JS of initialization plus references
 - useanalyzer: generate + use initialization/finalization references
 - useanalyzer: generate + use initialization/finalization references
-
-ToDo:
-- WPO uses Proc.References
 - uses section
 - uses section
 - external references
 - external references
 - stop after uses section and continue reading
 - stop after uses section and continue reading
+
+ToDo:
+- WPO uses Proc.References
 - gzipped json
 - gzipped json
 
 
 }
 }

+ 32 - 0
packages/pastojs/tests/tcmodules.pas

@@ -350,6 +350,7 @@ type
     Procedure TestExternalClass_TypeCastArrayFromExternalArray;
     Procedure TestExternalClass_TypeCastArrayFromExternalArray;
 
 
     // record
     // record
+    Procedure TestRecord_Empty;
     Procedure TestRecord_Var;
     Procedure TestRecord_Var;
     Procedure TestWithRecordDo;
     Procedure TestWithRecordDo;
     Procedure TestRecord_Assign;
     Procedure TestRecord_Assign;
@@ -6968,6 +6969,31 @@ begin
     '']));
     '']));
 end;
 end;
 
 
+procedure TTestModule.TestRecord_Empty;
+begin
+  StartProgram(false);
+  Add(['type',
+  '  TRecA = record',
+  '  end;',
+  'var a,b: TRecA;',
+  'begin',
+  '  if a=b then ;']);
+  ConvertProgram;
+  CheckSource('TestRecord_Empty',
+    LinesToStr([ // statements
+    'this.TRecA = function (s) {',
+    '  this.$equal = function (b) {',
+    '    return true;',
+    '  };',
+    '};',
+    'this.a = new $mod.TRecA();',
+    'this.b = new $mod.TRecA();'
+    ]),
+    LinesToStr([ // $mod.$main
+    'if ($mod.a.$equal($mod.b)) ;'
+    ]));
+end;
+
 procedure TTestModule.TestRecord_Var;
 procedure TTestModule.TestRecord_Var;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -12184,6 +12210,9 @@ begin
   CheckSource('TestClassInterface_Ignore',
   CheckSource('TestClassInterface_Ignore',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'this.TGUID = function (s) {',
     'this.TGUID = function (s) {',
+    '  this.$equal = function (b) {',
+    '    return true;',
+    '  };',
     '};',
     '};',
     'rtl.createClass($mod, "TObject", null, function () {',
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.$init = function () {',
     '  this.$init = function () {',
@@ -16403,6 +16432,9 @@ begin
   CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
   CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses3',
     LinesToStr([ // statements
     LinesToStr([ // statements
     'this.TRec = function (s) {',
     'this.TRec = function (s) {',
+    '  this.$equal = function (b) {',
+    '    return true;',
+    '  };',
     '};',
     '};',
     '$mod.$rtti.$Record("TRec", {});',
     '$mod.$rtti.$Record("TRec", {});',
     'rtl.createClass($mod, "TObject", null, function () {',
     'rtl.createClass($mod, "TObject", null, function () {',