Browse Source

# revisions: 43689,43690,43691,43692,43809,43810,43811,43813,43853,43873,43890,43951,43952,43953,43960,44077,44078,44110,44121,44122,44134,44135,44137,44140,44146

git-svn-id: branches/fixes_3_2@46822 -
marco 4 years ago
parent
commit
239c7268ab

+ 5 - 2
packages/fcl-js/src/jssrcmap.pas

@@ -734,7 +734,7 @@ begin
       if LastGeneratedLine<Item.GeneratedLine then
         begin
         // new line
-        //LastGeneratedColumn:=0;
+        LastGeneratedColumn:=0; // column is reset every generated line
         for j:=LastGeneratedLine+1 to Item.GeneratedLine do
           begin
           AddChar(';');
@@ -869,6 +869,7 @@ begin
       begin
       // next line
       inc(GeneratedLine);
+      LastColumn:=0;
       inc(p);
       end;
     else
@@ -1118,7 +1119,9 @@ begin
   SetLength(s,aStream.Size-aStream.Position);
   if s<>'' then
     aStream.Read(s[1],length(s));
-  if LeftStr(s,3)=')]}' then
+  if LeftStr(s,4)=')]}''' then
+    Delete(s,1,4)
+  else if LeftStr(s,3)=')]}' then
     Delete(s,1,3);
   P:=TJSONParser.Create(s,[joUTF8]);
   try

+ 2 - 0
packages/fcl-passrc/src/pasresolveeval.pas

@@ -205,6 +205,7 @@ const
   nCouldNotInferTypeArgXForMethodY = 3139;
   nInferredTypeXFromDiffArgsMismatchFromMethodY = 3140;
   nParamOfThisTypeCannotHaveDefVal = 3141;
+  nClassTypesAreNotRelatedXY = 3142;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -357,6 +358,7 @@ resourcestring
   sCouldNotInferTypeArgXForMethodY = 'Could not infer generic type argument "%s" for method "%s"';
   sInferredTypeXFromDiffArgsMismatchFromMethodY = 'Inferred type "%s" from different arguments mismatch for method "%s"';
   sParamOfThisTypeCannotHaveDefVal = 'Parameters of this type cannot have default values';
+  sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

+ 58 - 35
packages/fcl-passrc/src/pasresolver.pp

@@ -5676,7 +5676,7 @@ end;
 
 procedure TPasResolver.FinishUsesClause;
 var
-  Section, CurSection: TPasSection;
+  Section: TPasSection;
   i, j: Integer;
   PublicEl, UseModule: TPasElement;
   Scope: TPasSectionScope;
@@ -5723,25 +5723,6 @@ begin
         +UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
     UsesScope:=TPasSectionScope(PublicEl.CustomData);
 
-    // check if module was already used by a different name
-    j:=i;
-    CurSection:=Section;
-    repeat
-      dec(j);
-      if j<0 then
-        begin
-        if CurSection.ClassType<>TImplementationSection then
-          break;
-        CurSection:=CurSection.GetModule.InterfaceSection;
-        if CurSection=nil then break;
-        j:=length(CurSection.UsesClause)-1;
-        if j<0 then break;
-        end;
-      if CurSection.UsesClause[j].Module=UseModule then
-        RaiseMsg(20170503004022,nDuplicateIdentifier,sDuplicateIdentifier,
-          [UseModule.Name,GetElementSourcePosStr(CurSection.UsesClause[j])],UseUnit);
-    until false;
-
     // add full uses name
     AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
 
@@ -10805,6 +10786,24 @@ begin
         [GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
     end;
 
+  if FoundEl is TPasType then
+    begin
+      // typecast
+      TypeEl:=ResolveAliasType(TPasType(FoundEl));
+      C:=TypeEl.ClassType;
+      if C=TPasUnresolvedSymbolRef then
+        begin
+        // typecast to built-in type
+        if TypeEl.CustomData is TResElDataBaseType then
+          CheckTypeCast(TypeEl,Params,true); // emit warnings
+        end
+      else
+        begin
+        // typecast to user type
+        CheckTypeCast(TypeEl,Params,true); // emit warnings
+        end;
+    end;
+
   // FoundEl compatible element -> create reference
   Ref:=CreateReference(FoundEl,NameExpr,rraRead);
   if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
@@ -15677,16 +15676,20 @@ type
               and (NewBaseType in [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,btLongint])
               and (BaseType1<>btLongWord) and (BaseType2<>btLongWord) then
             NewBaseType:=btLongint
+          {$ifdef HasInt64}
           else if (BaseTypes[btInt64]<>nil)
               and (NewBaseType<=btInt64)
               and (BaseType1<>btQWord) and (BaseType2<>btQWord) then
             NewBaseType:=btInt64
+          {$endif}
           else if (BaseTypes[btIntDouble]<>nil)
               and (NewBaseType<=btIntDouble) then
             NewBaseType:=btIntDouble
+          {$ifdef HasInt64}
           else if (BaseTypes[btQWord]<>nil)
               and not (NewBaseType in btAllSignedInteger) then
             NewBaseType:=btQWord
+          {$endif}
           else
             NewBaseType:=GetCombinedInt(Param1Resolved,Param2Resolved,ErrorPos);
           end
@@ -26116,8 +26119,18 @@ end;
 function TPasResolver.CheckTypeCastRes(const FromResolved,
   ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
   ): integer;
+
+  procedure WarnClassTypesAreNotRelated(GotType, ExpType: TPasClassType);
+  var
+    GotDesc, ExpDesc: String;
+  begin
+    GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
+    LogMsg(20200209140450,mtWarning,nClassTypesAreNotRelatedXY,
+      sClassTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
+  end;
+
 var
-  ToTypeEl, ToClassType, FromClassType, FromTypeEl: TPasType;
+  ToTypeEl, ToType, FromType, FromTypeEl: TPasType;
   ToTypeBaseType: TResolverBaseType;
   C: TClass;
   ToProcType, FromProcType: TPasProcedureType;
@@ -26125,6 +26138,7 @@ var
   i: Integer;
   ConToken: TToken;
   ConEl: TPasElement;
+  ToClassType, FromClassType: TPasClassType;
 begin
   Result:=cIncompatible;
   ToTypeEl:=ToResolved.LoTypeEl;
@@ -26244,34 +26258,36 @@ begin
       end
     else if C=TPasClassType then
       begin
+      ToClassType:=TPasClassType(ToTypeEl);
       // to class
       if FromResolved.BaseType=btContext then
         begin
         FromTypeEl:=FromResolved.LoTypeEl;
         if FromTypeEl.ClassType=TPasClassType then
           begin
+          FromClassType:=TPasClassType(FromTypeEl);
           if FromResolved.IdentEl is TPasType then
             RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
-          if TPasClassType(FromTypeEl).ObjKind=TPasClassType(ToTypeEl).ObjKind then
+          if FromClassType.ObjKind=ToClassType.ObjKind then
             begin
             // type cast upwards or downwards
             Result:=CheckSrcIsADstType(FromResolved,ToResolved);
             if Result=cIncompatible then
               Result:=CheckSrcIsADstType(ToResolved,FromResolved);
             end
-          else if TPasClassType(ToTypeEl).ObjKind=okInterface then
+          else if ToClassType.ObjKind=okInterface then
             begin
-            if (TPasClassType(FromTypeEl).ObjKind=okClass)
-                and (not TPasClassType(FromTypeEl).IsExternal) then
+            if (FromClassType.ObjKind=okClass)
+                and (not FromClassType.IsExternal) then
               begin
               // e.g. intftype(classinstvar)
               Result:=cCompatible;
               end;
             end
-          else if TPasClassType(FromTypeEl).ObjKind=okInterface then
+          else if FromClassType.ObjKind=okInterface then
             begin
-            if (TPasClassType(ToTypeEl).ObjKind=okClass)
-                and (not TPasClassType(ToTypeEl).IsExternal) then
+            if (ToClassType.ObjKind=okClass)
+                and (not ToClassType.IsExternal) then
               begin
               // e.g. classtype(intfvar)
               Result:=cCompatible;
@@ -26279,6 +26295,12 @@ begin
             end;
           if Result=cIncompatible then
             Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
+          if (Result=cIncompatible) and (FromClassType.ObjKind=ToClassType.ObjKind) then
+            begin
+            if RaiseOnError then
+              WarnClassTypesAreNotRelated(FromClassType,ToClassType);
+            Result:=cTypeConversion;
+            end;
           end
         else if FromTypeEl.ClassType=TPasGenericTemplateType then
           begin
@@ -26354,9 +26376,9 @@ begin
           if (FromResolved.IdentEl is TPasType) then
             RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
           // type cast  classof(classof-var)  upwards or downwards
-          ToClassType:=TPasClassOfType(ToTypeEl).DestType;
-          FromClassType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
-          Result:=CheckClassesAreRelated(ToClassType,FromClassType);
+          ToType:=TPasClassOfType(ToTypeEl).DestType;
+          FromType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
+          Result:=CheckClassesAreRelated(ToType,FromType);
           end;
         end
       else if FromResolved.BaseType=btPointer then
@@ -26541,9 +26563,9 @@ begin
             and (ToTypeEl=ToResolved.IdentEl) then
           begin
           // for example  class-of(Self) in a class function
-          ToClassType:=TPasClassOfType(ToTypeEl).DestType;
-          FromClassType:=TPasClassType(FromTypeEl);
-          Result:=CheckClassesAreRelated(ToClassType,FromClassType);
+          ToType:=TPasClassOfType(ToTypeEl).DestType;
+          FromType:=TPasClassType(FromTypeEl);
+          Result:=CheckClassesAreRelated(ToType,FromType);
           end;
         end;
       end;
@@ -27930,7 +27952,8 @@ begin
   Templates:=GetProcTemplateTypes(Proc);
   if (Templates<>nil) and (Templates.Count>0) then
     exit(false);
-  if ProcScope.SpecializedFromItem=nil then exit(true);
+  if ProcScope.SpecializedFromItem=nil then
+    exit(true);
   Params:=ProcScope.SpecializedFromItem.Params;
   for i:=0 to length(Params)-1 do
     if Params[i] is TPasGenericTemplateType then exit(false);

+ 27 - 5
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -198,7 +198,8 @@ type
 
   TPasAnalyzerOption = (
     paoOnlyExports, // default: use all class members accessible from outside (protected, but not private)
-    paoImplReferences // collect references of top lvl proc implementations, initializationa dn finalization sections
+    paoImplReferences, // collect references of top lvl proc implementations, initializationa dn finalization sections
+    paoSkipGenericProc // ignore generic procedure body
     );
   TPasAnalyzerOptions = set of TPasAnalyzerOption;
 
@@ -1078,6 +1079,7 @@ function TPasAnalyzer.CanSkipGenericProc(DeclProc: TPasProcedure): boolean;
 
 var
   Templates: TFPList;
+  Parent: TPasElement;
 begin
   Result:=false;
   if ScopeModule=nil then
@@ -1091,10 +1093,30 @@ begin
     // analyze a module
     Templates:=Resolver.GetProcTemplateTypes(DeclProc);
     if (Templates<>nil) and (Templates.Count>0) then
-      // generic template -> analyze
+      begin
+      // generic procedure
+      if paoSkipGenericProc in Options then
+        exit(true); // emit no hints for generic proc
+      // -> analyze
+      end
     else if not Resolver.IsFullySpecialized(DeclProc) then
       // half specialized -> skip
-      exit(true);
+      exit(true)
+    else if paoSkipGenericProc in Options then
+      begin
+      Parent:=DeclProc.Parent;
+      while Parent<>nil do
+        begin
+        if (Parent is TPasGenericType) then
+          begin
+          Templates:=TPasGenericType(Parent).GenericTemplateTypes;
+          if (Templates<>nil) and (Templates.Count>0) then
+            // procedure of a generic parent -> emit no hints
+            exit(true);
+          end;
+        Parent:=Parent.Parent;
+        end;
+      end;
     end;
 end;
 
@@ -1923,10 +1945,10 @@ begin
   if Proc.Parent is TPasMembersType then
     UseClassOrRecType(TPasMembersType(Proc.Parent),paumElement);
 
-  UseScopeReferences(ProcScope.References);
-
   UseProcedureType(Proc.ProcType);
 
+  UseScopeReferences(ProcScope.References);
+
   ImplProc:=Proc;
   if ProcScope.ImplProc<>nil then
     ImplProc:=ProcScope.ImplProc;

+ 7 - 21
packages/fcl-passrc/src/pparser.pp

@@ -3792,16 +3792,6 @@ function TPasParser.AddUseUnit(ASection: TPasSection;
         ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
   end;
 
-  procedure CheckDuplicateInUsesList(UnitRef: TPasElement; UsesClause: TPasUsesClause);
-  var
-    i: Integer;
-  begin
-    if UsesClause=nil then exit;
-    for i:=0 to length(UsesClause)-1 do
-      if UsesClause[i].Module=UnitRef then
-        ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
-  end;
-
 var
   UnitRef: TPasElement;
   UsesUnit: TPasUsesUnit;
@@ -3820,22 +3810,18 @@ begin
       ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
       end;
 
+    // Note: The alias (AUnitName) must be unique within a module.
+    //       Using an unit module twice with different alias is allowed.
+    CheckDuplicateInUsesList(ASection.UsesClause);
+    if ASection.ClassType=TImplementationSection then
+      CheckDuplicateInUsesList(CurModule.InterfaceSection.UsesClause);
+
     UnitRef := Engine.FindModule(AUnitName,NameExpr,InFileExpr);
     if Assigned(UnitRef) then
-      begin
-      UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF};
-      CheckDuplicateInUsesList(UnitRef,ASection.UsesClause);
-      if ASection.ClassType=TImplementationSection then
-        CheckDuplicateInUsesList(UnitRef,CurModule.InterfaceSection.UsesClause);
-      end
+      UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF}
     else
-      begin
-      CheckDuplicateInUsesList(ASection.UsesClause);
-      if ASection.ClassType=TImplementationSection then
-        CheckDuplicateInUsesList(CurModule.InterfaceSection.UsesClause);
       UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef,
         AUnitName, ASection, NamePos));
