pastojs: test dotted unit name in implemention section

git-svn-id: trunk@37300 -

packages/pastojs/src/fppjssrcmap.pp

@@ -96,7 +96,7 @@ var
   C: TClass;
 begin
   {$IFDEF VerboseSrcMap}
-  system.write('TPas2JSWriter.SetCurElement ',CurLine,',',CurColumn);
+  system.write('TPas2JSMapper.SetCurElement ',CurLine,',',CurColumn);
   if AValue<>nil then
     system.writeln(' ',AValue.ClassName,' src=',ExtractFileName(AValue.Source),' ',AValue.Line,',',AValue.Column)
   else
@@ -142,7 +142,7 @@ begin
     exit; // built-in element -> do not add a mapping
 
   FNeedMapping:=false;
-  //system.writeln('TPas2JSWriter.Writing Generated.Line=',CurLine,',Col=',CurColumn-1,
+  //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),
@@ -167,7 +167,7 @@ begin
           inc(p);
         inc(Line);
         // add a mapping for each line
-        //system.writeln('TPas2JSWriter.Writing Generated.Line=',CurLine+Line,',Col=',0,
+        //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);

packages/pastojs/tests/tcmodules.pas

@@ -95,12 +95,13 @@ type
     FSkipTests: boolean;
     FSource: TStringList;
     FFirstPasStatement: TPasImplBlock;
-    function GetModuleCount: integer;
+    function GetResolverCount: integer;
-    function GetModules(Index: integer): TTestEnginePasResolver;
+    function GetResolvers(Index: integer): TTestEnginePasResolver;
     function OnPasResolverFindUnit(const aUnitName: String): TPasModule;
     function FindUnit(const aUnitName: String): TPasModule;
   protected
     procedure SetUp; override;
+    function CreateConverter: TPasToJSConverter; virtual;
     procedure TearDown; override;
     Procedure Add(Line: string); virtual;
     Procedure Add(const Lines: array of string);
@@ -126,6 +127,7 @@ type
     procedure CheckSource(Msg,Statements: String; InitStatements: string = '';
       ImplStatements: string = ''); virtual;
     procedure CheckDiff(Msg, Expected, Actual: string); virtual;
+    procedure CheckUnit(Filename, ExpectedSrc: string); virtual;
     procedure SetExpectedScannerError(Msg: string; MsgNumber: integer);
     procedure SetExpectedParserError(Msg: string; MsgNumber: integer);
     procedure SetExpectedPasResolverError(Msg: string; MsgNumber: integer);
@@ -138,10 +140,12 @@ type
     procedure HandleException(E: Exception);
     procedure RaiseException(E: Exception);
     procedure WriteSources(const aFilename: string; aRow, aCol: integer);
+    function IndexOfResolver(const Filename: string): integer;
+    function GetResolver(const Filename: string): TTestEnginePasResolver;
     function GetDefaultNamespace: string;
     property PasProgram: TPasProgram Read FPasProgram;
-    property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
+    property Resolvers[Index: integer]: TTestEnginePasResolver read GetResolvers;
-    property ModuleCount: integer read GetModuleCount;
+    property ResolverCount: integer read GetResolverCount;
     property Engine: TTestEnginePasResolver read FEngine;
     property Filename: string read FFilename;
     Property Module: TPasModule Read FModule;
@@ -171,12 +175,13 @@ type
 
   TTestModule = class(TCustomTestModule)
   Published
-    // modules
+    // Resolvers
     Procedure TestEmptyProgram;
     Procedure TestEmptyProgramUseStrict;
     Procedure TestEmptyUnit;
     Procedure TestEmptyUnitUseStrict;
     Procedure TestDottedUnitNames;
+    Procedure TestDottedUnitNameImpl;
     Procedure TestDottedUnitExpr;
     Procedure Test_ModeFPCFail;
     Procedure Test_ModeSwitchCBlocksFail;
@@ -611,12 +616,12 @@ end;
 
 { TCustomTestModule }
 
-function TCustomTestModule.GetModuleCount: integer;
+function TCustomTestModule.GetResolverCount: integer;
 begin
   Result:=FModules.Count;
 end;
 
