Browse Source

* 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 years ago
parent
commit
a1303eecde

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

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

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

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

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

@@ -154,6 +154,7 @@ type
     Procedure TestRenameJSNameConflict;
     Procedure TestRenameJSNameConflict;
     Procedure TestLocalConst;
     Procedure TestLocalConst;
     Procedure TestVarExternal;
     Procedure TestVarExternal;
+    Procedure TestVarExternalOtherUnit;
 
 
     // strings
     // strings
     Procedure TestCharConst;
     Procedure TestCharConst;
@@ -187,6 +188,7 @@ type
     Procedure TestBreak;
     Procedure TestBreak;
     Procedure TestContinue;
     Procedure TestContinue;
     Procedure TestProcedureExternal;
     Procedure TestProcedureExternal;
+    Procedure TestProcedureExternalOtherUnit;
     Procedure TestProcedureAsm;
     Procedure TestProcedureAsm;
     Procedure TestProcedureAssembler;
     Procedure TestProcedureAssembler;
     Procedure TestProcedure_VarParam;
     Procedure TestProcedure_VarParam;
@@ -285,6 +287,8 @@ type
     Procedure TestClass_OverloadConstructor;
     Procedure TestClass_OverloadConstructor;
     Procedure TestClass_ReintroducedVar;
     Procedure TestClass_ReintroducedVar;
     Procedure TestClass_RaiseDescendent;
     Procedure TestClass_RaiseDescendent;
+    Procedure TestClass_ExternalMethod;
+    Procedure TestClass_ExternalVar;
 
 
     // class of
     // class of
     Procedure TestClassOf_Create;
     Procedure TestClassOf_Create;
@@ -296,6 +300,7 @@ type
     Procedure TestClassOf_ClassProperty;
     Procedure TestClassOf_ClassProperty;
     Procedure TestClassOf_ClassMethodSelf;
     Procedure TestClassOf_ClassMethodSelf;
     Procedure TestClassOf_TypeCast;
     Procedure TestClassOf_TypeCast;
+    Procedure TestClassOf_ImplicitFunctionCall;
 
 
     // proc types
     // proc types
     Procedure TestProcType;
     Procedure TestProcType;
@@ -1754,6 +1759,49 @@ begin
     ]));
     ]));
 end;
 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;
 procedure TTestModule.TestProcedureAsm;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -2071,6 +2119,7 @@ begin
   Add('procedure ProcA(i:longint); varargs; external name ''ProcA'';');
   Add('procedure ProcA(i:longint); varargs; external name ''ProcA'';');
   Add('procedure ProcB; varargs; external name ''ProcB'';');
   Add('procedure ProcB; varargs; external name ''ProcB'';');
   Add('procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';');
   Add('procedure ProcC(i: longint = 17); varargs; external name ''ProcC'';');
+  Add('function GetIt: longint; begin end;');
   Add('begin');
   Add('begin');
   Add('  ProcA(1);');
   Add('  ProcA(1);');
   Add('  ProcA(1,2);');
   Add('  ProcA(1,2);');
@@ -2087,9 +2136,16 @@ begin
   Add('  ProcC();');
   Add('  ProcC();');
   Add('  ProcC(4);');
   Add('  ProcC(4);');
   Add('  ProcC(5,''foo'');');
   Add('  ProcC(5,''foo'');');
+  Add('  ProcB(GetIt);');
+  Add('  ProcB(GetIt());');
+  Add('  ProcB(GetIt,GetIt());');
   ConvertProgram;
   ConvertProgram;
   CheckSource('TestProc_Varargs',
   CheckSource('TestProc_Varargs',
     LinesToStr([ // statements
     LinesToStr([ // statements
+    'this.GetIt = function () {',
+    '  var Result = 0;',
+    '  return Result;',
+    '};',
     '']),
     '']),
     LinesToStr([
     LinesToStr([
     'ProcA(1);',
     'ProcA(1);',
@@ -2107,6 +2163,9 @@ begin
     'ProcC(17);',
     'ProcC(17);',
     'ProcC(4);',
     'ProcC(4);',
     'ProcC(5, "foo");',
     'ProcC(5, "foo");',
+    'ProcB(this.GetIt());',
+    'ProcB(this.GetIt());',
+    'ProcB(this.GetIt(), this.GetIt());',
     '']));
     '']));
 end;
 end;
 
 
@@ -2781,6 +2840,48 @@ begin
     ]));
     ]));
 end;
 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;
 procedure TTestModule.TestCharConst;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -6107,6 +6208,127 @@ begin
     '']));
     '']));
 end;
 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;
 procedure TTestModule.TestClassOf_Create;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -6540,6 +6762,52 @@ begin
     '']));
     '']));
 end;
 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;
 procedure TTestModule.TestProcType;
 begin
 begin
   StartProgram(false);
   StartProgram(false);

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

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