-      end;
 
     UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos));
     Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit);

+ 1 - 3
packages/fcl-passrc/src/pscanner.pp

@@ -1161,9 +1161,6 @@ const
     'DispatchStrField' // vsDispatchStrField
     );
 
-const
-  AllLanguageModes = [msFPC,msObjFPC,msDelphi,msTP7,msMac,msISO,msExtPas];
-
 const
   MessageTypeNames : Array[TMessageType] of string = (
     'Fatal','Error','Warning','Note','Hint','Info','Debug'
@@ -1172,6 +1169,7 @@ const
 const
   // all mode switches supported by FPC
   msAllModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
+  AllLanguageModes = [msFPC..msGPC];
 
   DelphiModeSwitches = [msDelphi,msClass,msObjpas,msResult,msStringPchar,
      msPointer2Procedure,msAutoDeref,msTPProcVar,msInitFinal,msDefaultAnsistring,

+ 53 - 25
packages/fcl-passrc/tests/tcresolver.pas

@@ -370,7 +370,7 @@ type
     Procedure TestUnit_DottedUnit;
     Procedure TestUnit_DottedExpr;
     Procedure TestUnit_DuplicateDottedUsesFail;
-    Procedure TestUnit_DuplicateUsesDiffNameFail;
+    Procedure TestUnit_DuplicateUsesDiffName;
     Procedure TestUnit_Unit1DotUnit2Fail;
     Procedure TestUnit_InFilename;
     Procedure TestUnit_InFilenameAliasDelphiFail;
@@ -379,6 +379,7 @@ type
     Procedure TestUnit_UnitNotFoundErrorPos;
     Procedure TestUnit_AccessIndirectUsedUnitFail;
     Procedure TestUnit_Intf1Impl2Intf1;
+    Procedure TestUnit_Intf1Impl2Intf1_Duplicate;
 
     // procs
     Procedure TestProcParam;
@@ -591,7 +592,7 @@ type
     Procedure TestClass_OperatorAsOnNonTypeFail;
     Procedure TestClassAsFuncResult;
     Procedure TestClassTypeCast;
-    Procedure TestClassTypeCastUnrelatedFail;
+    Procedure TestClassTypeCastUnrelatedWarn;
     Procedure TestClass_TypeCastSelf;
     Procedure TestClass_TypeCaseMultipleParamsFail;
     Procedure TestClass_TypeCastAssign;
@@ -2386,8 +2387,13 @@ function TCustomTestResolver.OnPasResolverFindUnit(SrcResolver: TPasResolver;
     {$ENDIF}
     CurEngine:=FindModuleWithFilename(aFilename);
     if CurEngine=nil then exit(false);
-    aModule:=InitUnit(CurEngine);
-    if aModule=nil then exit(false);
+    if CurEngine.Module=nil then
+      begin
+      aModule:=InitUnit(CurEngine);
+      if aModule=nil then exit(false);
+      end
+    else
+      aModule:=CurEngine.Module;
     OnPasResolverFindUnit:=aModule;
     Result:=true;
   end;
@@ -5924,7 +5930,7 @@ begin
     nParserDuplicateIdentifier);
 end;
 
-procedure TTestResolver.TestUnit_DuplicateUsesDiffNameFail;
+procedure TTestResolver.TestUnit_DuplicateUsesDiffName;
 begin
   MainFilename:='unitdots.main1.pas';
   AddModuleWithIntfImplSrc('unitdots.unit1.pp',
@@ -5942,8 +5948,7 @@ begin
   '  if unit1.j1=0 then ;',
   '  if unitdots.unit1.j1=0 then ;',
   '']);
-  CheckParserException('Duplicate identifier "unit1" at token ";" in file unitdots.main1.pas at line 2 column 27',
-    nParserDuplicateIdentifier);
+  ParseProgram;
 end;
 
 procedure TTestResolver.TestUnit_Unit1DotUnit2Fail;
@@ -6092,6 +6097,27 @@ begin
   ParseUnit;
 end;
 
+procedure TTestResolver.TestUnit_Intf1Impl2Intf1_Duplicate;
+begin
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'type number = longint;']),
+    LinesToStr([
+    'uses afile;',
+    'procedure DoIt;',
+    'begin',
+    '  i:=3;',
+    'end;']));
+
+  StartUnit(true);
+  Add([
+  'interface',
+  'uses unit1, foo in ''unit1.pp'';',
+  'var i: number;',
+  'implementation']);
+  ParseUnit;
+end;
+
 procedure TTestResolver.TestProcParam;
 begin
   StartProgram(false);
@@ -10324,26 +10350,28 @@ begin
   ParseProgram;
 end;
 