-function TCustomTestModule.GetModules(Index: integer
+function TCustomTestModule.GetResolvers(Index: integer
   ): TTestEnginePasResolver;
 begin
   Result:=TTestEnginePasResolver(FModules[Index]);
@@ -651,11 +656,11 @@ var
 begin
   //writeln('TTestModule.FindUnit START Unit="',aUnitName,'"');
   Result:=nil;
-  for i:=0 to ModuleCount-1 do
+  for i:=0 to ResolverCount-1 do
     begin
-    CurEngine:=Modules[i];
+    CurEngine:=Resolvers[i];
     CurUnitName:=ExtractFileUnitName(CurEngine.Filename);
-    //writeln('TTestModule.FindUnit Checking ',i,'/',ModuleCount,' ',CurEngine.Filename,' ',CurUnitName);
+    //writeln('TTestModule.FindUnit Checking ',i,'/',ResolverCount,' ',CurEngine.Filename,' ',CurUnitName);
     if CompareText(aUnitName,CurUnitName)=0 then
       begin
       Result:=CurEngine.Module;
@@ -705,12 +710,17 @@ begin
   FParser:=TTestPasParser.Create(FScanner,FFileResolver,FEngine);
   Parser.Options:=Parser.Options+po_pas2js+[po_KeepScannerError];
   FModule:=Nil;
-  FConverter:=TPasToJSConverter.Create;
+  FConverter:=CreateConverter;
-  FConverter.Options:=co_tcmodules;
 
   FExpectedErrorClass:=nil;
 end;
 
+function TCustomTestModule.CreateConverter: TPasToJSConverter;
+begin
+  Result:=TPasToJSConverter.Create;
+  Result.Options:=co_tcmodules;
+end;
+
 procedure TCustomTestModule.TearDown;
 begin
   FSkipTests:=false;
@@ -819,9 +829,9 @@ function TCustomTestModule.FindModuleWithFilename(aFilename: string
 var
   i: Integer;
 begin
-  for i:=0 to ModuleCount-1 do
+  for i:=0 to ResolverCount-1 do
-    if CompareText(Modules[i].Filename,aFilename)=0 then
+    if CompareText(Resolvers[i].Filename,aFilename)=0 then
-      exit(Modules[i]);
+      exit(Resolvers[i]);
   Result:=nil;
 end;
 
@@ -1168,7 +1178,7 @@ var
         else
           inc(p);
       end;
-      if p<=ExpectedP then begin
+      if (p<=ExpectedP) and (p^<>#0) then begin
         writeln('= ',ExpLine);
       end else begin
         // diff line
@@ -1186,6 +1196,12 @@ var
         break;
       end;
     until p^=#0;
+
+    writeln('DiffFound Actual:-----------------------');
+    writeln(Actual);
+    writeln('DiffFound Expected:---------------------');
+    writeln(Expected);
+    writeln('DiffFound ------------------------------');
     Fail('diff found, but lines are the same, internal error');
   end;
 
@@ -1234,6 +1250,39 @@ begin
   until false;
 end;
 
+procedure TCustomTestModule.CheckUnit(Filename, ExpectedSrc: string);
+var
+  aResolver: TTestEnginePasResolver;
+  aConverter: TPasToJSConverter;
+  aJSModule: TJSSourceElements;
+  ActualSrc: String;
+begin
+  aResolver:=GetResolver(Filename);
+  AssertNotNull('missing resolver of unit '+Filename,aResolver);
+  {$IFDEF VerbosePas2JS}
+  writeln('CheckUnit '+Filename+' converting ...');
+  {$ENDIF}
+  aConverter:=CreateConverter;
+  try
+    try
+      aJSModule:=aConverter.ConvertPasElement(aResolver.Module,aResolver) as TJSSourceElements;
+    except
+      on E: Exception do
+        HandleException(E);
+    end;
+    ActualSrc:=ConvertJSModuleToString(aJSModule);
+    {$IFDEF VerbosePas2JS}
+    writeln('TTestModule.CheckUnit ',Filename,' Pas:');
+    write(aResolver.Source);
+    writeln('TTestModule.CheckUnit ',Filename,' JS:');
+    write(ActualSrc);
+    {$ENDIF}
+    CheckDiff('Converted unit: "'+ChangeFileExt(Filename,'.js')+'"',ExpectedSrc,ActualSrc);
+  finally
+    aConverter.Free;
+  end;
+end;
+
 procedure TCustomTestModule.SetExpectedScannerError(Msg: string;
   MsgNumber: integer);
 begin
@@ -1396,9 +1445,9 @@ var
   aModule: TTestEnginePasResolver;
 begin
   writeln('TCustomTestModule.WriteSources File="',aFilename,'" Row=',aRow,' Col=',aCol);
-  for i:=0 to ModuleCount-1 do
+  for i:=0 to ResolverCount-1 do
     begin
-    aModule:=Modules[i];
+    aModule:=Resolvers[i];
     SrcLines:=TStringList.Create;
     try
       SrcLines.Text:=aModule.Source;
@@ -1420,6 +1469,25 @@ begin
     end;
 end;
 
+function TCustomTestModule.IndexOfResolver(const Filename: string): integer;
+var
+  i: Integer;
+begin
+  for i:=0 to ResolverCount-1 do
+    if Filename=Resolvers[i].Filename then exit(i);
+  Result:=-1;
+end;
+
+function TCustomTestModule.GetResolver(const Filename: string
+  ): TTestEnginePasResolver;
+var
+  i: Integer;
+begin
+  i:=IndexOfResolver(Filename);
+  if i<0 then exit(nil);
+  Result:=Resolvers[i];
+end;
+
 function TCustomTestModule.GetDefaultNamespace: string;
 var
   C: TClass;
@@ -1506,6 +1574,57 @@ begin
     '']) );
 end;
 
