Browse Source

fppas2js: fixed compilation, due to changes in resolver

git-svn-id: trunk@35828 -
Mattias Gaertner 8 years ago
parent
commit
1b07db5a08
2 changed files with 61 additions and 20 deletions
  1. 48 9
      packages/pastojs/src/fppas2js.pp
  2. 13 11
      packages/pastojs/tests/tcmodules.pas

+ 48 - 9
packages/pastojs/src/fppas2js.pp

@@ -238,7 +238,6 @@ Works:
   - use 0o for octal literals
 
 ToDos:
-- typecast proctype
 - RTTI
   - open array param
   - codetools function typeinfo
@@ -266,6 +265,7 @@ ToDos:
 - asm: pas() - useful for overloads and protect an identifier from optimization
 - source maps
 - ifthen
+- stdcall ->  add 'this' as first param, rtl.createCallbackStd, cannot be called from Pascal
 
 Not in Version 1.0:
 - write, writeln
@@ -550,7 +550,7 @@ const
     'tTypeInfoStaticArray'
     );
 
-  JSReservedWords: array[0..108] of string = (
+  JSReservedWords: array[0..113] of string = (
      // keep sorted, first uppercase, then lowercase !
      'Array',
      'ArrayBuffer',
@@ -627,6 +627,7 @@ const
      'for',
      'function',
      'getPrototypeOf',
+     'hasOwnProperty',
      'if',
      'implements',
      'import',
@@ -643,6 +644,7 @@ const
      'parseFloat',
      'parseInt',
      'private',
+     'propertyIsEnumerable',
      'protected',
      'prototype',
      'public',
@@ -652,11 +654,14 @@ const
      'switch',
      'this',
      'throw',
+     'toLocaleString',
+     'toString',
      'true',
      'try',
      'undefined',
      'unescape',
      'uneval',
+     'valueOf',
      'var',
      'while',
      'with',
@@ -765,7 +770,6 @@ const
     btWord,
     btSmallInt,
     btLongWord,
-    btCardinal,
     btLongint,
     //btQWord,
     btInt64,
@@ -902,6 +906,8 @@ type
     function CreateLocalIdentifier(const Prefix: string): string;
     function CurrentModeswitches: TModeSwitches;
     function GetSingletonFunc: TFunctionContext;
+    procedure WriteStack;
+    function ToString: ansistring; override;
   end;
 
   { TRootContext }
@@ -917,6 +923,7 @@ type
   public
     This: TPasElement;
     constructor Create(PasEl: TPasElement; JSEl: TJSElement; aParent: TConvertContext); override;
+    function ToString: ansistring; override;
   end;
 
   { TObjectContext }
@@ -1296,7 +1303,7 @@ var
     'completion'
     );
 
-function CodePointToJSString(u: cardinal): TJSString;
+function CodePointToJSString(u: longword): TJSString;
 function PosLast(c: char; const s: string): integer;
 
 implementation
@@ -1306,7 +1313,7 @@ const
   TempRefObjSetterName = 'set';
   TempRefObjSetterArgName = 'v';
 
-function CodePointToJSString(u: cardinal): TJSString;
+function CodePointToJSString(u: longword): TJSString;
 begin
   if u < $10000 then
     // Note: codepoints $D800 - $DFFF are reserved
@@ -2502,6 +2509,8 @@ begin
   for bt in [pbtJSValue] do
     AddJSBaseType(Pas2jsBaseTypeNames[bt],bt);
   AnonymousElTypePostfix:=Pas2JSBuiltInNames[pbitnAnonymousPostfix];
+  BaseTypeChar:=btWideChar;
+  BaseTypeString:=btUnicodeString;
 end;
 
 destructor TPas2JSResolver.Destroy;
@@ -2987,6 +2996,11 @@ begin
   Kind:=cjkFunction;
 end;
 
+function TFunctionContext.ToString: ansistring;
+begin
+  Result:=inherited ToString+' This='+GetObjName(This);
+end;
+
 { TRootContext }
 
 constructor TRootContext.Create(PasEl: TPasElement; JSEl: TJSElement;
@@ -3082,6 +3096,28 @@ begin
     end;
 end;
 
+procedure TConvertContext.WriteStack;
+
+  procedure W(Index: integer; AContext: TConvertContext);
+  begin
+    writeln('  ',Index,' ',AContext.ToString);
+    if AContext.Parent<>nil then
+      W(Index+1,AContext.Parent);
+  end;
+
+begin
+  writeln('TConvertContext.WriteStack: ');
+  W(1,Self);
+end;
+
+function TConvertContext.ToString: ansistring;
+begin
+  Result:='['+ClassName+']'
+    +' pas='+GetObjName(PasElement)
+    +' js='+GetObjName(JSElement)
+    +' Singleton='+BoolToStr(IsSingleton,true);
+end;
+
 { TPasToJSConverter }
 
 // inline
@@ -3597,12 +3633,12 @@ begin
     MinValue:=-$80000000;
     MaxValue:=$7fffffff;
     end
-  else if RangeResolved.BaseType=btCardinal then
+  else if RangeResolved.BaseType=btLongWord then
     begin
     MinValue:=0;
     MaxValue:=$ffffffff;
     end
-  else if RangeResolved.BaseType in [btChar,btWideChar] then
+  else if RangeResolved.BaseType in btAllChars then
     begin
     MinValue:=0;
     MaxValue:=$ffff;
@@ -6012,6 +6048,7 @@ begin
         end;
       end;
     btChar,
+    btAnsiChar,
     btWideChar:
       begin
       Result:=CreateLiteralJSString(El,#0);
@@ -8503,7 +8540,7 @@ begin
       begin
       bt:=TResElDataBaseType(El.CustomData).BaseType;
       case bt of
-      btLongint,btCardinal,btSmallInt,btWord,btShortInt,btByte,
+      btLongint,btLongWord,btSmallInt,btWord,btShortInt,btByte,
       btString,btChar,
       btDouble,
       btBoolean,
@@ -10166,7 +10203,8 @@ var
   ProcScope: TPasProcedureScope;
 begin
   Result:='';
-  //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext));
+  //writeln('TPasToJSConverter.CreateReferencePath START El=',GetObjName(El),' Parent=',GetObjName(El.Parent),' Context=',GetObjName(AContext),' ',GetObjName(AContext.GetThis));
+  //AContext.WriteStack;
 
   if AContext is TDotContext then
     begin
@@ -10224,6 +10262,7 @@ begin
     end
   else if (El.ClassType=TPasClassType) and TPasClassType(El).IsExternal then
     begin
+    // an external var -> use the literal
     Result:=TPasClassType(El).ExternalName;
     exit;
     end

+ 13 - 11
packages/pastojs/tests/tcmodules.pas

@@ -1877,6 +1877,7 @@ end;
 procedure TTestModule.TestNestedProc;
 begin
   StartProgram(false);
+  Add('var vInUnit: longint;');
   Add('function DoIt(pA,pD: longint): longint;');
   Add('var');
   Add('  vB: longint;');
@@ -1884,7 +1885,7 @@ begin
   Add('  function Nesty(pA: longint): longint; ');
   Add('  var vB: longint;');
   Add('  begin');
-  Add('    Result:=pa+vb+vc+pd;');
+  Add('    Result:=pa+vb+vc+pd+vInUnit;');
   Add('  end;');
   Add('begin');
   Add('  Result:=pa+vb+vc;');
@@ -1893,6 +1894,7 @@ begin
   ConvertProgram;
   CheckSource('TestNestedProc',
     LinesToStr([ // statements
+    'this.vInUnit = 0;',
     'this.DoIt = function (pA, pD) {',
     '  var Result = 0;',
     '  var vB = 0;',
@@ -1900,7 +1902,7 @@ begin
     '  function Nesty(pA) {',
     '    var Result = 0;',
     '    var vB = 0;',
-    '    Result = ((pA + vB) + vC) + pD;',
+    '    Result = (((pA + vB) + vC) + pD) + this.vInUnit;',
     '    return Result;',
     '  };',
     '  Result = (pA + vB) + vC;',
@@ -11267,7 +11269,7 @@ begin
   Add('    VarS: string;');
   Add('    VarD: double;');
   Add('    VarB: boolean;');
-  Add('    VarCa: cardinal;');
+  Add('    VarLW: longword;');
   Add('    VarSmI: smallint;');
   Add('    VarW: word;');
   Add('    VarShI: shortint;');
@@ -11291,7 +11293,7 @@ begin
     '    this.VarS = "";',
     '    this.VarD = 0.0;',
     '    this.VarB = false;',
-    '    this.VarCa = 0;',
+    '    this.VarLW = 0;',
     '    this.VarSmI = 0;',
     '    this.VarW = 0;',
     '    this.VarShI = 0;',
@@ -11305,7 +11307,7 @@ begin
     '  $r.addField("VarS", rtl.string);',
     '  $r.addField("VarD", rtl.double);',
     '  $r.addField("VarB", rtl.boolean);',
-    '  $r.addField("VarCa", rtl.cardinal);',
+    '  $r.addField("VarLW", rtl.longword);',
     '  $r.addField("VarSmI", rtl.smallint);',
     '  $r.addField("VarW", rtl.word);',
     '  $r.addField("VarShI", rtl.shortint);',
@@ -11747,7 +11749,7 @@ begin
   Add('  TSmallInt = smallint;');
   Add('  TWord = word;');
   Add('  TInt32 = longint;');
-  Add('  TDWord = cardinal;');
+  Add('  TDWord = longword;');
   Add('  TValue = jsvalue;');
   Add('var p: TPtr;');
   Add('begin');
@@ -11769,7 +11771,7 @@ begin
   Add('  p:=typeinfo(tsmallint);');
   Add('  p:=typeinfo(word);');
   Add('  p:=typeinfo(tword);');
-  Add('  p:=typeinfo(cardinal);');
+  Add('  p:=typeinfo(longword);');
   Add('  p:=typeinfo(tdword);');
   Add('  p:=typeinfo(jsvalue);');
   Add('  p:=typeinfo(tvalue);');
@@ -11797,8 +11799,8 @@ begin
     'this.p = rtl.smallint;',
     'this.p = rtl.word;',
     'this.p = rtl.word;',
-    'this.p = rtl.cardinal;',
-    'this.p = rtl.cardinal;',
+    'this.p = rtl.longword;',
+    'this.p = rtl.longword;',
     'this.p = rtl.jsvalue;',
     'this.p = rtl.jsvalue;',
     '']));
@@ -11850,7 +11852,7 @@ begin
   Add('  tiInt:=typeinfo(smallint);');
   Add('  tiInt:=typeinfo(word);');
   Add('  tiInt:=typeinfo(longint);');
-  Add('  tiInt:=typeinfo(cardinal);');
+  Add('  tiInt:=typeinfo(longword);');
   Add('  ti:=typeinfo(jsvalue);');
   Add('  tiEnum:=typeinfo(tflag);');
   Add('  tiSet:=typeinfo(tflags);');
@@ -11886,7 +11888,7 @@ begin
     'this.tiInt = rtl.smallint;',
     'this.tiInt = rtl.word;',
     'this.tiInt = rtl.longint;',
-    'this.tiInt = rtl.cardinal;',
+    'this.tiInt = rtl.longword;',
     'this.ti = rtl.jsvalue;',
     'this.tiEnum = this.$rtti["TFlag"];',
     'this.tiSet = this.$rtti["TFlags"];',