pastojs: filer: fixed msignoreinterfaces

git-svn-id: trunk@38581 -

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -2191,7 +2191,7 @@ begin
   if El is TPasProcedure then
     begin
     ProcScope:=El.CustomData as TPasProcedureScope;
-    if ProcScope.DeclarationProc<>nil then
+    if (ProcScope<>nil) and (ProcScope.DeclarationProc<>nil) then
       El:=ProcScope.DeclarationProc;
     end;
   Result:=FindElement(El);

packages/pastojs/src/pas2jscompiler.pp

@@ -363,10 +363,10 @@ type
       aName: String; out Value: string): boolean;
     function GetDefaultNamespace: String;
     function GetFileCount: integer;
-    function GetShowDebug: boolean; inline;
+    function GetShowDebug: boolean;
     function GetShowFullPaths: boolean;
     function GetShowLogo: Boolean; inline;
-    function GetShowTriedUsedFiles: boolean; inline;
+    function GetShowTriedUsedFiles: boolean;
     function GetShowUsedTools: boolean; inline;
     function GetSkipDefaultConfig: Boolean; inline;
     function GetSrcMapBaseDir: string;

packages/pastojs/src/pas2jsfilecache.pp

@@ -69,7 +69,7 @@ type
     FPool: TPas2jsCachedDirectories;
     FRefCount: integer;
     FSorted: boolean;
-    function GetEntries(Index: integer): TPas2jsCachedDirectoryEntry;
+    function GetEntries(Index: integer): TPas2jsCachedDirectoryEntry; inline;
     procedure SetSorted(const AValue: boolean);
   protected
     procedure DoReadDir; virtual;
@@ -509,12 +509,30 @@ end;
 
 { TPas2jsCachedDirectory }
 
+// inline
+function TPas2jsCachedDirectory.IndexOfFile(const ShortFilename: String
+  ): integer;
+begin
+  {$IFDEF CaseInsensitiveFilenames}
+  Result:=IndexOfFileCaseInsensitive(ShortFilename);
+  {$ELSE}
+  Result:=IndexOfFileCaseSensitive(ShortFilename);
+  {$ENDIF}
+end;
+
+// inline
 function TPas2jsCachedDirectory.GetEntries(Index: integer
   ): TPas2jsCachedDirectoryEntry;
 begin
   Result:=TPas2jsCachedDirectoryEntry(FEntries[Index]);
 end;
 
+// inline
+function TPas2jsCachedDirectory.NeedsUpdate: boolean;
+begin
+  Result:=(Pool.ChangeStamp<>FChangeStamp) or (FChangeStamp=InvalidChangeStamp);
+end;
+
 procedure TPas2jsCachedDirectory.SetSorted(const AValue: boolean);
 begin
   if FSorted=AValue then Exit;
@@ -576,11 +594,6 @@ begin
   FSorted:=true;
 end;
 
-function TPas2jsCachedDirectory.NeedsUpdate: boolean;
-begin
-  Result:=(Pool.ChangeStamp<>FChangeStamp) or (FChangeStamp=InvalidChangeStamp);
-end;
-
 procedure TPas2jsCachedDirectory.Update;
 begin
   if not NeedsUpdate then exit;
@@ -719,16 +732,6 @@ begin
   Result:=-1;
 end;
 
-function TPas2jsCachedDirectory.IndexOfFile(const ShortFilename: String
-  ): integer;
-begin
-  {$IFDEF CaseInsensitiveFilenames}
-  Result:=IndexOfFileCaseInsensitive(ShortFilename);
-  {$ELSE}
-  Result:=IndexOfFileCaseSensitive(ShortFilename);
-  {$ENDIF}
-end;
-
 function TPas2jsCachedDirectory.CountSameNamesCaseInsensitive(Index: integer
   ): integer;
 var

packages/pastojs/src/pas2jsfiler.pp

@@ -3295,6 +3295,7 @@ var
   Arr: TJSONArray;
   i: Integer;
   Ref: TResolvedReference;
