فهرست منبع

* Fixed from Mattias Gaertner
pasresolver: checking all varargs arguments
pasresolver: checking arguments are readable
fppas2js: fixed using externals from other units

git-svn-id: trunk@35631 -

michael 8 سال پیش
والد
کامیت
a1303eecde
4فایلهای تغییر یافته به همراه435 افزوده شده و 95 حذف شده
  1. 113 56
      packages/fcl-passrc/src/pasresolver.pp
  2. 51 36
      packages/pastojs/src/fppas2js.pp
  3. 268 0
      packages/pastojs/tests/tcmodules.pas
  4. 3 3
      utils/pas2js/dist/rtl.js

+ 113 - 56
packages/fcl-passrc/src/pasresolver.pp

@@ -1213,6 +1213,7 @@ type
     function IsProcedureType(const ResolvedEl: TPasResolverResult): boolean;
     function IsArrayType(const ResolvedEl: TPasResolverResult): boolean;
     function IsTypeCast(Params: TParamsExpr): boolean;
+    function ProcNeedsParams(El: TPasProcedureType): boolean;
     function GetRangeLength(RangeResolved: TPasResolverResult): integer;
   public
     property BaseType[bt: TResolverBaseType]: TPasUnresolvedSymbolRef read GetBaseType;
@@ -1255,6 +1256,7 @@ procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult;
 function ProcNeedsImplProc(Proc: TPasProcedure): boolean;
 function dbgs(const Flags: TPasResolverComputeFlags): string; overload;
 function dbgs(const a: TResolvedRefAccess): string;
+function dbgs(const Flags: TResolvedReferenceFlags): string; overload;
 
 implementation
 
@@ -1639,6 +1641,22 @@ begin
   str(a,Result);
 end;
 
+function dbgs(const Flags: TResolvedReferenceFlags): string;
+var
+  s: string;
+  f: TResolvedReferenceFlag;
+begin
+  Result:='';
+  for f in Flags do
+    if f in Flags then
+      begin
+      if Result<>'' then Result:=Result+',';
+      str(f,s);
+      Result:=Result+s;
+      end;
+  Result:='['+Result+']';
+end;
+
 { TPasPropertyScope }
 
 destructor TPasPropertyScope.Destroy;
@@ -2363,8 +2381,7 @@ var
 begin
   ok:=true;
   if (El is TPasProcedure)
-      and (TPasProcedure(El).ProcType.Args.Count>0)
-      and (TPasArgument(TPasProcedure(El).ProcType.Args[0]).ValueExpr=nil) then
+      and ProcNeedsParams(TPasProcedure(El).ProcType) then
     // found a proc, but it needs parameters -> remember the first and continue
     ok:=false;
   if ok or (Data^.Found=nil) then
@@ -4260,10 +4277,7 @@ begin
       begin
       // examples: funca or @proca or a.funca or @a.funca ...
       Proc:=TPasProcedure(DeclEl);
-      if (Proc.ProcType.Args.Count>0)
-          and (TPasArgument(Proc.ProcType.Args[0]).ValueExpr=nil) // no default value -> param needed
-          and not ExprIsAddrTarget(El)
-      then
+      if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
         begin
         {$IFDEF VerbosePasResolver}
         writeln('TPasResolver.ResolveNameExpr ',GetObjName(El));
@@ -4615,7 +4629,10 @@ begin
         and (TPrimitiveExpr(Value).Kind=pekIdent)) then
     begin
     // e.g. Name() -> find compatible
-    ElName:=TPrimitiveExpr(Value).Value;
+    if Value.ClassType=TPrimitiveExpr then
+      ElName:=TPrimitiveExpr(Value).Value
+    else
+      ElName:='Self';
     FindCallData:=Default(TFindCallElData);
     FindCallData.Params:=Params;
     Abort:=false;
@@ -6670,7 +6687,7 @@ begin
     end
   else
     ;// ordinal: result type is argument type
