* synchronized with trunk

git-svn-id: branches/wasm@48109 -

packages/regexpr/tests/tcregexp.pp

@@ -1,3 +1,4 @@
+{ %norun }
 unit tcregexp;
 
 {$mode objfpc}{$H+}

packages/regexpr/tests/testregexpr.pp

@@ -1,3 +1,5 @@
+{ %CONFIGFILE=fpcunit-console-defaults.ini testdefaults.ini }
+
 program testregexpr;
 
 {$mode objfpc}{$H+}

rtl/linux/ossysc.inc

@@ -732,3 +732,9 @@ begin
   fpsetrlimit:=do_syscall(syscall_nr_setrlimit,TSysParam(Resource),TSysParam(rlim));
 end;
 
+function FpSchedGetAffinity(pid : pid_t;cpusetsize : size_t;mask : pcpu_set_t) : cint;
+begin
+  FpSchedGetAffinity := do_syscall(syscall_nr_sched_getaffinity,TSysParam(pid),TSysParam(cpusetsize),TSysParam(mask));
+end;
+
+

rtl/linux/ostypes.inc

@@ -430,6 +430,17 @@ type
   tiovec=iovec;
   piovec=^tiovec;
 
+  cpu_set_t = record
+{$ifdef CPU64}
+    __bits : array[0..15] of culong;
+{$else CPU64}
+    __bits : array[0..0] of culong;
+{$endif CPU64}
+  end;
+
+  tcpu_set_t = cpu_set_t;
+  pcpu_set_t = ^tcpu_set_t;
+
 {$if defined(cpupowerpc)}
 const
   { FP exception related constants for prctl(); PowerPC specific }

rtl/linux/system.pp

@@ -113,6 +113,8 @@ procedure OsSetupEntryInformation(constref info: TEntryInformation); forward;
 
 {$endif FPC_LOAD_SOFTFPU}
 
+{$define HAS_GETCPUCOUNT}
+
 {$I system.inc}
 
 {$ifdef android}
@@ -458,6 +460,24 @@ Begin
   randseed:=longint(Fptime(nil));
 End;
 
+function GetCPUCount: LongWord;
+  var
+    cpus : tcpu_set_t;
+    BytesWritten,i : cint;
+  begin
+    Result := 1;
+    { same approach as nproc uses:
+      we return the number of available CPUs }
+    BytesWritten:=FpSchedGetAffinity(0,sizeof(cpus),@cpus);
+    if BytesWritten>0 then
+      begin
+        Result := 0;
+        for i:=0 to BytesWritten-1 do
+          Result:=Result+Popcnt((PByte(@cpus)+i)^);
+      end;
+  end;
+
+
 {*****************************************************************************
                                     cmdline
 *****************************************************************************}

tests/Makefile

@@ -2431,7 +2431,7 @@ TESTDIRECTDIRS=
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2
 TESTPACKAGESUBDIRS=$(addprefix packages/,$(TESTPACKAGESDIRS))
-TESTPACKAGESDIRECTDIRS=rtl-objpas rtl-generics hash
+TESTPACKAGESDIRECTDIRS=rtl-objpas rtl-generics hash regexpr
 TESTPACKAGESDIRECTSUBDIRS=$(addprefix ../packages/,$(addsuffix /tests,$(TESTPACKAGESDIRECTDIRS)))
 ifdef QUICKTEST
 export QUICKTEST

tests/Makefile.fpc

@@ -164,7 +164,7 @@ TESTDIRECTDIRS=
 TESTSUBDIRS=cg cg/variants cg/cdecl cpu16 cpu16/i8086 library opt $(addprefix units/,$(TESTUNITDIRS))
 TESTPACKAGESDIRS=win-base webtbs hash fcl-registry fcl-process zlib fcl-db fcl-xml cocoaint bzip2
 TESTPACKAGESUBDIRS=$(addprefix packages/,$(TESTPACKAGESDIRS))