+  Scope: TPas2JSClassScope;
 begin
   WritePasElement(Obj,El,aContext);
   if El.PackMode<>pmNone then
@@ -3326,9 +3327,13 @@ begin
     end
   else
     begin
+    Scope:=El.CustomData as TPas2JSClassScope;
     WriteElementList(Obj,El,'Interfaces',El.Interfaces,aContext,true);
     WriteElementList(Obj,El,'Members',El.Members,aContext);
-    WriteClassScope(Obj,El.CustomData as TPas2JSClassScope,aContext);
+    if Scope<>nil then
+      WriteClassScope(Obj,Scope,aContext)
+    else
+      Obj.Add('Scope',false); // msIgnoreInterfaces
     end;
 end;
 
@@ -3437,7 +3442,10 @@ end;
 
 procedure TPCUWriter.WriteProperty(Obj: TJSONObject; El: TPasProperty;
   aContext: TPCUWriterContext);
+var
+  Scope: TPasPropertyScope;
 begin
+  Scope:=El.CustomData as TPasPropertyScope;
   WriteVariable(Obj,El,aContext);
   WriteExpr(Obj,El,'Index',El.IndexExpr,aContext);
   WriteExpr(Obj,El,'Read',El.ReadAccessor,aContext);
@@ -3458,7 +3466,10 @@ begin
   if El.IsNodefault then
     Obj.Add('NoDefault',true);
 