-  ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable];
+  ResolvedEl.Flags:=ResolvedEl.Flags-[rrfWritable]+[rrfReadable];
 end;
 
 function TPasResolver.BI_PredSucc_OnGetCallCompatibility(
@@ -6888,8 +6905,7 @@ begin
     RaiseIdentifierNotFound(20170216152722,AName,ErrorPosEl);
     end;
   if NoProcsWithArgs and (Result is TPasProcedure)
-      and (TPasProcedure(Result).ProcType.Args.Count>0)
-      and (TPasArgument(TPasProcedure(Result).ProcType.Args[0]).ValueExpr=nil)
+      and ProcNeedsParams(TPasProcedure(Result).ProcType)
   then
     // proc needs parameters
     RaiseMsg(20170216152347,nWrongNumberOfParametersForCallTo,
@@ -7588,8 +7604,10 @@ procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType;
   PosEl: TPasElement);
 begin
   SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
-  if Assigned(CurrentParser.OnLog) then
-    CurrentParser.OnLog(Self,SafeFormat(Fmt,Args));
+  if Assigned(OnLog) then
+    OnLog(Self,FLastMsg)
+  else if Assigned(CurrentParser.OnLog) then
+    CurrentParser.OnLog(Self,FLastMsg);
 end;
 
 function TPasResolver.CheckCallProcCompatibility(ProcType: TPasProcedureType;
@@ -7598,36 +7616,52 @@ var
   ProcArgs: TFPList;
   i, ParamCnt, ParamCompatibility: Integer;
   Param: TPasExpr;
-  Proc: TPasProcedure;
+  ParamResolved: TPasResolverResult;
+  IsVarArgs: Boolean;
 begin
   Result:=cExact;
   ProcArgs:=ProcType.Args;
   // check args
   ParamCnt:=length(Params.Params);
+  IsVarArgs:=false;
   i:=0;
   while i<ParamCnt do
     begin
     Param:=Params.Params[i];
-    if i>=ProcArgs.Count then
+    {$IFDEF VerbosePasResolver}
+    writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
+    {$ENDIF}
+    if i<ProcArgs.Count then
+      begin
+      ParamCompatibility:=CheckParamCompatibility(Param,TPasArgument(ProcArgs[i]),i,RaiseOnError);
+      if ParamCompatibility=cIncompatible then
+        exit(cIncompatible);
+      end
+    else
       begin
-      if ProcType.Parent is TPasProcedure then
+      IsVarArgs:=IsVarArgs or ((ProcType.Parent is TPasProcedure)
+        and (pmVarargs in TPasProcedure(ProcType.Parent).Modifiers));
+      if IsVarArgs then
         begin
-        Proc:=TPasProcedure(ProcType.Parent);
-        if pmVarargs in Proc.Modifiers then
-          exit;
+        ComputeElement(Param,ParamResolved,[],Param);
+        if not (rrfReadable in ParamResolved.Flags) then
+          begin
+          if RaiseOnError then
+            RaiseMsg(20170318234957,nVariableIdentifierExpected,
+              sVariableIdentifierExpected,[],Param);
+          exit(cIncompatible);
+          end;
+        ParamCompatibility:=cExact;
+        end
+      else
+        begin
+        // too many arguments
+        if RaiseOnError then
+          RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
+            sWrongNumberOfParametersForCallTo,[GetProcDesc(ProcType)],Param);
+        exit(cIncompatible);
         end;
-      // too many arguments
-      if RaiseOnError then
-        RaiseMsg(20170216152408,nWrongNumberOfParametersForCallTo,
-          sWrongNumberOfParametersForCallTo,[GetProcDesc(ProcType)],Param);
-      exit(cIncompatible);
       end;
-    {$IFDEF VerbosePasResolver}
-    writeln('TPasResolver.CheckCallProcCompatibility ',i,'/',ParamCnt);
-    {$ENDIF}
-    ParamCompatibility:=CheckParamCompatibility(Param,TPasArgument(ProcArgs[i]),i,RaiseOnError);
-    if ParamCompatibility=cIncompatible then
-      exit(cIncompatible);
     inc(Result,ParamCompatibility);
     inc(i);
     end;
@@ -7926,54 +7960,60 @@ begin
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.CheckAssignResCompatibility START LHS='+GetResolverResultDesc(LHS)+' RHS='+GetResolverResultDesc(RHS));
   {$ENDIF}
+  Result:=-1;
+
   if LHS.TypeEl=nil then
     begin
     if LHS.BaseType=btUntyped then
       begin
       // untyped parameter
-      exit(cExact+1);
-      end;
-    RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
+      Result:=cExact+1;
+      end
+    else
+      RaiseNotYetImplemented(20160922163631,LHS.IdentEl);
     end
   else if LHS.BaseType=RHS.BaseType then
     begin
     if LHS.BaseType=btContext then
-      exit(CheckAssignCompatibilityCustomType(LHS,RHS,ErrorEl,RaiseOnIncompatible))
+      Result:=CheckAssignCompatibilityCustomType(LHS,RHS,ErrorEl,RaiseOnIncompatible)
     else
-      exit(cExact); // same base type, maybe not same type name (e.g. longint and integer)
+      Result:=cExact; // same base type, maybe not same type name (e.g. longint and integer)
     end
   else if (LHS.BaseType in btAllInteger)
       and (RHS.BaseType in btAllInteger) then
-    exit(cExact+1) // ToDo: range check for Expr
+    Result:=cExact+1
   else if (LHS.BaseType in btAllBooleans)
       and (RHS.BaseType in btAllBooleans) then
-    exit(cExact+1)
+    Result:=cExact+1
   else if (LHS.BaseType in btAllStringAndChars)
       and (RHS.BaseType in btAllStringAndChars) then
-    exit(cExact+1)
+    Result:=cExact+1
   else if (LHS.BaseType in btAllFloats)
       and (RHS.BaseType in btAllFloats+btAllInteger) then
-    exit(cExact+1)
+    Result:=cExact+1
   else if LHS.BaseType=btNil then
     begin
-    if not RaiseOnIncompatible then exit(cIncompatible);
-    RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
-      [],ErrorEl);
+    if RaiseOnIncompatible then
+      RaiseMsg(20170216152431,nCantAssignValuesToAnAddress,sCantAssignValuesToAnAddress,
+        [],ErrorEl);
+    exit(cIncompatible);
     end
   else if LHS.BaseType in [btRange,btSet,btModule,btArray] then
     begin
     if RaiseOnIncompatible then
       RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);