+procedure TTestModule.TestDottedUnitNameImpl;
+begin
+  AddModuleWithIntfImplSrc('TEST.UnitA.pas',
+    LinesToStr([
+    'type',
+    '  TObject = class end;',
+    '  TTestA = class',
+    '  end;'
+    ]),
+    LinesToStr(['uses TEST.UnitB;'])
+    );
+  AddModuleWithIntfImplSrc('TEST.UnitB.pas',
+    LinesToStr([
+    'uses TEST.UnitA;',
+    'type TTestB = class(TTestA);'
+    ]),
+    ''
+    );
+  StartProgram(true);
+  Add('uses TEST.UnitA;');
+  Add('begin');
+  ConvertProgram;
+  CheckSource('TestDottedUnitNameImpl',
+    LinesToStr([
+    '']),
+    LinesToStr([ // this.$init
+    '']) );
+  CheckUnit('TEST.UnitA.pas',
+    LinesToStr([
+    'rtl.module("TEST.UnitA", ["system"], function () {',
+    '  var $mod = this;',
+    '  rtl.createClass($mod, "TObject", null, function () {',
+    '    this.$init = function () {',
+    '    };',
+    '    this.$final = function () {',
+    '    };',
+    '  });',
+    '  rtl.createClass($mod, "TTestA", $mod.TObject, function () {',
+    '  });',
+    '}, ["TEST.UnitB"]);'
+    ]));
+  CheckUnit('TEST.UnitB.pas',
+    LinesToStr([
+    'rtl.module("TEST.UnitB", ["system","TEST.UnitA"], function () {',
+    '  var $mod = this;',
+    '  rtl.createClass($mod, "TTestB", pas["TEST.UnitA"].TTestA, function () {',
+    '  });',
+    '});'
+    ]));
+end;
+
 procedure TTestModule.TestDottedUnitExpr;
 begin
   AddModuleWithIntfImplSrc('NS2.SubNs2.Unit2.pas',
@@ -2863,8 +2982,10 @@ begin
   Add('var');
   Add('  e: TMyEnum;');
   Add('  f: TMyEnum = Green;');
+  Add('  i: longint;');
   Add('begin');
   Add('  e:=green;');
+  //Add('  i:=longint(e);');
   ConvertProgram;
   CheckSource('TestEnumNumber',
     LinesToStr([ // statements
@@ -2875,10 +2996,12 @@ begin
     '  Green:1',
     '  };',
     'this.e = 0;',
-    'this.f = 1;'
+    'this.f = 1;',
+    'this.i = 0;'
     ]),
     LinesToStr([
     '$mod.e=1;'
+    //'$mod.i=$mod.e;'
     ]));
 end;