-TESTPACKAGESDIRECTDIRS=rtl-objpas rtl-generics hash
+TESTPACKAGESDIRECTDIRS=rtl-objpas rtl-generics hash regexpr
 TESTPACKAGESDIRECTSUBDIRS=$(addprefix ../packages/,$(addsuffix /tests,$(TESTPACKAGESDIRECTDIRS)))
 
 ifdef QUICKTEST

utils/fpdoc/dglobals.pp

@@ -161,7 +161,6 @@ resourcestring
   SMDNavSubtree = '    UnitSubTree : put all units in a sub tree of a Units node';
   SMDNavTree =    '    UnitTree : put every units as a node on the same level as packages node';
 
-
   SXMLUsageFlatStructure  = 'Use a flat output structure of XML files and directories';
   SXMLUsageSource  = 'Include source file and line info in generated XML';
 
@@ -172,7 +171,7 @@ resourcestring
   STitle           = 'FPDoc - Free Pascal Documentation Tool';
   SVersion         = 'Version %s [%s]';
   SCopyright1      = '(c) 2000 - 2003 Areca Systems GmbH / Sebastian Guenther, [email protected]';
-  SCopyright2      = '(c) 2005 - 2012 various FPC contributors';
+  SCopyright2      = '(c) 2005 - 2021 various FPC contributors';
 
   SCmdLineHelp     = 'Usage: %s [options]';
   SUsageOption008  = '--base-descr-dir=DIR prefix all description files with this directory';
@@ -213,6 +212,7 @@ resourcestring
   SUsageOption300  = '--dry-run         Only parse sources and XML, do not create output';
   SUsageOption310  = '--write-project=file';
   SUsageOption320  = '                  Write all command-line options to a project file';
+  SUsageSubNames   = 'Use the file subnames instead the indexes as postfixes';
 
   SUsageFormats        = 'The following output formats are supported by this fpdoc:';
   SUsageBackendHelp    = 'Specify an output format, combined with --help to get more help for this backend.';

utils/fpdoc/dw_chm.pp

@@ -119,11 +119,8 @@ begin
       Result := LowerCase(AElement.PathName);
       excl := (ASubindex > 0);
     end;
-    // searching for TPasModule - it is on the 2nd level
-    if Assigned(AElement.Parent) then
-      while Assigned(AElement.Parent.Parent) do
-        AElement := AElement.Parent;
     // cut off Package Name
+    AElement:= AElement.GetModule;
     Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
     // to skip dots in unit name
     i := Length(AElement.Name);
@@ -142,10 +139,8 @@ begin
   end;
 
   if ASubindex > 0 then
-    Result := Result + '-' + IntToStr(ASubindex);
-
+    Result := Result + '-' + GetFilePostfix(ASubindex);
   Result := Result + Extension;
-//  Writeln('Result filename : ',Result);
 end;
 
 { TFpDocChmWriter }
@@ -634,6 +629,11 @@ var
   IFileName,FileName: String;
   FilePath: String;
 begin
+  FAllocator:=CreateAllocator;
+  FAllocator.SubPageNames:= SubPageNames;
+  AllocatePages;
+  DoLog(SWritingPages, [PageCount]);
+
   FileName := Engine.Output;
   if FileName = '' then
     Raise Exception.Create('Error: no --output option used.'); 

utils/fpdoc/dw_html.pp

@@ -143,7 +143,6 @@ begin
   UseMenuBrackets:=True;
   IndexColCount:=3;
   Charset:='iso-8859-1';