-  WritePropertyScope(Obj,El.CustomData as TPasPropertyScope,aContext);
+  if Scope<>nil then
+    WritePropertyScope(Obj,Scope,aContext)
+  else
+    Obj.Add('Scope',false); // msIgnoreInterfaces
 end;
 
 procedure TPCUWriter.WriteProcedureModifiers(Obj: TJSONObject;
@@ -3518,7 +3529,9 @@ var
 begin
   WritePasElement(Obj,El,aContext);
   Scope:=El.CustomData as TPas2JSProcedureScope;
-  if Scope.DeclarationProc=nil then
+  //writeln('TPCUWriter.WriteProcedure ',GetObjName(El),' ',GetObjName(Scope),' ',Resolver.GetElementSourcePosStr(El));
+  // BEWARE: Scope can be nil for ignored methods of an interface (msIgnoreInterfaces)
+  if (Scope=nil) or (Scope.DeclarationProc=nil) then
     begin
     WriteElementProperty(Obj,El,'ProcType',El.ProcType,aContext);
     WriteExpr(Obj,El,'Public',El.PublicName,aContext);
@@ -3537,6 +3550,11 @@ begin
         Obj.Add('MessageType',PCUProcedureMessageTypeNames[El.MessageType]);
       end;
 
+    if Scope=nil then
+      begin
+      Obj.Add('Scope',false); // msIgnoreInterfaces
+      exit;
+      end;
     WriteProcedureScope(Obj,Scope,aContext);
     end
   else
@@ -4008,6 +4026,7 @@ procedure TPCUReader.Set_ClassScope_DirectAncestor(RefEl: TPasElement;
   Data: TObject);
 var
   Scope: TPas2JSClassScope absolute Data;
+  AncestorScope: TPas2JSClassScope;
   aClassAncestor: TPasType;
 begin
   if not (RefEl is TPasType) then
@@ -4019,8 +4038,9 @@ begin
   aClassAncestor:=Resolver.ResolveAliasType(Scope.DirectAncestor);
   if not (aClassAncestor is TPasClassType) then
     RaiseMsg(20180214114322,Scope.Element,GetObjName(RefEl));
-  Scope.AncestorScope:=aClassAncestor.CustomData as TPas2JSClassScope;
-  if pcsfPublished in Scope.AncestorScope.Flags then
+  AncestorScope:=aClassAncestor.CustomData as TPas2JSClassScope;
+  Scope.AncestorScope:=AncestorScope;
+  if (AncestorScope<>nil) and (pcsfPublished in Scope.AncestorScope.Flags) then
     Include(Scope.Flags,pcsfPublished);
 end;
 
@@ -6424,8 +6444,13 @@ begin
     end
   else
     begin
-    Scope:=TPas2JSClassScope(Resolver.CreateScope(El,Resolver.ScopeClass_Class));
-    El.CustomData:=Scope;
+    if Obj.Find('Scope') is TJSONBoolean then
+      Scope:=nil // msIgnoreInterfaces
+    else
+      begin
+      Scope:=TPas2JSClassScope(Resolver.CreateScope(El,Resolver.ScopeClass_Class));
+      El.CustomData:=Scope;
+      end;
     end;
 
   ReadPasElement(Obj,El,aContext);
@@ -6454,13 +6479,11 @@ begin
   ReadString(Obj,'ExternalName',El.ExternalName,El);
 
   if Scope<>nil then
-    begin
     ReadClassScope(Obj,Scope,aContext);
-    // read Members as last
-    ReadElementList(Obj,El,'Members',El.Members,aContext);
-
+  // read Members
+  ReadElementList(Obj,El,'Members',El.Members,aContext);
+  if Scope<>nil then
     ReadClassScopeAbstractProcs(Obj,Scope);
-    end;
 end;
 
 procedure TPCUReader.ReadArgument(Obj: TJSONObject; El: TPasArgument;
@@ -6652,8 +6675,13 @@ procedure TPCUReader.ReadProperty(Obj: TJSONObject; El: TPasProperty;
 var
   Scope: TPasPropertyScope;
 begin
-  Scope:=TPasPropertyScope(Resolver.CreateScope(El,TPasPropertyScope));
-  El.CustomData:=Scope;
+  if Obj.Find('Scope') is TJSONBoolean then
+    Scope:=nil // msIgnoreInterfaces
+  else
+    begin
+    Scope:=TPasPropertyScope(Resolver.CreateScope(El,TPasPropertyScope));
+    El.CustomData:=Scope;
+    end;
 
   ReadVariable(Obj,El,aContext);
   El.IndexExpr:=ReadExpr(Obj,El,'Index',aContext);
@@ -6672,7 +6700,8 @@ begin
   ReadBoolean(Obj,'Default',El.IsDefault,El);
   ReadBoolean(Obj,'NoDefault',El.IsNodefault,El);
 
-  ReadPropertyScope(Obj,Scope,aContext);
+  if Scope<>nil then
+    ReadPropertyScope(Obj,Scope,aContext);
 end;
 
 function TPCUReader.ReadProcedureModifiers(Obj: TJSONObject; El: TPasElement;
@@ -6840,8 +6869,13 @@ var
   Ref: TPCUFilerElementRef;
   DeclProc: TPasProcedure;
 begin
-  Scope:=TPas2JSProcedureScope(Resolver.CreateScope(El,Resolver.ScopeClass_Procedure));
-  El.CustomData:=Scope;
+  if Obj.Find('Scope') is TJSONBoolean then
+    Scope:=nil // msIgnoreInterfaces
+  else
+    begin
+    Scope:=TPas2JSProcedureScope(Resolver.CreateScope(El,Resolver.ScopeClass_Procedure));
+    El.CustomData:=Scope;
+    end;
 
   ReadPasElement(Obj,El,aContext);
 
@@ -6891,10 +6925,11 @@ begin
     El.ProcType:=TPasProcedureType(ReadElementProperty(
                                  Obj,El,'ProcType',TPasProcedureType,aContext));
 
-    ReadProcedureScope(Obj,Scope,aContext);
+    if Scope<>nil then
+      ReadProcedureScope(Obj,Scope,aContext);
     end;
 
-  if Obj.Find('ImplProc')=nil then
+  if (Scope<>nil) and (Obj.Find('ImplProc')=nil) then
     ReadProcScopeReferences(Obj,Scope);
 
   if Obj.Find('Body')<>nil then

packages/pastojs/tests/tcfiler.pas

@@ -152,6 +152,7 @@ type
     procedure TestPC_ClassConstructor;
     procedure TestPC_Initialization;
     procedure TestPC_BoolSwitches;
+    procedure TestPC_IgnoreInterface;
 
     procedure TestPC_UseUnit;
     procedure TestPC_UseUnit_Class;
@@ -1107,6 +1108,7 @@ begin
     RestItem:=TObject(Rest[i]);
     if not (RestItem is TPasElement) then
       Fail(SubPath+' Rest='+GetObjName(RestItem));
+    SubPath:=Path+'['+IntToStr(i)+']"'+TPasElement(OrigItem).Name+'"';
     CheckRestoredElement(SubPath,TPasElement(OrigItem),TPasElement(RestItem));
     end;
 end;
@@ -1417,6 +1419,8 @@ begin
   CheckRestoredObject(Path+'.CustomData',Orig.CustomData,Rest.CustomData);
   OrigScope:=Orig.CustomData as TPas2JSProcedureScope;
   RestScope:=Rest.CustomData as TPas2JSProcedureScope;
+  if OrigScope=nil then
+    exit; // msIgnoreInterfaces
   CheckRestoredReference(Path+'.CustomData[TPas2JSProcedureScope].DeclarationProc',
     OrigScope.DeclarationProc,RestScope.DeclarationProc);
   AssertEquals(Path+'.CustomData[TPas2JSProcedureScope].ResultVarName',OrigScope.ResultVarName,RestScope.ResultVarName);
@@ -1884,6 +1888,24 @@ begin
   WriteReadUnit;
 end;
 
+procedure TTestPrecompile.TestPC_IgnoreInterface;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  '{$modeswitch ignoreinterfaces}',
+  'type',
+  '  TIntf = interface',
+  '    function GetItems(Index: longint): longint;',
+  '    procedure SetItems(Index: longint; Value: longint);',
+  '    property Items[Index: longint]: longint read GetItems write SetItems;',
+  '  end;',
+  'implementation',
+  'end.',
+  '']);
+  WriteReadUnit;
+end;
+
 procedure TTestPrecompile.TestPC_UseUnit;
 begin
   AddModuleWithIntfImplSrc('unit2.pp',

packages/pastojs/tests/tcprecompile.pas

@@ -56,6 +56,7 @@ type
     procedure TestPCU_UnitCycle;
     procedure TestPCU_ClassForward;
     procedure TestPCU_ClassConstructor;
+    procedure TestPCU_IgnoreInterface;
   end;
 
 function LinesToList(const Lines: array of string): TStringList;
@@ -315,6 +316,39 @@ begin
   CheckPrecompile('test1.pas','src');
 end;
 
+procedure TTestCLI_Precompile.TestPCU_IgnoreInterface;
+begin
+  AddUnit('src/system.pp',[
+    'type integer = longint;',
+    'procedure Writeln; varargs;'],
+    ['procedure Writeln; begin end;']);
+  AddUnit('src/unit1.pp',[
+    'type',
+    '  TIntf = interface',
+    '    function GetItems: longint;',
+    '    procedure SetItems(Index: longint; Value: longint);',
+    '    property Items[Index: longint]: longint read GetItems write SetItems;',
+    '  end;',
+    ''],[
+    '']);
+  AddUnit('src/unit2.pp',[
+    'uses unit1;',
+    'type',
+    '  TAlias = TIntf;',
+    '  TObject = class end;',
+    '  TBird = class(TIntf) end;',
+    ''],[
+    '']);
+  AddFile('test1.pas',[
+    'uses unit2;',
+    'type TAlias2 = TAlias;',
+    'var b: TBird;',
+    'begin',
+    '  if b=nil then ;',
+    'end.']);
+  CheckPrecompile('test1.pas','src');
+end;
+
 Initialization
   RegisterTests([TTestCLI_Precompile]);
 end.