-procedure TTestResolver.TestClassTypeCastUnrelatedFail;
+procedure TTestResolver.TestClassTypeCastUnrelatedWarn;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  {#TOBJ}TObject = class');
-  Add('  end;');
-  Add('  {#A}TClassA = class');
-  Add('    id: longint;');
-  Add('  end;');
-  Add('  {#B}TClassB = class');
-  Add('    Name: string;');
-  Add('  end;');
-  Add('var');
-  Add('  {#o}{=TOBJ}o: TObject;');
-  Add('  {#va}{=A}va: TClassA;');
-  Add('  {#vb}{=B}vb: TClassB;');
-  Add('begin');
-  Add('  {@vb}vb:=TClassB({@va}va);');
-  CheckResolverException('Illegal type conversion: "TClassA" to "class TClassB"',
-    nIllegalTypeConversionTo);
+  Add([
+  'type',
+  '  {#TOBJ}TObject = class',
+  '  end;',
+  '  {#A}TClassA = class',
+  '    id: longint;',
+  '  end;',
+  '  {#B}TClassB = class',
+  '    Name: string;',
+  '  end;',
+  'var',
+  '  {#o}{=TOBJ}o: TObject;',
+  '  {#va}{=A}va: TClassA;',
+  '  {#vb}{=B}vb: TClassB;',
+  'begin',
+  '  {@vb}vb:=TClassB({@va}va);']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nClassTypesAreNotRelatedXY,'Class types "TClassA" and "TClassB" are not related');
+  CheckResolverUnexpectedHints;
 end;
 
 procedure TTestResolver.TestClass_TypeCastSelf;

+ 121 - 16
packages/pastojs/src/fppas2js.pp

@@ -499,6 +499,7 @@ const
   nBitWiseOperationIs32Bit = 4028;
   nDuplicateMessageIdXAtY = 4029;
   nDispatchRequiresX = 4030;
+  nConstRefNotForXAsConst = 4031;
 // resourcestring patterns of messages
 resourcestring
   sPasElementNotSupported = 'Pascal element not supported: %s';
@@ -531,6 +532,7 @@ resourcestring
   sBitWiseOperationIs32Bit = 'Bitwise operation is 32-bit';
   sDuplicateMessageIdXAtY = 'Duplicate message id "%s" at %s';
   sDispatchRequiresX = 'Dispatch requires %s';
+  sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const';
 
 const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
@@ -1453,6 +1455,7 @@ type
     function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
     function HasAnonymousFunctions(El: TPasImplElement): boolean;
     function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
+    function ProcCanBePrecompiled(DeclProc: TPasProcedure): boolean; virtual;
     function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
     function IsExternalBracketAccessor(El: TPasElement): boolean;
     function IsExternalClassConstructor(El: TPasElement): boolean;
@@ -2926,6 +2929,7 @@ var
   ElevatedLocals: TPas2jsElevatedLocals;
 begin
   Result:=0;
+  //if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' ',HasOverloadIndex(El,true));
   if not HasOverloadIndex(El,true) then exit;
 
   ThisChanged:=false;
@@ -2946,6 +2950,7 @@ begin
 
       // check elevated locals
       ElevatedLocals:=GetElevatedLocals(Scope);
+      // if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' ',Scope.Element.ClassName,' ',ElevatedLocals<>nil);
       if ElevatedLocals<>nil then
         begin
         Identifier:=ElevatedLocals.Find(El.Name);
@@ -3057,6 +3062,7 @@ var
 begin
   // => count overloads in this section
   OverloadIndex:=GetOverloadIndex(El);
+  //if SameText(El.Name,'ci') then writeln('TPas2JSResolver.RenameOverload ',GetObjPath(El),' ',OverloadIndex);
   if OverloadIndex=0 then
     exit(false); // there is no overload
 
@@ -3182,16 +3188,51 @@ begin
 end;
 
 procedure TPas2JSResolver.RenameSubOverloads(Declarations: TFPList);
+
+  procedure RestoreScopeLvl(OldScopeCount: integer);
+  begin
+    while FOverloadScopes.Count>OldScopeCount do
+      PopOverloadScope;
+  end;
+
+  procedure LocalPushClassOrRecScopes(Scope: TPasClassOrRecordScope);
+  var
+    CurScope: TPasClassOrRecordScope;
+    aParent: TPasElement;
+  begin
+    CurScope:=Scope;
+    repeat
+      PushOverloadScope(CurScope);
+      if Scope is TPas2JSClassScope then
+        CurScope:=TPas2JSClassScope(CurScope).AncestorScope
+      else
+        break;
+    until CurScope=nil;
+    aParent:=Scope.Element.Parent;
+    if not (aParent is TPasMembersType) then
+      exit;
+    // nested class -> push parent class scope...
+    CurScope:=aParent.CustomData as TPasClassOrRecordScope;
+    LocalPushClassOrRecScopes(CurScope);
+  end;
+
 var
   i, OldScopeCount: Integer;
   El: TPasElement;
-  Proc: TPasProcedure;
-  ProcScope: TPasProcedureScope;
+  Proc, ImplProc: TPasProcedure;
+  ProcScope, ImplProcScope: TPas2JSProcedureScope;
   ClassScope, aScope: TPasClassScope;
   ClassEl: TPasClassType;
   C: TClass;
   ProcBody: TProcedureBody;
+  IntfSection: TInterfaceSection;
+  ImplSection: TImplementationSection;
 begin
+  IntfSection:=RootElement.InterfaceSection;
+  if IntfSection<>nil then
+    ImplSection:=RootElement.ImplementationSection
+  else
+    ImplSection:=nil;
   for i:=0 to Declarations.Count-1 do
     begin
     El:=TPasElement(Declarations[i]);
@@ -3199,26 +3240,49 @@ begin
     if C.InheritsFrom(TPasProcedure) then
       begin
       Proc:=TPasProcedure(El);
-      ProcScope:=Proc.CustomData as TPasProcedureScope;
+      ProcScope:=Proc.CustomData as TPas2JSProcedureScope;
+
+      // handle each Proc only once, by handling only the DeclProc,
+      // except for DeclProc in the unit interface
       if ProcScope.DeclarationProc<>nil then
-        continue;
-      if ProcScope.ImplProc<>nil then
         begin
-        Proc:=ProcScope.ImplProc;
-        ProcScope:=TPasProcedureScope(Proc.CustomData);
+        // ImplProc with separate declaration
+        if (Proc.Parent=ImplSection)
+        and ProcScope.DeclarationProc.HasParent(IntfSection) then
+          // ImplProc in unit implementation, DeclProc in unit interface
+          // Note: The Unit Impl elements are renamed in a separate run, aka now
+        else
+          continue; // handled via DeclProc
+        end;
+      ImplProc:=ProcScope.ImplProc;
+      if ImplProc<>nil then
+        ImplProcScope:=TPas2JSProcedureScope(ImplProc.CustomData)
+      else
+        begin
+        ImplProc:=Proc;
+        ImplProcScope:=ProcScope;
         end;
       {$IFDEF VerbosePas2JS}
-      //writeln('TPas2JSResolver.RenameSubOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassOrRecordScope));
+      //writeln('TPas2JSResolver.RenameSubOverloads ImplProc=',ImplProc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ClassScope=',GetObjName(ImplProcScope.ClassOrRecordScope));
       {$ENDIF}
-      ProcBody:=Proc.Body;
+      ProcBody:=ImplProc.Body;
       if ProcBody<>nil then
         begin
-        PushOverloadScope(ProcScope);
+        OldScopeCount:=FOverloadScopes.Count;
+        if (ImplProcScope.ClassRecScope<>nil)
+            and not (Proc.Parent is TPasMembersType) then
+          begin
+          // push class scopes
+          LocalPushClassOrRecScopes(ImplProcScope.ClassRecScope);
+          end;
+
+        PushOverloadScope(ImplProcScope);
         // first rename all overloads on this level
         RenameOverloads(ProcBody,ProcBody.Declarations);
         // then process nested procedures
         RenameSubOverloads(ProcBody.Declarations);
         PopOverloadScope;
+        RestoreScopeLvl(OldScopeCount);
         end;
       end
     else if (C=TPasClassType) or (C=TPasRecordType) then
@@ -3250,8 +3314,7 @@ begin
       RenameSubOverloads(TPasMembersType(El).Members);
 
       // restore scope
-      while FOverloadScopes.Count>OldScopeCount do
-        PopOverloadScope;
+      RestoreScopeLvl(OldScopeCount);
       end;
     end;
   {$IFDEF VerbosePas2JS}
@@ -3938,13 +4001,15 @@ end;
 procedure TPas2JSResolver.FinishArgument(El: TPasArgument);
 var
   TypeEl, ElTypeEl: TPasType;
+  C: TClass;
 begin
   inherited FinishArgument(El);
   if El.ArgType<>nil then
     begin
     TypeEl:=ResolveAliasType(El.ArgType);
+    C:=TypeEl.ClassType;
 
-    if TypeEl.ClassType=TPasPointerType then
+    if C=TPasPointerType then
       begin
       ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
       if ElTypeEl.ClassType=TPasRecordType then
@@ -3952,6 +4017,15 @@ begin
       else
         RaiseMsg(20180423110239,nNotSupportedX,sNotSupportedX,['pointer'],El);
       end;
+
+    if El.Access=argConstRef then
+      begin
+      if (C=TPasRecordType) or (C=TPasArrayType) then
+        // argConstRef works same as argConst for records -> ok
+      else
+        LogMsg(20191215133912,mtWarning,nConstRefNotForXAsConst,sConstRefNotForXAsConst,
+          [GetElementTypeName(TypeEl)],El);
+      end;
     end;
 end;
 
@@ -5926,6 +6000,37 @@ begin
     end;
 end;
 
+function TPas2JSResolver.ProcCanBePrecompiled(DeclProc: TPasProcedure): boolean;
+var
+  El: TPasElement;
+  TemplTypes: TFPList;
+  ProcScope: TPas2JSProcedureScope;
+  GenScope: TPasGenericScope;
+begin
+  if GetProcTemplateTypes(DeclProc)<>nil then
+    exit(false); // generic DeclProc
+  ProcScope:=DeclProc.CustomData as TPas2JSProcedureScope;
+  if ProcScope.SpecializedFromItem<>nil then
+    exit(false); // specialized generic DeclProc
+  El:=DeclProc;
+  repeat
+    El:=El.Parent;
+    if El=nil then
+      exit(true); // ok
+    if El is TPasProcedure then
+      exit(false); // DeclProc is a local DeclProc
+    if El is TPasGenericType then
+      begin
+      TemplTypes:=TPasGenericType(El).GenericTemplateTypes;
+      if (TemplTypes<>nil) and (TemplTypes.Count>0) then
+        exit(false); // method of a generic class/record type
+      GenScope:=El.CustomData as TPasGenericScope;
+      if GenScope.SpecializedFromItem<>nil then
+        exit(false); // method of a specialized class/record type
+      end;
+  until false;
+end;
+
 function TPas2JSResolver.IsTObjectFreeMethod(El: TPasExpr): boolean;
 var
   Ref: TResolvedReference;
@@ -14975,7 +15080,7 @@ begin
 
   if (coStoreImplJS in Options) and (aResolver<>nil) then
     begin
-    if aResolver.GetTopLvlProc(El)=El then
+    if aResolver.ProcCanBePrecompiled(El) then
       begin
       ImplProcScope.BodyJS:=CreatePrecompiledJS(Result);
       ImplProcScope.EmptyJS:=BodyPas.Body=nil;
@@ -17348,7 +17453,7 @@ begin
   // add flags
   case Arg.Access of
     argDefault: ;
-    argConst: inc(Flags,pfConst);
+    argConst,argConstRef: inc(Flags,pfConst);
     argVar: inc(Flags,pfVar);
     argOut: inc(Flags,pfOut);
   else
@@ -22314,7 +22419,7 @@ begin
     exit;
     end;
 
-  if not (TargetArg.Access in [argDefault,argVar,argOut,argConst]) then
+  if not (TargetArg.Access in [argDefault,argVar,argOut,argConst,argConstRef]) then
     DoError(20170213220927,nPasElementNotSupported,sPasElementNotSupported,
             [AccessNames[TargetArg.Access]],El);
   aResolver:=AContext.Resolver;

+ 47 - 13
packages/pastojs/src/fppjssrcmap.pp

@@ -44,6 +44,7 @@ type
 
   TPas2JSMapper = class(TBufferWriter)
   private
+    FPCUExt: string;
     FDestFileName: String;
     FSrcMap: TPas2JSSrcMap;
     procedure SetSrcMap(const AValue: TPas2JSSrcMap);
@@ -52,16 +53,19 @@ type
     FGeneratedStartLine: integer; // first line where CurElement was set or a line was written
     // last valid CurElement position
     FSrcFilename: String;
+    FSrcIsBinary: boolean;
     FSrcLine: integer;
     FSrcColumn: integer;
     procedure SetCurElement(const AValue: TJSElement); override;
+    procedure SetSrcFilename(Value: string); virtual;
     procedure Writing; override;
   public
     property SrcMap: TPas2JSSrcMap read FSrcMap write SetSrcMap;
     destructor Destroy; override;
     procedure WriteFile(Src, Filename: string);
     // Final destination filename. Usually unit, unless combining javascript in single file.
-    Property DestFileName : String Read FDestFileName Write FDestFileName;
+    property DestFileName : String read FDestFileName Write FDestFileName;
+    property PCUExt: string read FPCUExt write FPCUExt;
   end;
 
 implementation
@@ -97,6 +101,7 @@ end;
 procedure TPas2JSMapper.SetCurElement(const AValue: TJSElement);
 var
   C: TClass;
+  NewSrcFilename: String;
 begin
   {$IFDEF VerboseSrcMap}
   system.write('TPas2JSMapper.SetCurElement ',CurLine,',',CurColumn);
@@ -112,26 +117,38 @@ begin
       or (C=TJSEmptyStatement) then
     exit; // do not switch position on brackets
 
-  if (AValue<>nil) and (AValue.Source<>'') then
+  if (AValue<>nil) then
     begin
-    if (FSrcFilename<>AValue.Source)
-        or (FSrcLine<>AValue.Line)
-        or (FSrcColumn<>AValue.Column) then
+    NewSrcFilename:=AValue.Source;
+    if NewSrcFilename<>'' then
       begin
-      FNeedMapping:=true;
-      FSrcFilename:=AValue.Source;
-      FSrcLine:=AValue.Line;
-      FSrcColumn:=AValue.Column;
+      if (FSrcFilename<>NewSrcFilename)
+          or (FSrcLine<>AValue.Line)
+          or (FSrcColumn<>AValue.Column) then
+        begin
+        FNeedMapping:=true;
+        SetSrcFilename(NewSrcFilename);
+        FSrcLine:=AValue.Line;
+        FSrcColumn:=AValue.Column;
+        end;
       end;
     end;
   if FGeneratedStartLine<1 then
     FGeneratedStartLine:=CurLine;
 end;
 
+procedure TPas2JSMapper.SetSrcFilename(Value: string);
+begin
+  if FSrcFilename=Value then exit;
+  FSrcFilename:=Value;
+  FSrcIsBinary:=SameText(ExtractFileExt(Value),FPCUExt);
+end;
+
 procedure TPas2JSMapper.Writing;
 var
   S: TJSString;
-  p, l, Line: Integer;
+  p, l, Line, CurSrcLine, CurSrcColumn: Integer;
+  CurSrcFilename: String;
 begin
   inherited Writing;
   if SrcMap=nil then exit;
@@ -143,12 +160,29 @@ begin
   if FSrcFilename='' then
     exit; // built-in element -> do not add a mapping
 
+  if FSrcIsBinary then
+    begin
+    // precompiled js -> map to js
+    CurSrcFilename:=DestFileName;
+    CurSrcLine:=CurLine;
+    CurSrcColumn:=CurColumn;
+    FSrcLine:=CurLine;
+    FSrcColumn:=1;
+    end
+  else
+    begin
+    CurSrcFilename:=FSrcFilename;
+    CurSrcLine:=FSrcLine;
+    CurSrcColumn:=FSrcColumn;
+    end;
+  //system.writeln('TPas2JSMapper.Writing ',FSrcFilename);
+
   FNeedMapping:=false;
   //system.writeln('TPas2JSMapper.Writing Generated.Line=',CurLine,',Col=',CurColumn-1,
   //  ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine,',Col=',FSrcColumn-1);
 
   SrcMap.AddMapping(CurLine,Max(0,CurColumn-1),
-    FSrcFilename,Max(0,FSrcLine),Max(0,FSrcColumn-1));
+    CurSrcFilename,Max(0,CurSrcLine),Max(0,CurSrcColumn-1));
 
   if (CurElement is TJSLiteral)
       and (TJSLiteral(CurElement).Value.CustomValue<>'') then