-  AllocatePages;
 end;
 
 function THTMLWriter.CreateHTMLPage(AElement: TPasElement;
@@ -2297,7 +2296,7 @@ begin
   else if Cmd = '--disable-menu-brackets' then
     FUseMenuBrackets:=False
   else
-    Result:=False;
+    Result:=inherited InterPretOption(Cmd, Arg);
 end;
 
 
@@ -2321,6 +2320,7 @@ begin
   List.Add(SHTMLImageUrl);
   List.Add('--disable-menu-brackets');
   List.Add(SHTMLDisableMenuBrackets);
+  inherited Usage(List);
 end;
 
 class procedure THTMLWriter.SplitImport(var AFilename, ALinkPrefix: String);

utils/fpdoc/dw_markdown.pp

@@ -1889,11 +1889,14 @@ begin
       FNavigationMode:=nmUnitSubTree
     else if SameText(Arg,'UnitTree') then
       FNavigationMode:=nmUnitTree;
-    end;
+    end
+  else
+    Result:=inherited InterPretOption(Cmd, Arg);
 end;
 
 class procedure TMarkdownWriter.Usage(List: TStrings);
 begin
+  inherited Usage(List);
   List.add('--header=file');
   List.Add(SMDUsageHeader);
   List.add('--footer=file');
@@ -1906,7 +1909,10 @@ begin
   List.Add(SMDTheme);
   List.Add('--navigation=scheme');
   List.Add(SMDNavigation);
+  // we have to write even count of params into list either we will have a exception
+  List.Add('');
   List.Add(SMDNavSubtree);
+  List.Add('');
   List.Add(SMDNavTree);
 end;
 

utils/fpdoc/dw_xml.pp

@@ -81,6 +81,8 @@ begin
   else if AElement.ClassType = TPasModule then
     Result := LowerCase(AElement.Name);
 
+  if ASubindex > 0 then
+    Result := Result + '-' + GetFilePostfix(ASubindex);
   Result := Result + Extension;
 end;
 
@@ -641,12 +643,10 @@ begin
 end;
 
 procedure TXMLWriter.AllocatePackagePages;
-var
-  H: Boolean;
 begin
-  H:= false; // TODO: I want to public TreeClass for package
-  if H then
-    AddPage(Package,ClassHierarchySubIndex);
+  AddPage(Package, IdentifierIndex);
+  AddPage(Package, ClassHierarchySubIndex);
+  AddPage(Package, InterfaceHierarchySubIndex);
 end;
 
 procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
@@ -654,7 +654,7 @@ procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
 begin
   if not assigned(Amodule.Interfacesection) then
     exit;
-  AddPage(AModule, 0);
+  AddPage(AModule, IdentifierIndex);
 end;
 
 procedure TXMLWriter.WriteDocPage(const aFileName: String;
@@ -667,6 +667,13 @@ begin
     doc := ModuleToXMLStruct(TPasModule(aElement));
     WriteXMLFile(doc, GetFileBaseDir(Engine.Output) + aFileName);
     doc.Free;
+  end
+  else if (aElement is TPasPackage) then
+  begin
+    if aSubPageIndex = ClassHierarchySubIndex then
+      TreeClass.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
+    if aSubPageIndex = InterfaceHierarchySubIndex then
+      TreeInterface.SaveToXml(GetFileBaseDir(Engine.Output) + aFileName);
   end;
 end;
 
@@ -679,6 +686,7 @@ end;
 
 class procedure TXMLWriter.Usage(List: TStrings);
 begin
+  inherited Usage(List);
   List.AddStrings(['--source-info', SXMLUsageSource]);
   List.AddStrings(['--flat-structure', SXMLUsageFlatStructure]);
 end;

utils/fpdoc/dwriter.pp

@@ -65,13 +65,21 @@ type
     Destructor Destroy; override;
   end;
 
+  { TFileAllocator }
+
   TFileAllocator = class
+  private
+    FSubPageNames: Boolean;
+  protected
+    function GetFilePostfix(ASubindex: Integer):String;
   public
+    procedure Create(); overload;
     procedure AllocFilename(AElement: TPasElement; ASubindex: Integer); virtual;
     function GetFilename(AElement: TPasElement;
       ASubindex: Integer): String; virtual; abstract;
     function GetRelativePathToTop(AElement: TPasElement): String; virtual;
     function GetCSSFilename(ARelativeTo: TPasElement): DOMString; virtual;
+    property SubPageNames: Boolean read FSubPageNames write FSubPageNames;
   end;
 
   TLongNameFileAllocator = class(TFileAllocator)
@@ -228,6 +236,7 @@ const
   TopicsSubIndex = 7;
   IndexSubIndex = 8;
   ClassHierarchySubIndex = 9;
+  InterfaceHierarchySubIndex = 10;
 
   // Subpage indices for classes
   PropertiesByInheritanceSubindex = 11;
@@ -237,6 +246,7 @@ const
   EventsByInheritanceSubindex = 15;
   EventsByNameSubindex = 16;
 
+
 Type
   { TMultiFileDocWriter }
 
@@ -260,7 +270,7 @@ Type
 
   TMultiFileDocWriter = Class(TFPDocWriter)
   Private
-    FAllocator: TFileAllocator;
+    FSubPageNames: Boolean;
     FBaseDirectory: String;
     FCurDirectory: String;
     FModule: TPasModule;
@@ -268,6 +278,7 @@ Type
     function GetPageCount: Integer;
 
   Protected
+    FAllocator: TFileAllocator;
     function ResolveLinkID(const Name: String; Level: Integer=0): DOMString;
     function ResolveLinkIDInUnit(const Name,AUnitName: String): DOMString;
     function ResolveLinkWithinPackage(AElement: TPasElement; ASubpageIndex: Integer): String;
@@ -284,15 +295,17 @@ Type
     procedure AllocatePackagePages; virtual;
     // Prefix every filename generated with the result of this.
     function GetFileBaseDir(aOutput: String): String; virtual;
-
+    function InterPretOption(const Cmd, Arg: String): boolean; override;
     function  ModuleHasClasses(AModule: TPasModule): Boolean;
     Property PageInfos : TFPObjectList Read FPageInfos;
+    Property SubPageNames: Boolean Read FSubPageNames;
   Public
     constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
     Destructor Destroy; override;
     procedure WriteDoc; override;
+    class procedure Usage(List: TStrings); override;
     property PageCount: Integer read GetPageCount;
-    Property Allocator : TFileAllocator Read FAllocator Write FAllocator;
+    Property Allocator : TFileAllocator Read FAllocator;
     Property Module: TPasModule  Read FModule Write FModule;
     Property CurDirectory: String Read FCurDirectory Write FCurDirectory;    // relative to curdir of process
     property BaseDirectory: String read FBaseDirectory Write FBaseDirectory; // relative path to package base directory
@@ -398,6 +411,7 @@ constructor TMultiFileDocWriter.Create(APackage: TPasPackage;
 begin
   inherited Create(APackage, AEngine);
   FPageInfos:=TFPObjectList.Create;
+  FSubPageNames:= False;
 end;
 
 destructor TMultiFileDocWriter.Destroy;
@@ -758,6 +772,7 @@ var
 
 begin
   FAllocator:=CreateAllocator;
+  FAllocator.SubPageNames:= SubPageNames;
   AllocatePages;
   DoLog(SWritingPages, [PageCount]);
   if Engine.Output <> '' then
@@ -772,7 +787,19 @@ begin
        end;
 end;
 
+class procedure TMultiFileDocWriter.Usage(List: TStrings);
+begin
+  List.AddStrings(['--use-subpagenames', SUsageSubNames]);
+end;
 
+function TMultiFileDocWriter.InterPretOption(const Cmd, Arg: String): boolean;
+begin
+  Result := True;
+  if Cmd = '--use-subpagenames' then
+    FSubPageNames:= True
+  else
+    Result:=inherited InterPretOption(Cmd, Arg);
+end;
 
 
 { TWriterRecord }
@@ -882,6 +909,36 @@ end;
   TFileAllocator
   ---------------------------------------------------------------------}
 
+function TFileAllocator.GetFilePostfix(ASubindex: Integer): String;
+begin
+  if FSubPageNames then
+  case ASubindex of
+    IdentifierIndex: Result:='';
+    ResstrSubindex: Result:='reestr';
+    ConstsSubindex: Result:='consts';
+    TypesSubindex: Result:='types';
+    ClassesSubindex: Result:='classes';
+    ProcsSubindex: Result:='procs';
+    VarsSubindex: Result:='vars';
+    TopicsSubIndex: Result:='topics';
+    IndexSubIndex: Result:='indexes';
+    ClassHierarchySubIndex: Result:='class-tree';
+    InterfaceHierarchySubIndex: Result:='interface-tree';
+    PropertiesByInheritanceSubindex: Result:='props';
+    PropertiesByNameSubindex: Result:='props-n';
+    MethodsByInheritanceSubindex: Result:='methods';
+    MethodsByNameSubindex: Result:='methods-n';
+    EventsByInheritanceSubindex: Result:='events';
+    EventsByNameSubindex: Result:='events-n';
+  end
+    else
+  Result:= IntToStr(ASubindex);
+end;
+
+procedure TFileAllocator.Create();
+begin
+  FSubPageNames:= False;
+end;
 
 procedure TFileAllocator.AllocFilename(AElement: TPasElement;
   ASubindex: Integer);
@@ -951,11 +1008,8 @@ begin
       Result:=Result + '-'+ s + '-' + N;
     end else
       Result := LowerCase(AElement.PathName);
-    // searching for TPasModule - it is on the 2nd level
-    if Assigned(AElement.Parent) then
-      while Assigned(AElement.Parent.Parent) do
-        AElement := AElement.Parent;
     // cut off Package Name
+    AElement:= AElement.GetModule;
     Result := Copy(Result, Length(AElement.Parent.Name) + 2, MaxInt);
     // to skip dots in unit name
     i := Length(AElement.Name);
@@ -966,8 +1020,7 @@ begin
   end;
 
   if ASubindex > 0 then
-    Result := Result + '-' + IntToStr(ASubindex);
-
+    Result := Result + '-' + GetFilePostfix(ASubindex);
   Result := Result + Extension;
 end;
 
@@ -1437,12 +1490,9 @@ begin
       if Not (M is TPasExternalModule) and assigned(M.InterfaceSection) then
         Self.AddElementsFromList(L,M.InterfaceSection.Classes,True)
       end;
+      // You can see this tree by using --format=xml option
       TreeClass.BuildTree(L);
       TreeInterface.BuildTree(L);
-      {$IFDEF TREE_TEST}
-      TreeClass.SaveToXml('TreeClass.xml');
-      TreeInterface.SaveToXml('TreeInterface.xml');
-      {$ENDIF}
   Finally
     L.Free;
   end;

utils/fpdoc/fpdocclasstree.pp

@@ -5,7 +5,7 @@ unit fpdocclasstree;
 interface
 
 uses
-  Classes, SysUtils, dGlobals, pastree, contnrs{$IFDEF TREE_TEST}, DOM ,XMLWrite{$ENDIF};
+  Classes, SysUtils, dGlobals, pastree, contnrs, DOM ,XMLWrite;
 
 Type
 
@@ -48,9 +48,7 @@ Type
                           AObjectKind : TPasObjKind = okClass);
     Destructor Destroy; override;
     Function BuildTree(AObjects : TStringList) : Integer;
-{$IFDEF TREE_TEST}
     Procedure SaveToXml(AFileName: String);
-{$ENDIF}
     Property RootNode : TPasElementNode Read FRootNode;
     Property PasElToNodes: TFPObjectHashTable read FElementList;
     function GetPasElNode (APasEl: TPasElement) : TPasElementNode;
@@ -214,8 +212,7 @@ begin
   Result:= TPasElementNode(FElementList.Items[APasEl.PathName]);
 end;
 
-{$IFDEF TREE_TEST}
-procedure TClassTreeBuilder.SaveToXml ( AFileName: String ) ;
+procedure TClassTreeBuilder.SaveToXml ( AFileName: String );
 
   procedure AddPasElChildsToXml (ParentxmlEl : TDOMElement ; ParentPasEl: TPasElementNode ) ;
   var
@@ -245,6 +242,7 @@ var
   M: TPasModule;
 begin
   XmlDoc:= TXMLDocument.Create;
+  XmlDoc.AppendChild(XmlDoc.CreateComment(UTF8Decode(SDocGeneratedByComment)));
   try
     XmlRootEl:= XmlDoc.CreateElement(UnicodeString(FRootNode.Element.Name));
     M:= FRootNode.Element.GetModule;
@@ -265,7 +263,6 @@ begin
     XmlDoc.Free;
   end;
 end;
-{$ENDIF}
 
 end.