+    exit(cIncompatible);
     end
   else if (LHS.IdentEl=nil) and (LHS.ExprEl=nil) then
     begin
     if RaiseOnIncompatible then
       RaiseMsg(20170216152434,nIllegalExpression,sIllegalExpression,[],ErrorEl);
+    exit(cIncompatible);
     end
   else if RHS.BaseType=btNil then
     begin
     if LHS.BaseType=btPointer then
-      exit(cExact)
+      Result:=cExact
     else if LHS.BaseType=btContext then
       begin
       TypeEl:=LHS.TypeEl;
@@ -7982,7 +8022,7 @@ begin
           or (TypeEl.ClassType=TPasPointerType)
           or (TypeEl is TPasProcedureType)
           or IsDynArray(TypeEl) then
-        exit(cExact);
+        Result:=cExact;
       end;
     end
   else if RHS.BaseType=btSet then
@@ -7990,15 +8030,15 @@ begin
     if (LHS.BaseType=btSet) then
       begin
       if RHS.TypeEl=nil then
-        exit(cExact); // empty set
-      if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+[btChar])) then
-        exit(cExact);
-      if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
+        Result:=cExact // empty set
+      else if (LHS.SubType=RHS.SubType) and (LHS.SubType in (btAllBooleans+btAllInteger+[btChar])) then
+        Result:=cExact
+      else if ((LHS.SubType in btAllBooleans) and (RHS.SubType in btAllBooleans))
           or ((LHS.SubType in btAllInteger) and (RHS.SubType in btAllInteger)) then
-        exit(cExact+1);
-      if (LHS.SubType=btContext) and (LHS.TypeEl is TPasEnumType)
+        Result:=cExact+1
+      else if (LHS.SubType=btContext) and (LHS.TypeEl is TPasEnumType)
           and (LHS.TypeEl=RHS.TypeEl) then
-        exit(cExact);
+        Result:=cExact;
       end;
     end
   else if RHS.BaseType=btProc then
@@ -8009,15 +8049,29 @@ begin
       begin
       if CheckProcAssignCompatibility(TPasProcedureType(LHS.TypeEl),
           TPasProcedure(RHS.IdentEl).ProcType) then
-        exit(cExact);
+        Result:=cExact;
       end;
     end
   else if (LHS.BaseType=btContext) and (LHS.TypeEl is TPasArrayType) then