@@ -171,7 +205,7 @@ begin
         //system.writeln('TPas2JSMapper.Writing Generated.Line=',CurLine+Line,',Col=',0,
         //  ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine+Line,',Col=',0);
         SrcMap.AddMapping(CurLine+Line,0,
-          FSrcFilename,FSrcLine+Line,0);
+          CurSrcFilename,CurSrcLine+Line,0);
         end;
       else
         inc(p);
@@ -190,7 +224,7 @@ var
   l, p, LineStart: integer;
 begin
   if Src='' then exit;
-  FSrcFilename:=Filename;
+  SetSrcFilename(Filename);
   FSrcLine:=1;
   FSrcColumn:=1;
   l:=length(Src);

+ 168 - 40
packages/pastojs/src/pas2jscompiler.pp

@@ -53,7 +53,7 @@ const
 const
   nOptionIsEnabled = 101; sOptionIsEnabled = 'Option "%s" is %s';
   nSyntaxModeIs = 102; sSyntaxModeIs = 'Syntax mode is %s';
-  // was: nMacroDefined = 103
+  nModeswitchXisY = 103; sModeswitchXisY = 'Modeswitch %s is %s';
   // 104 in unit Pas2JSFS
   // 105 in unit Pas2JSFS
   nNameValue = 106; sNameValue = '%s: %s';
@@ -125,6 +125,7 @@ type
     // features
     coAllowCAssignments,
     coAllowMacros,
+    coWriteableConst,
     // output
     coLowerCase,
     coUseStrict,
@@ -153,7 +154,7 @@ type
   TResourceMode = (rmNone,rmHTML,rmJS);
 
 const
-  DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict];
+  DefaultP2jsCompilerOptions = [coShowErrors,coWriteableConst,coUseStrict,coSourceMapXSSIHeader];
   DefaultP2JSResourceStringFile = rsfProgram;
   DefaultP2jsRTLVersionCheck = rvcNone;
   DefaultResourceMode = rmHTML;
@@ -185,6 +186,7 @@ const
     'Assertions',
     'Allow C assignments',
     'Allow macros',
+    'Allows typed constants to be writeable',
     'Lowercase identifiers',
     'Use strict',
     'Write pas2jsdebug.log',
@@ -489,7 +491,7 @@ type
     FMainJSFileIsResolved: Boolean;
     FMainJSFileResolved: String;
     FMainSrcFile: String;
-    FMode: TP2jsMode;
+    FModeSwitches: TModeSwitches;
     FNamespaces: TStringList;
     FNamespacesFromCmdLine: integer;
     FOptions: TP2jsCompilerOptions;
@@ -541,6 +543,7 @@ type
     procedure SetCompilerExe(AValue: string);
     procedure SetFS(AValue: TPas2jsFS);
     procedure SetMode(AValue: TP2jsMode);
+    procedure SetModeSwitches(const AValue: TModeSwitches);
     procedure SetOptions(AValue: TP2jsCompilerOptions);
     procedure SetShowDebug(AValue: boolean);
     procedure SetShowFullPaths(AValue: boolean);
@@ -600,6 +603,7 @@ type
     procedure HandleOptionPCUFormat(aValue: String); virtual;
     function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): Boolean; virtual;
     function HandleOptionJ(C: Char; aValue: String; Quick,FromCmdLine: Boolean): Boolean; virtual;
+    function HandleOptionM(aValue: String; Quick: Boolean): Boolean; virtual;
     procedure HandleOptionConfigFile(aPos: Integer; const aFileName: string); virtual;
     procedure HandleOptionInfo(aValue: string);
     // DoWriteJSFile: return false to use the default write function.
@@ -660,8 +664,9 @@ type
     function IsDefined(const aName: String): boolean;
     procedure SetOption(Flag: TP2jsCompilerOption; Enable: boolean);
 