-    exit(CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible));
+    Result:=CheckAssignCompatibilityArrayType(LHS,RHS,ErrorEl,RaiseOnIncompatible);
   {$IFDEF VerbosePasResolver}
   writeln('TPasResolver.CheckAssignResCompatibility incompatible LHS='+GetResolverResultDesc(LHS)+' RHS='+GetResolverResultDesc(RHS));
   {$ENDIF}
 
+  if (Result>=0) and (Result<cIncompatible) then
+    begin
+    // type fits -> check readable
+    if not (rrfReadable in RHS.Flags) then
+      begin
+      if RaiseOnIncompatible then
+        RaiseMsg(20170318235637,nVariableIdentifierExpected,
+          sVariableIdentifierExpected,[],ErrorEl);
+      exit(cIncompatible);
+      end;
+    exit;
+    end;
+
+  // incompatible
   if not RaiseOnIncompatible then
     exit(cIncompatible);
 
@@ -8860,8 +8914,7 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
         begin
         // a proc and implicit call without params is allowed -> check if possible
         Proc:=ResolvedEl.IdentEl as TPasProcedure;
-        if (Proc.ProcType.Args.Count=0)
-            or (TPasArgument(Proc.ProcType.Args[0]).ValueExpr<>nil) then
+        if not ProcNeedsParams(Proc.ProcType) then
           begin
           // parameter less proc -> implicit call
           Include(Ref.Flags,rrfImplicitCallWithoutParams);
@@ -8886,8 +8939,7 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
         begin
         // a proc type and implicit call without params is allowed -> check if possible
         ProcType:=TPasProcedureType(ResolvedEl.TypeEl);
-        if (ProcType.Args.Count=0)
-            or (TPasArgument(ProcType.Args[0]).ValueExpr<>nil) then
+        if not ProcNeedsParams(ProcType) then
           begin
           // parameter less proc -> implicit call
           Include(Ref.Flags,rrfImplicitCallWithoutParams);
@@ -9355,6 +9407,11 @@ begin
     exit(true);
 end;
 
+function TPasResolver.ProcNeedsParams(El: TPasProcedureType): boolean;
+begin
+  Result:=(El.Args.Count>0) and (TPasArgument(El.Args[0]).ValueExpr=nil);
+end;
+
 function TPasResolver.GetRangeLength(RangeResolved: TPasResolverResult
   ): integer;
 begin

+ 51 - 36
packages/pastojs/src/fppas2js.pp

@@ -650,7 +650,8 @@ type
     // Computation, value conversions
     Function GetExpressionValueType(El: TPasExpr; AContext: TConvertContext ): TJSType; virtual;
     Function GetPasIdentValueType(AName: String; AContext: TConvertContext): TJSType; virtual;
-    Function ComputeConst(Expr: TPasExpr; AContext: TConvertContext): TJSValue; virtual;
+    Function ComputeConst(Expr: TPasExpr; AContext: TConvertContext;
+      StoreCustomData: boolean): TJSValue; virtual;
     Function TransFormStringLiteral(El: TPasElement; AContext: TConvertContext; const S: String): TJSString; virtual;
     // Name mangling
     Function TransformVariableName(El: TPasElement; Const AName: String; AContext : TConvertContext): String; virtual;
@@ -1639,14 +1640,27 @@ begin
 end;
 
 function TPasToJSConverter.ComputeConst(Expr: TPasExpr;
-  AContext: TConvertContext): TJSValue;
+  AContext: TConvertContext; StoreCustomData: boolean): TJSValue;
 var
   Prim: TPrimitiveExpr;
   V: TJSValue;
+  ConstData: TP2JConstExprData;
 begin
   Result:=nil;
   if Expr=nil then
     RaiseInconsistency(20170215123600);
+  if StoreCustomData and (Expr.CustomData is TPasElementBase) then
+    begin
+    ConstData:=TP2JConstExprData(GetElementData(
+                           TPasElementBase(Expr.CustomData),TP2JConstExprData));
+    if ConstData<>nil then
+      begin
+      // use stored result
+      Result:=ConstData.Value;
+      exit;
+      end;
+    end;
+
   V:=nil;
   try
     if Expr.ClassType=TPrimitiveExpr then
@@ -1660,6 +1674,13 @@ begin
     else
       RaiseNotSupported(Expr,AContext,20170215124746);
     Result:=V;
+
+    if StoreCustomData then
+      begin
+      // store result
+      ConstData:=TP2JConstExprData(CreateElementData(TP2JConstExprData,Expr));
+      ConstData.Value:=V;
+      end;
   finally
     if Result=nil then
       V.Free;
@@ -2075,8 +2096,20 @@ var
   Left, Right: TJSElement;
   DotContext: TDotContext;
   OldAccess: TCtxAccess;
+  LeftResolved: TPasResolverResult;
 begin
   Result:=nil;
+  if AContext.Resolver<>nil then
+    begin
+    AContext.Resolver.ComputeElement(El.left,LeftResolved,[]);
+    if LeftResolved.BaseType=btModule then
+      begin
+      // e.g. System.ExitCode
+      // unit prefix is automatically created -> omit
+      Result:=ConvertElement(El.right,AContext);
+      exit;
+      end;
+    end;
   // convert left side
   OldAccess:=AContext.Access;
   AContext.Access:=caRead;
@@ -2088,8 +2121,7 @@ begin
   DotContext:=TDotContext.Create(El,Left,AContext);
   Right:=nil;
   try
-    if AContext.Resolver<>nil then
-      AContext.Resolver.ComputeElement(El.left,DotContext.LeftResolved,[]);
+    DotContext.LeftResolved:=LeftResolved;
     Right:=ConvertElement(El.right,DotContext);
   finally
     DotContext.Free;
@@ -2207,10 +2239,10 @@ var
   AssignContext: TAssignContext;
   Arg: TPasArgument;
   ParamContext: TParamContext;
-  ConstData: TP2JConstExprData;
   ResolvedEl: TPasResolverResult;
   ProcType: TPasProcedureType;
   aVar: TPasVariable;
+  ConstValue: TJSValue;
 begin
   Result:=nil;
   if AContext=nil then ;
@@ -2355,19 +2387,19 @@ begin
       begin
       // an external function -> use the literal
       Proc:=TPasProcedure(Decl);
-      ConstData:=TP2JConstExprData(GetElementData(Proc.LibrarySymbolName,TP2JConstExprData));
-      if ConstData=nil then
+      ConstValue:=ComputeConst(Proc.LibrarySymbolName,AContext,true);
+      if ConstValue=nil then
         RaiseInconsistency(20170215131352);
-      Name:=String(ConstData.Value.AsString);
+      Name:=String(ConstValue.AsString);
       end
     else if (Decl is TPasVariable) and (TPasVariable(Decl).ExportName<>nil) then
       begin
       // an external variable -> use the literal
       aVar:=TPasVariable(Decl);
-      ConstData:=TP2JConstExprData(GetElementData(aVar.ExportName,TP2JConstExprData));
-      if ConstData=nil then
+      ConstValue:=ComputeConst(aVar.ExportName,AContext,true);
+      if ConstValue=nil then
         RaiseInconsistency(20170227091555);
-      Name:=String(ConstData.Value.AsString);
+      Name:=String(ConstValue.AsString);
       end
     else
       Name:=CreateReferencePath(Decl,AContext,rpkPathAndName,false,Ref);
@@ -3749,8 +3781,6 @@ Var
   Obj: TJSObjectLiteral;
   ObjLit: TJSObjectLiteralElement;
   LibSymbol: TJSValue;
-  ConstData: TP2JConstExprData;
-
 begin
   Result:=nil;
   if vmExternal in El.VarModifiers then
@@ -3761,16 +3791,9 @@ begin
         ['library'],El.ExportName);
     if El.ExportName=nil then
       DoError(20170227100750,nMissingExternalName,sMissingExternalName,[],El);
-    LibSymbol:=ComputeConst(El.ExportName,AContext);
-    try
-      if (LibSymbol.ValueType<>jstString) or (LibSymbol.AsString='') then
-        DoError(20170227094343,nExpectedXButFoundY,sExpectedXButFoundY,['string literal',El.Name],El);
-      ConstData:=TP2JConstExprData(CreateElementData(TP2JConstExprData,El.ExportName));
-      ConstData.Value:=LibSymbol;
-      LibSymbol:=nil;
-    finally
-      LibSymbol.Free;
-    end;
+    LibSymbol:=ComputeConst(El.ExportName,AContext,true);
+    if (LibSymbol.ValueType<>jstString) or (LibSymbol.AsString='') then
+      DoError(20170227094343,nExpectedXButFoundY,sExpectedXButFoundY,['string literal',El.Name],El);
     exit;
     end;
   if AContext is TObjectContext then