-    function GetUnitInfo(const UseUnitName, InFileName, ModuleDir: String;
+    function GetUnitInfo(UseUnitName, InFileName, ModuleDir: String;
       PCUSupport: TPCUSupport): TFindUnitInfo;
+    procedure CheckUnitAlias(var UseUnitName: string); virtual;
     function FindFileWithUnitFilename(UnitFilename: string): TPas2jsCompilerFile;
     procedure LoadModuleFile(UnitFilename, UseUnitName: string;
       out aFile: TPas2jsCompilerFile; isPCU: Boolean);
@@ -680,7 +685,7 @@ type
     property InterfaceType: TPasClassInterfaceType read FInterfaceType write FInterfaceType;
     property Log: TPas2jsLogger read FLog;
     property MainFile: TPas2jsCompilerFile read FMainFile;
-    property Mode: TP2jsMode read FMode write SetMode;
+    property ModeSwitches: TModeSwitches read FModeSwitches write SetModeSwitches;
     property Options: TP2jsCompilerOptions read FOptions write SetOptions;
     property ConverterGlobals: TPasToJSConverterGlobals read FConverterGlobals write SetConverterGlobals;
     property ParamMacros: TPas2jsMacroEngine read FParamMacros;
@@ -999,7 +1004,7 @@ end;
 
 function TPas2jsCompilerFile.GetInitialModeSwitches: TModeSwitches;
 begin
-  Result:=p2jsMode_SwitchSets[Compiler.Mode];
+  Result:=Compiler.ModeSwitches;
 end;
 
 function TPas2jsCompilerFile.GetInitialBoolSwitches: TBoolSwitches;
@@ -1007,8 +1012,12 @@ var
   bs: TBoolSwitches;
 begin
   bs:=[bsLongStrings,bsWriteableConst];
-  if coAllowMacros in Compiler.Options then
-    Include(bs,bsMacro);
+  if coShowHints in Compiler.Options then
+    Include(bs,bsHints);
+  if coShowNotes in Compiler.Options then
+    Include(bs,bsNotes);
+  if coShowWarnings in Compiler.Options then
+    Include(bs,bsWarnings);
   if coOverflowChecks in Compiler.Options then
     Include(bs,bsOverflowChecks);
   if coRangeChecks in Compiler.Options then
@@ -1017,12 +1026,10 @@ begin
     Include(bs,bsObjectChecks);
   if coAssertions in Compiler.Options then
     Include(bs,bsAssertions);
-  if coShowHints in Compiler.Options then
-    Include(bs,bsHints);
-  if coShowNotes in Compiler.Options then
-    Include(bs,bsNotes);
-  if coShowWarnings in Compiler.Options then
-    Include(bs,bsWarnings);
+  if coAllowMacros in Compiler.Options then
+    Include(bs,bsMacro);
+  if not (coWriteableConst in Compiler.Options) then
+    Exclude(bs,bsWriteableConst);
   Result:=bs;
 end;
 
@@ -1084,8 +1091,6 @@ begin
   Scanner.CurrentValueSwitch[vsInterfaces]:=InterfaceTypeNames[Compiler.InterfaceType];
   if coAllowCAssignments in Compiler.Options then
     Scanner.Options:=Scanner.Options+[po_cassignments];
-  if Compiler.Mode=p2jmDelphi then
-    Scanner.Options:=Scanner.Options+[po_delphi];
   // Note: some Scanner.Options are set by TPasResolver
   for i:=0 to Compiler.Defines.Count-1 do
     begin
@@ -1948,7 +1953,7 @@ begin
 
   // check modeswitches
   ms:=StrToModeSwitch(aName);
-  if (ms<>msNone) and (ms in p2jsMode_SwitchSets[Compiler.Mode]) then
+  if (ms<>msNone) and (ms in Compiler.ModeSwitches) then
   begin
     Value:=CondDirectiveBool[true];
     exit(true);
@@ -3067,14 +3072,19 @@ end;
 
 procedure TPas2jsCompiler.SetMode(AValue: TP2jsMode);
 begin
-  if FMode=AValue then Exit;
-  FMode:=AValue;
-  case FMode of
+  SetModeSwitches(p2jsMode_SwitchSets[AValue]);
+  case AValue of
     p2jmObjFPC: Options:=Options-[coAllowCAssignments];
     p2jmDelphi: Options:=Options-[coAllowCAssignments];
   end;
 end;
 
+procedure TPas2jsCompiler.SetModeSwitches(const AValue: TModeSwitches);
+begin
+  if FModeSwitches=AValue then Exit;
+  FModeSwitches:=AValue;
+end;
+
 procedure TPas2jsCompiler.SetOptions(AValue: TP2jsCompilerOptions);
 begin
   if FOptions=AValue then Exit;
@@ -3236,6 +3246,7 @@ begin
   LastMsgNumber:=-1;
   r(mtInfo,nOptionIsEnabled,sOptionIsEnabled);
   r(mtInfo,nSyntaxModeIs,sSyntaxModeIs);
+  r(mtInfo,nModeswitchXisY,sModeswitchXisY);
   LastMsgNumber:=-1; // was nMacroDefined 103
   r(mtInfo,nUsingPath,sUsingPath);
   r(mtNote,nFolderNotFound,sFolderNotFound);
@@ -3578,6 +3589,49 @@ begin
   end;
 end;
 
+function TPas2jsCompiler.HandleOptionM(aValue: String; Quick: Boolean): Boolean;
+var
+  Negated: Boolean;
+  ms: TModeSwitch;
+begin
+  Result:=True;
+  if aValue='' then
+    ParamFatal('invalid syntax mode (-M<x>) "'+aValue+'"');
+  if Quick then exit;
+
+  case lowerCase(aValue) of
+    'delphi': SetMode(p2jmDelphi);
+    'objfpc': SetMode(p2jmObjFPC);
+  else
+    if aValue[length(aValue)]='-' then
+    begin
+      aValue:=LeftStr(aValue,length(aValue)-1);
+      Negated:=true;
+    end else
+      Negated:=false;
+    for ms in TModeSwitch do
+      if (ms in msAllPas2jsModeSwitches)
+          and SameText(SModeSwitchNames[ms],aValue) then
+      begin
+        if (ms in ModeSwitches)<>Negated then
+        begin
+          // already set
+          exit;
+        end else if ms in msAllPas2jsModeSwitchesReadOnly then
+          ParamFatal('modeswitch is read only -M"'+aValue+'"')
+        else begin
+          // switch
+          if Negated then
+            ModeSwitches:=ModeSwitches-[ms]
+          else
+            ModeSwitches:=ModeSwitches+[ms];
+          exit;
+        end;
+      end;
+    ParamFatal('invalid syntax mode (-M) "'+aValue+'"');
+  end;
+end;
+
 procedure TPas2jsCompiler.HandleOptionConfigFile(aPos: Integer; const aFileName: string);
 
 Var
@@ -3612,6 +3666,7 @@ Var
   pl: TPasToJsPlatform;
   s: string;
   pbi: TPas2JSBuiltInName;
+  ms: TModeSwitch;
 begin
   // write information and halt
   InfoMsg:='';
@@ -3667,6 +3722,12 @@ begin
       // write list of supported JS processors
       for pr in TPasToJsProcessor do
         Log.LogPlain(PasToJsProcessorNames[pr]);
+    'm':
+      begin
+      // write list of supported modeswitches
+      for ms in (msAllPas2jsModeSwitches-AllLanguageModes) do
+        Log.LogPlain(SModeSwitchNames[ms]);
+      end;
     'o':
       begin
         // write list of optimizations
@@ -3808,14 +3869,8 @@ begin
             UnknownParam;
         end;
       'M': // syntax mode
-        begin
-          case lowerCase(aValue) of
-            'delphi': Mode:=p2jmDelphi;
-            'objfpc': Mode:=p2jmObjFPC;
-          else
-            ParamFatal('invalid syntax mode  (-M) "'+aValue+'"');
-          end;
-        end;
+        if not HandleOptionM(aValue,Quick) then
+          UnknownParam;
       'N':
         begin
           if aValue='' then
@@ -3989,14 +4044,15 @@ var
   Enabled, Disabled: string;
   i: Integer;
 begin
-  ReadSingleLetterOptions(Param,p,'2acdm',Enabled,Disabled);
+  ReadSingleLetterOptions(Param,p,'2acdmj',Enabled,Disabled);
   for i:=1 to length(Enabled) do begin
     case Enabled[i] of
-    '2': Mode:=p2jmObjFPC;
+    '2': SetMode(p2jmObjFPC);
     'a': Options:=Options+[coAssertions];
     'c': Options:=Options+[coAllowCAssignments];
-    'd': Mode:=p2jmDelphi;
+    'd': SetMode(p2jmDelphi);
     'm': Options:=Options+[coAllowMacros];
+    'j': Options:=Options+[coWriteableConst];
     end;
   end;
   for i:=1 to length(Disabled) do begin
@@ -4006,6 +4062,7 @@ begin
     'c': Options:=Options-[coAllowCAssignments];
     'd': ;
     'm': Options:=Options-[coAllowMacros];
+    'j': Options:=Options-[coWriteableConst];
     end;
   end;
 end;
@@ -4367,7 +4424,7 @@ begin
   FMainSrcFile:='';
   FOptions:=DefaultP2jsCompilerOptions;
   FRTLVersionCheck:=DefaultP2jsRTLVersionCheck;
-  FMode:=p2jmObjFPC;
+  FModeSwitches:=p2jsMode_SwitchSets[p2jmObjFPC];
   FConverterGlobals.Reset;
   FConverterGlobals.RTLVersion:=(VersionMajor*100+VersionMinor)*100+VersionRelease;
   FConverterGlobals.TargetPlatform:=PlatformBrowser;
@@ -4593,6 +4650,7 @@ begin
   w('    -iV  : Write short compiler version');
   w('    -iW  : Write full compiler version');
   w('    -ic  : Write list of supported JS processors usable by -P<x>');
+  w('    -im  : Write list of supported modeswitches usable by -M<x>');
   w('    -io  : Write list of supported optimizations usable by -Oo<x>');
   w('    -it  : Write list of supported targets usable by -T<x>');
   w('    -iJ  : Write list of supported JavaScript identifiers -JoRTL-<x>');
@@ -4648,8 +4706,12 @@ begin
   w('   -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
   WritePrecompiledFormats;
   w('  -l     : Write logo');
-  w('  -MDelphi: Delphi 7 compatibility mode');
-  w('  -MObjFPC: FPC''s Object Pascal compatibility mode (default)');
+  w('  -M<x>  : Set language mode or enable/disable a modeswitch');
+  w('    -MDelphi: Delphi 7 compatibility mode');
+  w('    -MObjFPC: FPC''s Object Pascal compatibility mode (default)');
+  w('    -M<x>  : enable or disable modeswitch, see option -im');
+  w('    Each mode (as listed above) enables its default set of modeswitches.');
+  w('    Other modeswitches are disabled and need to be enabled one by another.');
   w('  -NS<x> : obsolete: add <x> to namespaces. Same as -FN<x>');
   w('  -n     : Do not read the default config files');
   w('  -o<x>  : Change main JavaScript file to <x>, "." means stdout');
@@ -4665,11 +4727,12 @@ begin
   w('    -Pecmascript5: default');
   w('    -Pecmascript6');
   w('  -S<x>  : Syntax options. <x> is a combination of the following letters:');
+  w('    2    : Same as -Mobjfpc (default)');
   w('    a    : Turn on assertions');
   w('    c    : Support operators like C (*=,+=,/= and -=)');
   w('    d    : Same as -Mdelphi');
+  w('    j    : Allows typed constants to be writeable (default)');
   w('    m    : Enables macro replacements');
-  w('    2    : Same as -Mobjfpc (default)');
   w('  -SI<x>  : Set interface style to <x>');
   w('    -SIcom  : COM, reference counted interface (default)');
   w('    -SIcorba: CORBA interface');
@@ -4739,14 +4802,25 @@ procedure TPas2jsCompiler.WriteOptions;
 var
   co: TP2jsCompilerOption;
   fco: TP2jsFSOption;
+  ms: TModeSwitch;
 begin
   // message encoding
   WriteEncoding;
   // target platform
   Log.LogMsgIgnoreFilter(nTargetPlatformIs,[PasToJsPlatformNames[TargetPlatform]]);
   Log.LogMsgIgnoreFilter(nTargetProcessorIs,[PasToJsProcessorNames[TargetProcessor]]);
-  // default syntax mode
-  Log.LogMsgIgnoreFilter(nSyntaxModeIs,[p2jscModeNames[Mode]]);
+  // syntax mode
+  for ms in msAllPas2jsModeSwitches do
+    case ms of
+    msObjfpc:
+      if ms in ModeSwitches then
+        Log.LogMsgIgnoreFilter(nSyntaxModeIs,[p2jscModeNames[p2jmObjFPC]]);
+    msDelphi:
+      if ms in ModeSwitches then
+        Log.LogMsgIgnoreFilter(nSyntaxModeIs,[p2jscModeNames[p2jmDelphi]]);
+    else
+      Log.LogMsgIgnoreFilter(nModeswitchXisY,[SModeSwitchNames[ms],BoolToStr(ms in ModeSwitches,'on','off')]);
+    end;
   Log.LogMsgIgnoreFilter(nClassInterfaceStyleIs,[InterfaceTypeNames[InterfaceType]]);
   // boolean options
   for co in TP2jsCompilerOption do
@@ -4808,6 +4882,33 @@ begin
 end;
 
 procedure TPas2jsCompiler.WriteInfo;
+var
+  Flags: string;
+
+  procedure AppendFlag(const s: string);
+  begin
+    if s='' then exit;
+    if Flags='' then
+      Flags:=Space(Log.Indent)
+    else
+      Flags:=Flags+',';
+    if length(Flags)+length(s)>Log.LineLen then
+    begin
+      Log.LogPlain(Flags);
+      Flags:=Space(Log.Indent);
+    end;
+    Flags:=Flags+s;
+  end;
+
+  procedure FlushFlags;
+  begin
+    if Flags='' then exit;
+    Log.LogPlain(Flags);
+    Flags:='';
+  end;
+
+var
+  ms: TModeSwitch;
 begin
   WriteVersionLine;
   Log.LogLn;
@@ -4821,10 +4922,30 @@ begin
   Log.LogPlain('Supported CPU instruction sets:');
   Log.LogPlain('  ECMAScript5, ECMAScript6');
   Log.LogLn;
+
   Log.LogPlain('Recognized compiler and RTL features:');
-  Log.LogPlain('  RTTI,CLASSES,EXCEPTIONS,EXITCODE,RANDOM,DYNARRAYS,COMMANDARGS,');
-  Log.LogPlain('  UNICODESTRINGS');
+  Flags:='';
+  AppendFlag('INITFINAL');
+  AppendFlag('RTTI');
+  AppendFlag('CLASSES');
+  AppendFlag('EXCEPTIONS');
+  AppendFlag('EXITCODE');
+  AppendFlag('WIDESTRINGS');
+  AppendFlag('RANDOM');
+  AppendFlag('DYNARRAYS');
+  AppendFlag('COMMANDARGS');
+  AppendFlag('RESOURCES');
+  AppendFlag('UNICODESTRINGS');
+  FlushFlags;
+  Log.LogLn;
+
+  Log.LogPlain('Recognized modeswitches:');
+  Flags:='';
+  for ms in (msAllPas2jsModeSwitches-AllLanguageModes) do
+    AppendFlag(SModeSwitchNames[ms]);
+  FlushFlags;
   Log.LogLn;
+
   Log.LogPlain('Supported Optimizations:');
   Log.LogPlain('  EnumNumbers');
   Log.LogPlain('  RemoveNotUsedPrivates');
@@ -5056,7 +5177,7 @@ begin
   Result:=FMainJSFileResolved;
 end;
 
-function TPas2jsCompiler.GetUnitInfo(const UseUnitName, InFileName,
+function TPas2jsCompiler.GetUnitInfo(UseUnitName, InFileName,
   ModuleDir: String; PCUSupport: TPCUSupport): TFindUnitInfo;
 
 var
@@ -5116,6 +5237,8 @@ begin
 
   if InFilename='' then
   begin
+    CheckUnitAlias(UseUnitName);
+
     if Pos('.',UseUnitname)<1 then
     begin
       // generic unit name -> search with namespaces
@@ -5175,6 +5298,11 @@ begin
   end;
 end;
 
+procedure TPas2jsCompiler.CheckUnitAlias(var UseUnitName: string);
+begin
+  if UseUnitName='' then ;
+end;
+
 function TPas2jsCompiler.LoadUsedUnit(Info: TLoadUnitInfo;
   Context: TPas2jsCompilerFile): TPas2jsCompilerFile;
 

File diff suppressed because it is too large
+ 682 - 119
packages/pastojs/src/pas2jsfiler.pp


+ 35 - 4
packages/pastojs/src/pas2jslibcompiler.pp

@@ -25,7 +25,7 @@ unit pas2jslibcompiler;
 interface
 
 uses
-  SysUtils, Classes,
+  SysUtils, Classes, Math,
   FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler,
   Pas2JSCompilerCfg, Pas2JSCompilerPP;
 
@@ -47,6 +47,8 @@ Type
     AFileData : PAnsiChar; Var AFileDataLen: Int32); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
   TReadDirCallBack = Function (Data : Pointer;
     P : PDirectoryCache; ADirPath: PAnsiChar): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+  TUnitAliasCallBack = Function (Data: Pointer;
+    AUnitName: PAnsiChar; AUnitNameMaxLen: Integer): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 
   { TLibraryPas2JSCompiler }
 
@@ -60,6 +62,8 @@ Type
     FOnReadDirData: Pointer;
     FOnReadPasData: Pointer;
     FOnReadPasFile: TReadPasCallBack;
+    FOnUnitAlias: TUnitAliasCallBack;
+    FOnUnitAliasData: Pointer;
     FOnWriteJSCallBack: TWriteJSCallBack;
     FOnWriteJSData: Pointer;
     FReadBufferLen: Cardinal;
@@ -71,6 +75,7 @@ Type
     Function ReadDirectory(Dir: TPas2jsCachedDirectory): boolean; virtual;
   Public
     Constructor Create; override;
+    procedure CheckUnitAlias(var UseUnitName: string); override;
     Procedure DoLibraryLog(Sender : TObject; Const Msg : String);
     Function LibraryRun(ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) :Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
     Property LastError : String Read FLastError Write FLastError;
@@ -84,6 +89,8 @@ Type
     Property ReadBufferLen : Cardinal Read FReadBufferLen Write FReadBufferLen;
     Property OnReadDir: TReadDirCallBack read FOnReadDir write FOnReadDir;
     Property OnReadDirData: Pointer read FOnReadDirData write FOnReadDirData;
+    Property OnUnitAlias: TUnitAliasCallBack read FOnUnitAlias write FOnUnitAlias;
+    Property OnUnitAliasData: Pointer read FOnUnitAliasData write FOnUnitAliasData;
   end;
 
 Type
@@ -95,6 +102,7 @@ Procedure SetPas2JSReadPasCallBack(P : PPas2JSCompiler; ACallBack : TReadPasCall
 Procedure SetPas2JSReadDirCallBack(P : PPas2JSCompiler; ACallBack : TReadDirCallBack; CallBackData : Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 Procedure AddPas2JSDirectoryEntry(P: PDirectoryCache; AFilename: PAnsiChar;
   AAge: TPas2jsFileAgeTime; AAttr: TPas2jsFileAttr; ASize: TPas2jsFileSize); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+Procedure SetPas2JSUnitAliasCallBack(P : PPas2JSCompiler; ACallBack : TUnitAliasCallBack; CallBackData : Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 Function RunPas2JSCompiler(P : PPas2JSCompiler; ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) : Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 Procedure FreePas2JSCompiler(P : PPas2JSCompiler); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
 Function GetPas2JSCompiler : PPas2JSCompiler; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
@@ -129,8 +137,8 @@ begin
 end;
 
 procedure TLibraryPas2JSCompiler.GetLastError(AError: PAnsiChar;
-  Var AErrorLength: Longint; AErrorClass: PAnsiChar;
-  Var AErrorClassLength: Longint);
+  var AErrorLength: Longint; AErrorClass: PAnsiChar;
+  var AErrorClassLength: Longint);
 
 Var
   L : Integer;
@@ -192,6 +200,23 @@ begin
   PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(Self);
 end;
 
+procedure TLibraryPas2JSCompiler.CheckUnitAlias(var UseUnitName: string);
+var
+  UnitNameLen, UnitNameMaxLen: Integer;
+  s: String;
+begin
+  inherited CheckUnitAlias(UseUnitName);
+  UnitNameLen:=length(UseUnitName);
+  if (UnitNameLen>0) and Assigned(OnUnitAlias) then
+    begin
+    UnitNameMaxLen:=Max(UnitNameLen,255);
+    s:=UseUnitName;
+    SetLength(s,UnitNameMaxLen);
+    if OnUnitAlias(OnUnitAliasData,Pointer(s),UnitNameMaxLen) then
+      UseUnitName:=LeftStr(s,UnitNameLen);
+    end;
+end;
+
 procedure TLibraryPas2JSCompiler.DoLibraryLog(Sender: TObject; const Msg: String);
 begin
   if Assigned(FOnLibLogCallBack) then
@@ -286,10 +311,16 @@ begin
   TPas2jsCachedDirectory(P).Add(AFilename,AAge,AAttr,ASize);
 end;
 
+procedure SetPas2JSUnitAliasCallBack(P: PPas2JSCompiler;
+  ACallBack: TUnitAliasCallBack; CallBackData: Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
+begin
+  TLibraryPas2JSCompiler(P).OnUnitAlias:=ACallBack;
+  TLibraryPas2JSCompiler(P).OnUnitAliasData:=CallBackData;
+end;
+
 function RunPas2JSCompiler(P: PPas2JSCompiler; ACompilerExe,
   AWorkingDir: PAnsiChar; CommandLine: PPAnsiChar; DoReset: Boolean): Boolean;
   {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
-
 begin
   Result:=TLibraryPas2JSCompiler(P).LibraryRun(ACompilerExe,AWorkingDir,CommandLine,DoReset)
 end;

+ 6 - 0
packages/pastojs/src/pas2jslogger.pp

@@ -119,12 +119,14 @@ type
   private
     FDebugLog: TPas2JSStream;
     FEncoding: string;
+    FIndent: integer;
     FLastMsgCol: integer;
     FLastMsgFile: string;
     FLastMsgLine: integer;
     FLastMsgNumber: integer;
     FLastMsgTxt: string;
     FLastMsgType: TMessageType;
+    FLineLen: integer;
     FMsgNumberDisabled: TIntegerDynArray;// sorted ascending
     FMsg: TFPList; // list of TPas2jsMessage
     FOnFormatPath: TPScannerFormatPathEvent;
@@ -212,6 +214,8 @@ type
     property LastMsgTxt: string read FLastMsgTxt write FLastMsgTxt;
     property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
     property DebugLog: TPas2jsStream read FDebugLog write FDebugLog;
+    property LineLen: integer read FLineLen write FLineLen; // used by LogPlainText
+    property Indent: integer read FIndent write FIndent; // used by LogPlainText
   end;
 
 function CompareP2JMessage(Item1, Item2: {$IFDEF Pas2JS}JSValue{$ELSE}Pointer{$ENDIF}): Integer;
@@ -723,6 +727,8 @@ constructor TPas2jsLogger.Create;
 begin
   FMsg:=TFPList.Create;
   FShowMsgTypes:=DefaultLogMsgTypes;
+  FLineLen:=78;
+  FIndent:=2;
 end;
 
 destructor TPas2jsLogger.Destroy;

+ 9 - 1
packages/pastojs/src/pas2jspcucompiler.pp

@@ -34,7 +34,7 @@ uses
   PasTree, PScanner, PasResolveEval,
   FPPas2Js,
   Pas2jsCompiler, Pas2JSFS, Pas2JSFSCompiler, Pas2JsFiler,
-  Pas2jsLogger, Pas2jsFileUtils;
+  Pas2jsLogger, Pas2jsFileUtils, FPPJsSrcMap;
 
 Type
 
@@ -79,6 +79,7 @@ Type
   Private
     FPrecompileFormat: TPas2JSPrecompileFormat;
   Protected
+    function CreateJSMapper: TPas2JSMapper; override;
     procedure WritePrecompiledFormats; override;
     function CreateCompilerFile(const PasFileName, PCUFilename: String): TPas2jsCompilerFile; override;
     procedure HandleOptionPCUFormat(Value: string); override;
@@ -397,6 +398,13 @@ end;
 
 { TPas2jsPCUCompiler }
 
+function TPas2jsPCUCompiler.CreateJSMapper: TPas2JSMapper;
+begin
+  Result:=inherited CreateJSMapper;
+  if PrecompileFormat<>nil then
+    Result.PCUExt:='.'+PrecompileFormat.Ext;
+end;
+
 procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
 Var
   I: Integer;

+ 12 - 6
packages/pastojs/src/pas2jsresources.pp

@@ -5,7 +5,13 @@ unit pas2jsresources;
 interface
 
 uses
-  Classes, SysUtils, pas2jsfs, jsTree;
+  Classes, SysUtils,
+  {$IFDEF pas2js}
+  web,
+  {$ELSE}
+  base64,
+  {$ENDIF}
+  pas2jsfs, jsTree;
 
 Type
   TResourceScopeMode = (rmProgram,rmUnit);
@@ -62,10 +68,8 @@ Type
     function GetResourceCount: Integer; override;
     function GetAsString: String; override;
   end;
-implementation
 
-{$IFNDEF PAS2JS}
-uses base64;
+implementation
 
 { TNoResources }
 
@@ -92,8 +96,6 @@ begin
   Result:='';
 end;
 
-{$ENDIF}
-
 { TPas2jsResourceHandler }
 
 
@@ -148,7 +150,11 @@ Var
 
 begin
   F:=LoadFile(aFileName);
+  {$IFDEF pas2js}
+  Result:=window.atob(F.Source);
+  {$ELSE}
   Result:=EncodeStringBase64(F.Source);
+  {$ENDIF}
   // Do not release, FS will release all files
 end;
 

File diff suppressed because it is too large
+ 387 - 261
packages/pastojs/tests/tcfiler.pas


+ 51 - 1
packages/pastojs/tests/tcgenerics.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, fpcunit, testregistry,
-  TCModules, FPPas2Js;
+  TCModules, FPPas2Js, PScanner, PasResolveEval;
 
 type
 
@@ -34,9 +34,12 @@ type
     //Procedure TestGen_Class_ReferGenClass_DelphiFail;
     Procedure TestGen_Class_ClassConstructor;
     // ToDo: rename local const T
+    Procedure TestGen_Class_TypeCastSpecializesWarn;
 
     // generic external class
     procedure TestGen_ExtClass_Array;
+    // ToDo: TestGen_ExtClass_GenJSValueAssign  TExt<JSValue> := TExt<Word>
+    // ToDo: TestGen_ExtClass_TypeCastJSValue  TExt<Word>(aTExt<JSValue>) and vice versa
 
     // statements
     Procedure TestGen_InlineSpec_Constructor;
@@ -628,6 +631,53 @@ begin
     '']));
 end;
 
+procedure TTestGenerics.TestGen_Class_TypeCastSpecializesWarn;
+begin
+  StartProgram(false);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TObject = class end;',
+  '  TBird<T> = class F: T; end;',
+  '  TBirdWord = TBird<Word>;',
+  '  TBirdChar = TBird<Char>;',
+  'var',
+  '  w: TBirdWord;',
+  '  c: TBirdChar;',
+  'begin',
+  '  w:=TBirdWord(c);',
+  '']);
+  ConvertProgram;
+  CheckSource('TestGen_Class_TypeCastSpecializesWarn',
+    LinesToStr([ // statements
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.F = 0;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird$G2", $mod.TObject, function () {',
+    '  this.$init = function () {',
+    '    $mod.TObject.$init.call(this);',
+    '    this.F = "";',
+    '  };',
+    '});',
+    'this.w = null;',
+    'this.c = null;',
+    '']),
+    LinesToStr([ // $mod.$main
+    '$mod.w = $mod.c;',
+    '']));
+  CheckHint(mtWarning,nClassTypesAreNotRelatedXY,'Class types "TBird$G2<Char>" and "TBird$G1<Word>" are not related');
+  CheckResolverUnexpectedHints();
+end;
+
 procedure TTestGenerics.TestGen_ExtClass_Array;
 begin
   StartProgram(false);

+ 236 - 36
packages/pastojs/tests/tcmodules.pas

@@ -339,6 +339,7 @@ type
     Procedure TestProc_LocalVarAbsolute;
     Procedure TestProc_LocalVarInit;
     Procedure TestProc_ReservedWords;
+    Procedure TestProc_ConstRefWord;
 
     // anonymous functions
     Procedure TestAnonymousProc_Assign_ObjFPC;
@@ -434,6 +435,7 @@ type
     Procedure TestArray_SetLengthProperty;
     Procedure TestArray_SetLengthMultiDim;
     Procedure TestArray_OpenArrayOfString;
+    Procedure TestArray_ConstRef;
     Procedure TestArray_Concat;
     Procedure TestArray_Copy;
     Procedure TestArray_InsertDelete;
@@ -456,6 +458,7 @@ type
     Procedure TestRecord_WithDo;
     Procedure TestRecord_Assign;
     Procedure TestRecord_AsParams;
+    Procedure TestRecord_ConstRef;
     Procedure TestRecordElement_AsParams;
     Procedure TestRecordElementFromFuncResult_AsParams;
     Procedure TestRecordElementFromWith_AsParams;
@@ -526,7 +529,8 @@ type
     Procedure TestClass_ExternalOverrideFail;
     Procedure TestClass_ExternalVar;
     Procedure TestClass_Const;
-    Procedure TestClass_LocalConstDuplicate;
+    Procedure TestClass_LocalConstDuplicate_Prg;
+    Procedure TestClass_LocalConstDuplicate_Unit;
     // ToDo: Procedure TestAdvRecord_LocalConstDuplicate;
     Procedure TestClass_LocalVarSelfFail;
     Procedure TestClass_ArgSelfFail;
@@ -4528,7 +4532,7 @@ begin
   '  Nan:=&bOolean;',
   'end;',
   'begin',
-  ' Date(1);']);
+  '  Date(1);']);
   ConvertProgram;
   CheckSource('TestProc_ReservedWords',
     LinesToStr([ // statements
@@ -4545,6 +4549,50 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProc_ConstRefWord;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Run(constref w: word);',
+  'var l: word;',
+  'begin',
+  '  l:=w;',
+  '  Run(w);',
+  '  Run(l);',
+  'end;',
+  'procedure Fly(a: word; var b: word; out c: word; const d: word; constref e: word);',
+  'begin',
+  '  Run(a);',
+  '  Run(b);',
+  '  Run(c);',
+  '  Run(d);',
+  '  Run(e);',
+  'end;',
+  'begin',
+  '  Run(1);']);
+  ConvertProgram;
+  CheckHint(mtWarning,nConstRefNotForXAsConst,'ConstRef not yet implemented for Word. Treating as Const');
+  CheckSource('TestProc_ConstRefWord',
+    LinesToStr([ // statements
+    'this.Run = function (w) {',
+    '  var l = 0;',
+    '  l = w;',
+    '  $mod.Run(w);',
+    '  $mod.Run(l);',
+    '};',
+    'this.Fly = function (a, b, c, d, e) {',
+    '  $mod.Run(a);',
+    '  $mod.Run(b.get());',
+    '  $mod.Run(c.get());',
+    '  $mod.Run(d);',
+    '  $mod.Run(e);',
+    '};',
+    '']),
+    LinesToStr([
+    '$mod.Run(1);'
+    ]));
+end;
+
 procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
 begin
   StartProgram(false);
@@ -7981,38 +8029,40 @@ end;
 procedure TTestModule.TestTryExcept;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  TObject = class end;');
-  Add('  Exception = class Msg: string; end;');
-  Add('  EInvalidCast = class(Exception) end;');
-  Add('var vI: longint;');
-  Add('begin');
-  Add('  try');
-  Add('    vi:=1;');
-  Add('  except');
-  Add('    vi:=2');
-  Add('  end;');
-  Add('  try');
-  Add('    vi:=3;');
-  Add('  except');
-  Add('    raise;');
-  Add('  end;');
-  Add('  try');
-  Add('    VI:=4;');
-  Add('  except');
-  Add('    on einvalidcast do');
-  Add('      raise;');
-  Add('    on E: exception do');
-  Add('      if e.msg='''' then');
-  Add('        raise e;');
-  Add('    else');
-  Add('      vi:=5');
-  Add('  end;');
-  Add('  try');
-  Add('    VI:=6;');
-  Add('  except');
-  Add('    on einvalidcast do ;');
-  Add('  end;');
+  Add([
+  'type',
+  '  TObject = class end;',
+  '  Exception = class Msg: string; end;',
+  '  EInvalidCast = class(Exception) end;',
+  'var vI: longint;',
+  'begin',
+  '  try',
+  '    vi:=1;',
+  '  except',
+  '    vi:=2',
+  '  end;',
+  '  try',
+  '    vi:=3;',
+  '  except',
+  '    raise;',
+  '  end;',
+  '  try',
+  '    VI:=4;',
+  '  except',
+  '    on einvalidcast do',
+  '      raise;',
+  '    on E: exception do',
+  '      if e.msg='''' then',
+  '        raise e;',
+  '    else',
+  '      vi:=5',
+  '  end;',
+  '  try',
+  '    VI:=6;',
+  '  except',
+  '    on einvalidcast do ;',
+  '  end;',
+  '']);
   ConvertProgram;
   CheckSource('TestTryExcept',
     LinesToStr([ // statements
@@ -9320,6 +9370,46 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestArray_ConstRef;
+begin
+  StartProgram(false);
+  Add([
+  'type TArr = array of word;',
+  'procedure Run(constref a: TArr);',
+  'begin',
+  'end;',
+  'procedure Fly(a: TArr; var b: TArr; out c: TArr; const d: TArr; constref e: TArr);',
+  'var l: TArr;',
+  'begin',
+  '  Run(l);',
+  '  Run(a);',
+  '  Run(b);',
+  '  Run(c);',
+  '  Run(d);',
+  '  Run(e);',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckResolverUnexpectedHints();
+  CheckSource('TestArray_ConstRef',
+    LinesToStr([ // statements
+    'this.Run = function (a) {',
+    '};',
+    'this.Fly = function (a, b, c, d, e) {',
+    '  var l = [];',
+    '  $mod.Run(l);',
+    '  $mod.Run(a);',
+    '  $mod.Run(b.get());',
+    '  $mod.Run(c.get());',
+    '  $mod.Run(d);',
+    '  $mod.Run(e);',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestArray_Concat;
 begin
   StartProgram(false);
@@ -10388,6 +10478,56 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestRecord_ConstRef;
+begin
+  StartProgram(false);
+  Add([
+  'type TRec = record i: word; end;',
+  'procedure Run(constref a: TRec);',
+  'begin',
+  'end;',
+  'procedure Fly(a: TRec; var b: TRec; out c: TRec; const d: TRec; constref e: TRec);',
+  'var l: TRec;',
+  'begin',
+  '  Run(l);',
+  '  Run(a);',
+  '  Run(b);',
+  '  Run(c);',
+  '  Run(d);',
+  '  Run(e);',
+  'end;',
+  'begin',
+  '']);
+  ConvertProgram;
+  CheckResolverUnexpectedHints();
+  CheckSource('TestRecord_ConstRef',
+    LinesToStr([ // statements
+    'rtl.recNewT($mod, "TRec", function () {',
+    '  this.i = 0;',
+    '  this.$eq = function (b) {',
+    '    return this.i === b.i;',
+    '  };',
+    '  this.$assign = function (s) {',
+    '    this.i = s.i;',
+    '    return this;',
+    '  };',
+    '});',
+    'this.Run = function (a) {',
+    '};',
+    'this.Fly = function (a, b, c, d, e) {',
+    '  var l = $mod.TRec.$new();',
+    '  $mod.Run(l);',
+    '  $mod.Run(a);',
+    '  $mod.Run(b);',
+    '  $mod.Run(c);',
+    '  $mod.Run(d);',
+    '  $mod.Run(e);',
+    '};',
+    '']),
+    LinesToStr([
+    '']));
+end;
+
 procedure TTestModule.TestRecordElement_AsParams;
 begin
   StartProgram(false);
@@ -14109,7 +14249,7 @@ begin
     '']));
 end;
 
-procedure TTestModule.TestClass_LocalConstDuplicate;
+procedure TTestModule.TestClass_LocalConstDuplicate_Prg;
 begin
   StartProgram(false);
   Add([
@@ -14140,7 +14280,7 @@ begin
   'begin',
   '']);
   ConvertProgram;
-  CheckSource('TestClass_LocalConstDuplicate',
+  CheckSource('TestClass_LocalConstDuplicate_Prg',
     LinesToStr([
     'rtl.createClass($mod, "TObject", null, function () {',
     '  this.cI = 3;',
@@ -14168,6 +14308,66 @@ begin
     '']));
 end;
 
+procedure TTestModule.TestClass_LocalConstDuplicate_Unit;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  TObject = class',
+  '    const cI: longint = 3;',
+  '    procedure Fly;',
+  '    procedure Run;',
+  '  end;',
+  '  TBird = class',
+  '    procedure Go;',
+  '  end;',
+  'implementation',
+  'procedure tobject.fly;',
+  'const cI: word = 4;',
+  'begin',
+  '  if cI=Self.cI then ;',
+  'end;',
+  'procedure tobject.run;',
+  'const cI: word = 5;',
+  'begin',
+  '  if cI=Self.cI then ;',
+  'end;',
+  'procedure tbird.go;',
+  'const cI: word = 6;',
+  'begin',
+  '  if cI=Self.cI then ;',
+  'end;',
+  '']);
+  ConvertUnit;
+  CheckSource('TestClass_LocalConstDuplicate_Unit',
+    LinesToStr([
+    'rtl.createClass($mod, "TObject", null, function () {',
+    '  this.cI = 3;',
+    '  this.$init = function () {',
+    '  };',
+    '  this.$final = function () {',
+    '  };',
+    '  var cI$1 = 4;',
+    '  this.Fly = function () {',
+    '    if (cI$1 === this.cI) ;',
+    '  };',
+    '  var cI$2 = 5;',
+    '  this.Run = function () {',
+    '    if (cI$2 === this.cI) ;',
+    '  };',
+    '});',
+    'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
+    '  var cI$3 = 6;',
+    '  this.Go = function () {',
+    '    if (cI$3 === this.cI) ;',
+    '  };',
+    '});',
+    '']),
+    '',
+    '');
+end;
+
 procedure TTestModule.TestClass_LocalVarSelfFail;
 begin
   StartProgram(false);

+ 52 - 0
packages/pastojs/tests/tcunitsearch.pas

@@ -145,10 +145,15 @@ type
     procedure TestUS_Program_FE_o;
     procedure TestUS_IncludeSameDir;
 
+    // uses 'in' modifier
     procedure TestUS_UsesInFile;
     procedure TestUS_UsesInFile_Duplicate;
     procedure TestUS_UsesInFile_IndirectDuplicate;
     procedure TestUS_UsesInFile_WorkNotEqProgDir;
+    procedure TestUS_UsesInFileTwice;
+
+    procedure TestUS_UseUnitTwiceFail;
+    procedure TestUS_UseUnitTwiceViaNameSpace;
   end;
 
 function LinesToStr(const Lines: array of string): string;
@@ -738,6 +743,7 @@ end;
 
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile_Duplicate;
 begin
+  // check if using two different units with same name
   AddUnit('system.pp',[''],['']);
   AddUnit('unit1.pas',
   ['var a: longint;'],
@@ -757,6 +763,7 @@ end;
 
 procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
 begin
+  // check if using two different units with same name
   AddUnit('system.pp',[''],['']);
   AddUnit('unit1.pas',
   ['var a: longint;'],
@@ -791,6 +798,51 @@ begin
   Compile(['sub/test1.pas','-Jc']);
 end;
 
+procedure TTestCLI_UnitSearch.TestUS_UsesInFileTwice;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('unit1.pas',
+  ['var a: longint;'],
+  ['']);
+  AddFile('test1.pas',[
+    'uses foo in ''unit1.pas'', bar in ''unit1.pas'';',
+    'begin',
+    '  bar.a:=foo.a;',
+    '  a:=a;',
+    'end.']);
+  Compile(['test1.pas','-Jc']);
+end;
+
+procedure TTestCLI_UnitSearch.TestUS_UseUnitTwiceFail;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('sub.unit1.pas',
+  ['var a: longint;'],
+  ['']);
+  AddFile('test1.pas',[
+    'uses sub.Unit1, sub.unit1;',
+    'begin',
+    '  a:=a;',
+    'end.']);
+  Compile(['test1.pas','-FNsub','-Jc'],ExitCodeSyntaxError);
+  AssertEquals('ErrorMsg','Duplicate identifier "sub.unit1"',ErrorMsg);
+end;
+
+procedure TTestCLI_UnitSearch.TestUS_UseUnitTwiceViaNameSpace;
+begin
+  AddUnit('system.pp',[''],['']);
+  AddUnit('sub.unit1.pas',
+  ['var a: longint;'],
+  ['']);
+  AddFile('test1.pas',[
+    'uses unit1, sub.unit1;',
+    'begin',
+    '  unit1.a:=sub.unit1.a;',
+    '  a:=a;',
+    'end.']);
+  Compile(['test1.pas','-FNsub','-Jc']);
+end;
+
 Initialization
   RegisterTests([TTestCLI_UnitSearch]);
 end.

+ 8 - 3
utils/pas2js/docs/translation.html

@@ -133,6 +133,7 @@ Put + after a boolean switch option to enable it, - to disable it
     -iV   : Write short compiler version
     -iW   : Write full compiler version
     -ic   : Write list of supported JS processors usable by -P&lt;x&gt;
+    -im   : Write list of supported modeswitches usable by -M&lt;x&gt;
     -io   : Write list of supported optimizations usable by -Oo&lt;x&gt;
     -it   : Write list of supported targets usable by -T&lt;x&gt;
     -iJ   : Write list of supported JavaScript identifiers -JoRTL-&lt;x&gt;
@@ -179,8 +180,11 @@ Put + after a boolean switch option to enable it, - to disable it
                   postprocessors in succession.
    -Ju&lt;x&gt; : Add &lt;x&gt; to foreign unit paths. Foreign units are not compiled.
   -l      : Write logo
-  -MDelphi: Delphi 7 compatibility mode
-  -MObjFPC: FPC's Object Pascal compatibility mode (default)
+  -M&lt;x&gt;  : Set language mode or enable/disable a modeswitch
+    -MDelphi: Delphi 7 compatibility mode
+    -MObjFPC: FPC's Object Pascal compatibility mode (default)
+    Each mode (as listed above) enables its default set of modeswitches.
+    Other modeswitches are disabled and need to be enabled one by another.
   -NS&lt;x&gt;  : obsolete: add &lt;x&gt; to namespaces. Same as -FN&lt;x&gt;
   -n      : Do not read the default config files
   -o&lt;x&gt;   : Change main JavaScript file to &lt;x&gt;, "." means stdout
@@ -196,11 +200,12 @@ Put + after a boolean switch option to enable it, - to disable it
     -Pecmascript5  : default
     -Pecmascript6
   -S&lt;x&gt;   : Syntax options. &lt;x&gt; is a combination of the following letters:
+    2     : Same as -Mobjfpc (default)
     a     : Turn on assertions
     c     : Support operators like C (*=,+=,/= and -=)
     d     : Same as -Mdelphi
     m     : Enables macro replacements
-    2     : Same as -Mobjfpc (default)
+    j     : Allows typed constants to be writeable (default)
   -SI&lt;x&gt;   : Set interface style to &lt;x&gt;
     -SIcom   : COM, reference counted interface (default)
     -SIcorba : CORBA interface

+ 1 - 0
utils/pas2js/fpmake.pp

@@ -22,6 +22,7 @@ begin
     P.Description := 'Convert pascal sources to javascript.';
     P.Email := '[email protected]';
     P.NeedLibC:= false;
+    P.ShortName:='p2js';
 
     P.Directory:=ADirectory;
     P.Version:='3.2.1';

+ 1 - 0
utils/pas2js/pas2jslib.pp

@@ -15,6 +15,7 @@ exports
   SetPas2JSWriteJSCallBack,
   SetPas2JSReadDirCallBack,
   AddPas2JSDirectoryEntry,
+  SetPas2JSUnitAliasCallBack,
   SetPas2JSCompilerLogCallBack,
   GetPas2JSCompilerLastError;
 

Some files were not shown because too many files changed in this diff