@@ -4516,8 +4539,6 @@ Var
   ImplProc: TPasProcedure;
   pm: TProcedureModifier;
   LibSymbol: TJSValue;
-  ConstData: TP2JConstExprData;
-
 begin
   Result:=nil;
 
@@ -4556,16 +4577,9 @@ begin
     for pm in [pmAssembler,pmForward] do
       if pm in El.Modifiers then
         RaiseNotSupported(El,AContext,20170301121326,'modifier '+ModifierNames[pm]);
-    LibSymbol:=ComputeConst(El.LibrarySymbolName,AContext);
-    try
-      if (LibSymbol.ValueType<>jstString) or (LibSymbol.AsString='') then
-        DoError(20170211221121,nExpectedXButFoundY,sExpectedXButFoundY,['string literal',El.Name],El);
-      ConstData:=TP2JConstExprData(CreateElementData(TP2JConstExprData,El.LibrarySymbolName));
-      ConstData.Value:=LibSymbol;
-      LibSymbol:=nil;
-    finally
-      LibSymbol.Free;
-    end;
+    LibSymbol:=ComputeConst(El.LibrarySymbolName,AContext,true);
+    if (LibSymbol.ValueType<>jstString) or (LibSymbol.AsString='') then
+      DoError(20170211221121,nExpectedXButFoundY,sExpectedXButFoundY,['string literal',El.Name],El);
     exit;
     end;
 
@@ -5849,7 +5863,8 @@ begin
       begin
       El:=TPasElement(UsesList[k]);
       if not (El is TPasModule) then continue;
-      if not IsElementUsed(El) then continue;
+      if (not IsElementUsed(El)) and (CompareText('system',El.Name)<>0) then
+        continue;
       anUnitName := TransformVariableName(TPasModule(El),AContext);
       ArgEx := CreateLiteralString(UsesSection,anUnitName);
       ArgArray.Elements.AddElement.Expr := ArgEx;

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

@@ -154,6 +154,7 @@ type
     Procedure TestRenameJSNameConflict;
     Procedure TestLocalConst;
     Procedure TestVarExternal;
+    Procedure TestVarExternalOtherUnit;
 
     // strings
     Procedure TestCharConst;
@@ -187,6 +188,7 @@ type
     Procedure TestBreak;
     Procedure TestContinue;
     Procedure TestProcedureExternal;
+    Procedure TestProcedureExternalOtherUnit;
     Procedure TestProcedureAsm;
     Procedure TestProcedureAssembler;
     Procedure TestProcedure_VarParam;
@@ -285,6 +287,8 @@ type
     Procedure TestClass_OverloadConstructor;
     Procedure TestClass_ReintroducedVar;
     Procedure TestClass_RaiseDescendent;
+    Procedure TestClass_ExternalMethod;
+    Procedure TestClass_ExternalVar;
 
     // class of
     Procedure TestClassOf_Create;
@@ -296,6 +300,7 @@ type
     Procedure TestClassOf_ClassProperty;
     Procedure TestClassOf_ClassMethodSelf;
     Procedure TestClassOf_TypeCast;
+    Procedure TestClassOf_ImplicitFunctionCall;
 
     // proc types
     Procedure TestProcType;
@@ -1754,6 +1759,49 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProcedureExternalOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'procedure Now; external name ''Date.now'';',
+    'procedure DoIt;'
+    ]),
+    'procedure doit; begin end;');
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('implementation');
+  Add('begin');
+  Add('  now;');
+  Add('  now();');
+  Add('  uNit2.now;');
+  Add('  uNit2.now();');
+  Add('  test1.now;');
+  Add('  test1.now();');
+  Add('  doit;');
+  Add('  uNit2.doit;');
+  Add('  test1.doit;');
+  ConvertUnit;
+  CheckSource('TestProcedureExternalOtherUnit',
+    LinesToStr([
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;'
+    ]),
+    LinesToStr([
+    'Date.now();',
+    'Date.now();',
+    'Date.now();',
+    'Date.now();',
+    'Date.now();',
+    'Date.now();',
+    'pas.unit2.DoIt();',
+    'pas.unit2.DoIt();',
+    'pas.unit2.DoIt();'
+    ]));
+end;
+
 procedure TTestModule.TestProcedureAsm;
 begin
   StartProgram(false);
@@ -2071,6 +2119,7 @@ begin
   Add('procedure ProcA(i:longint); varargs; external name ''ProcA'';');
   Add('procedure ProcB; varargs; external name ''ProcB'';');
   Add('procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';');
+  Add('function GetIt: longint; begin end;');
   Add('begin');
   Add('  ProcA(1);');
   Add('  ProcA(1,2);');
@@ -2087,9 +2136,16 @@ begin
   Add('  ProcC();');
   Add('  ProcC(4);');
   Add('  ProcC(5,''foo'');');
+  Add('  ProcB(GetIt);');
+  Add('  ProcB(GetIt());');
+  Add('  ProcB(GetIt,GetIt());');
   ConvertProgram;
   CheckSource('TestProc_Varargs',
     LinesToStr([ // statements
+    'this.GetIt = function () {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
     '']),
     LinesToStr([
     'ProcA(1);',
@@ -2107,6 +2163,9 @@ begin
     'ProcC(17);',
     'ProcC(4);',
     'ProcC(5, "foo");',
+    'ProcB(this.GetIt());',
+    'ProcB(this.GetIt());',
+    'ProcB(this.GetIt(), this.GetIt());',
     '']));
 end;
 
@@ -2781,6 +2840,48 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestVarExternalOtherUnit;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'var NaN: double; external name ''Global.NaN'';',
+    'var iV: longint;'
+    ]),
+    '');
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('implementation');
+  Add('var');
+  Add('  d: double;');
+  Add('  i: longint;');
+  Add('begin');
+  Add('  d:=nan;');
+  Add('  d:=uNit2.nan;');
+  Add('  d:=test1.nan;');
+  Add('  i:=iv;');
+  Add('  i:=uNit2.iv;');
+  Add('  i:=test1.iv;');
+  ConvertUnit;
+  CheckSource('TestVarExternalOtherUnit',
+    LinesToStr([
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;',
+    '$impl.d = 0.0;',
+    '$impl.i = 0;',
+    '']),
+    LinesToStr([
+    '$impl.d = Global.NaN;',
+    '$impl.d = Global.NaN;',
+    '$impl.d = Global.NaN;',
+    '$impl.i = pas.unit2.iV;',
+    '$impl.i = pas.unit2.iV;',
+    '$impl.i = pas.unit2.iV;',
+    '']));
+end;
+
 procedure TTestModule.TestCharConst;
 begin
   StartProgram(false);
@@ -6107,6 +6208,127 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClass_ExternalMethod;
+begin
+  AddModuleWithIntfImplSrc('unit2.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class',
+    '  public',
+    '    procedure Intern; external name ''$DoIntern'';',
+    '  end;',
+    '']),
+    LinesToStr([
+    '']));
+
+  StartUnit(true);
+  Add('interface');
+  Add('uses unit2;');
+  Add('type');
+  Add('  TCar = class(TObject)');
+  Add('  public');
+  Add('    procedure Intern2; external name ''$DoIntern2'';');
+  Add('    procedure DoIt;');
+  Add('  end;');
+  Add('implementation');
+  Add('procedure tcar.doit;');
+  Add('begin');
+  Add('  Intern;');
+  Add('  Intern();');
+  Add('  Intern2;');
+  Add('  Intern2();');
+  Add('end;');
+  Add('var Obj: TCar;');
+  Add('begin');
+  Add('  obj.intern;');
+  Add('  obj.intern();');
+  Add('  obj.intern2;');
+  Add('  obj.intern2();');
+  Add('  obj.doit;');
+  Add('  obj.doit();');
+  ConvertUnit;
+  CheckSource('TestClass_ExternalMethod',
+    LinesToStr([
+    'var $impl = {',
+    '};',
+    'this.$impl = $impl;',
+    'rtl.createClass(this, "TCar", pas.unit2.TObject, function () {',
+    '    this.DoIt = function () {',
+    '      $DoIntern();',
+    '      $DoIntern();',
+    '      $DoIntern2();',
+    '      $DoIntern2();',
+    '    };',
+    '  });',
+    '$impl.Obj = null;',
+    '']),
+    LinesToStr([
+    '$impl.Obj.$DoIntern();',
+    '$impl.Obj.$DoIntern();',
+    '$impl.Obj.$DoIntern2();',
+    '$impl.Obj.$DoIntern2();',
+    '$impl.Obj.DoIt();',
+    '$impl.Obj.DoIt();',
+    '']));
+end;
+
+procedure TTestModule.TestClass_ExternalVar;
+begin
+  //Not yet supported by pparser:
+  //
+  //AddModuleWithIntfImplSrc('unit2.pas',
+  //  LinesToStr([
+  //  'type',
+  //  '  TObject = class',
+  //  '  public',
+  //  '    Intern: longint; external name ''$Intern'';',
+  //  '  end;',
+  //  '']),
+  //  LinesToStr([
+  //  '']));
+  //
+  //StartUnit(true);
+  //Add('interface');
+  //Add('uses unit2;');
+  //Add('type');
+  //Add('  TCar = class(tobject)');
+  //Add('  public');
+  //Add('    Intern2: longint; external name ''$Intern2'';');
+  //Add('    procedure DoIt;');
+  //Add('  end;');
+  //Add('implementation');
+  //Add('procedure tcar.doit;');
+  //Add('begin');
+  //Add('  Intern:=Intern+1;');
+  //Add('  Intern2:=Intern2+2;');
+  //Add('end;');
+  //Add('var Obj: TCar;');
+  //Add('begin');
+  //Add('  obj.intern:=obj.intern+1;');
+  //Add('  obj.intern2:=obj.intern2+2;');
+  //ConvertUnit;
+  //CheckSource('TestClass_ExternalVar',
+  //  LinesToStr([
+  //  'var $impl = {',
+  //  '};',
+  //  'this.$impl = $impl;',
+  //  'rtl.createClass(this, "TCar", pas.unit2.TObject, function () {',
+  //  '    this.DoIt = function () {',
+  //  '      $DoIntern();',
+  //  '      $DoIntern();',
+  //  '    };',
+  //  '  });',
+  //  '']),
+  //  LinesToStr([
+  //  '$impl.Obj.$DoIntern();',
+  //  '$impl.Obj.$DoIntern();',
+  //  '$impl.Obj.$DoIntern2();',
+  //  '$impl.Obj.$DoIntern2();',
+  //  '$impl.Obj.DoIt();',
+  //  '$impl.Obj.DoIt();',
+  //  '']));
+end;
+
 procedure TTestModule.TestClassOf_Create;
 begin
   StartProgram(false);
@@ -6540,6 +6762,52 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClassOf_ImplicitFunctionCall;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  TObject = class');
+  Add('    function CurNow: longint; ');
+  Add('    class function Now: longint; ');
+  Add('  end;');
+  Add('function TObject.CurNow: longint; begin end;');
+  Add('class function TObject.Now: longint; begin end;');
+  Add('var');
+  Add('  Obj: tobject;');
+  Add('  vI: longint;');
+  Add('begin');
+  Add('  obj.curnow;');
+  Add('  vi:=obj.curnow;');
+  Add('  tobject.now;');
+  Add('  vi:=tobject.now;');
+  ConvertProgram;
+  CheckSource('TestClassOf_ImplicitFunctionCall',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  this.CurNow = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '  this.Now = function () {',
+    '    var Result = 0;',
+    '    return Result;',
+    '  };',
+    '});',
+    'this.Obj = null;',
+    'this.vI = 0;',
+    '']),
+    LinesToStr([ // this.$main
+    'this.Obj.CurNow();',
+    'this.vI = this.Obj.CurNow();',
+    'this.TObject.Now();',
+    'this.vI = this.TObject.Now();',
+    '']));
+end;
+
 procedure TTestModule.TestProcType;
 begin
   StartProgram(false);

+ 3 - 3
utils/pas2js/dist/rtl.js

@@ -1,4 +1,4 @@
-/*
+/*
     This file is part of the Free Pascal pas2js tool.
     Copyright (c) 2017 Mattias Gaertner
 
@@ -17,7 +17,7 @@ var pas = {};
 var rtl = {
 
   quiet: false,
-  debug_load_units: true,
+  debug_load_units: false,
 
   m_loading: 0,
   m_loading_intf: 1,
@@ -27,7 +27,7 @@ var rtl = {
   m_initialized: 5,
 
   debug: function(){
-    if (!window.console || rtl.quiet) return;
+    if (rtl.quiet || !console || !console.log) return;
     console.log(arguments);
   },