* synchronized with trunk

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

.gitattributes

@@ -16765,6 +16765,7 @@ tests/webtbf/tw37476.pp svneol=native#text/pascal
 tests/webtbf/tw37763.pp svneol=native#text/pascal
 tests/webtbf/tw3790.pp svneol=native#text/plain
 tests/webtbf/tw3812.pp svneol=native#text/plain
+tests/webtbf/tw38287.pp svneol=native#text/pascal
 tests/webtbf/tw38289a.pp svneol=native#text/pascal
 tests/webtbf/tw38289b.pp svneol=native#text/pascal
 tests/webtbf/tw3930a.pp svneol=native#text/plain

compiler/aarch64/aasmcpu.pas

@@ -1018,6 +1018,7 @@ implementation
           A_TST,
           A_FCMP,A_FCMPE,
           A_CBZ,A_CBNZ,
+          A_PRFM,A_PRFUM,
           A_RET:
             result:=operand_read;
           A_STR,A_STUR:
@@ -1026,14 +1027,6 @@ implementation
             else
               { check for pre/post indexed in spilling_get_operation_type_ref }
               result:=operand_read;
-          A_STLXP,
-          A_STLXR,
-          A_STXP,
-          A_STXR:
-            if opnr=0 then
-              result:=operand_write
-            else
-              result:=operand_read;
           A_STP:
             begin
               if opnr in [0,1] then
@@ -1102,12 +1095,21 @@ implementation
            A_FCVTZS,
            A_SDIV,
            A_SMULL,
+           A_STLXP,
+           A_STLXR,
+           A_STXP,
+           A_STXR,
            A_SUB,
+           A_SXTB,
+           A_SXTH,
+           A_SXTW,
            A_UBFIZ,
            A_UBFX,
            A_UCVTF,
            A_UDIV,
-           A_UMULL:
+           A_UMULL,
+           A_UXTB,
+           A_UXTH:
              if opnr=0 then
                result:=operand_write
              else

compiler/aarch64/cgcpu.pas

@@ -587,6 +587,9 @@ implementation
         manipulated_a: tcgint;
         leftover_a: word;
       begin
+{$ifdef extdebug}
+        list.concat(tai_comment.Create(strpnew('Generating constant ' + tostr(a))));
+{$endif extdebug}
         case a of
           { Small positive number }
           $0..$FFFF:

compiler/scanner.pas

@@ -135,6 +135,8 @@ interface
           { if nexttoken<>NOTOKEN, then nexttokenpos holds its filepos }
           next_filepos   : tfileposinfo;
 
+          { current macro nesting depth }
+          macro_nesting_depth,
           comment_level,
           yylexcount     : longint;
           ignoredirectives : TFPHashList; { ignore directives, used to give warnings only once }
@@ -2922,7 +2924,10 @@ type
         if assigned(inputfile.next) then
          begin
            if inputfile.is_macro then
-             to_dispose:=inputfile
+             begin
+               to_dispose:=inputfile;
+               dec(macro_nesting_depth);
+             end
            else
              begin
                to_dispose:=nil;
@@ -3686,6 +3691,7 @@ type
         addfile(hp);
         with inputfile do
          begin
+           inc(macro_nesting_depth);
            setmacro(p,len);
          { local buffer }
            inputbuffer:=buf;
@@ -4868,7 +4874,7 @@ type
                  mac:=tmacro(search_macro(pattern));
                  if assigned(mac) and (not mac.is_compiler_var) and (assigned(mac.buftext)) then
                   begin
-                    if yylexcount<max_macro_nesting then
+                    if (yylexcount<max_macro_nesting) and (macro_nesting_depth<max_macro_nesting) then
                      begin
                        mac.is_used:=true;
                        inc(yylexcount);

packages/fcl-db/src/sqldb/sqldb.pp

@@ -802,6 +802,7 @@ type
     Property Proxy : TSQLConnection Read FProxy;
   Published
     Property ConnectorType : String Read FConnectorType Write SetConnectorType;
+    Property Port;
   end;
 
   TSQLConnectionClass = Class of TSQLConnection;
@@ -1197,8 +1198,12 @@ end;
 
 procedure TCustomSQLStatement.DeAllocateCursor;
 begin
-  if Assigned(FCursor) and Assigned(Database) then
-    DataBase.DeAllocateCursorHandle(FCursor);
+  if Assigned(FCursor) then
+     begin
+     if Assigned(Database) then
+       DataBase.DeAllocateCursorHandle(FCursor);
+     FreeAndNil(FCursor);
+     end;
 end;
 
 function TCustomSQLStatement.ExpandMacros( OrigSQL : String ) : String;
@@ -1515,6 +1520,7 @@ begin
     end;
   finally;
     DeAllocateCursorHandle(Cursor);
+    FreeAndNil(Cursor);
   end;
 end;
 

tests/webtbf/tw38287.pp

@@ -0,0 +1,11 @@
+{$macro on}
+var
+  a,b,s : real;
+
+begin
+  a:=1;
+  b:=2;
+{$define sum:=a+b }
+{$define b:=sum} { DON’T do this !!!}
+  s:=sum;         { Will be infinitely recursively expanded... }
+end.

utils/fpdoc/dw_basehtml.pp

@@ -1012,7 +1012,7 @@ begin
           break;
         ThisPackage := ThisPackage.NextSibling;
         end;
-      if Length(s) = 0 then
+      if (Length(s) = 0) and Assigned(Module) then
         begin
         { Okay, then we have to try all imported units of the current module }
         UnitList := Module.InterfaceSection.UsesList;
@@ -1038,6 +1038,8 @@ begin
     end
   else if Element is TPasEnumValue then
     s := ResolveLinkID(Element.Parent.PathName)
+  else if Element is TPasAliasType then
+    s := ResolveLinkID(TPasAliasType(Element).DestType.PathName)
   else
     s := ResolveLinkID(Element.PathName);
 
@@ -1049,7 +1051,10 @@ begin
   else
     begin
     Result := nil;
-    AppendText(Parent, Element.Name); // unresolved items
+    if  Element is TPasAliasType then
+      AppendText(Parent, TPasAliasType(Element).DestType.Name)
+    else
+      AppendText(Parent, Element.Name); // unresolved items
     end;
 end;
 

utils/fpdoc/dw_html.pp

@@ -1744,7 +1744,6 @@ end;
 procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
 
   procedure AppendGenericTypes(CodeEl : TDomElement; AList : TFPList; isSpecialize : Boolean);
-
   Var
     I : integer;
   begin
@@ -1759,6 +1758,16 @@ procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
     AppendSym(CodeEl, '>');
   end;
 
+  procedure AppendGeneric(ACodeEl : TDomElement ; AGenericObject: TPasClassType);
+  begin
+    if AGenericObject.GenericTemplateTypes.Count>0 then
+    begin
+      AppendKw(ACodeEl, ' generic ');
+      AppendText(ACodeEl, ' ' + UTF8Decode(AGenericObject.Name) + ' ');
+      AppendGenericTypes(ACodeEl,AGenericObject.GenericTemplateTypes,false);
+    end;
+  end;
+
   procedure AppendInterfaceInfo(ACodeEl : TDomElement ; AThisClass: TPasClassType);
   var
     i:Integer;
@@ -1777,7 +1786,7 @@ procedure THTMLWriter.CreateClassMainPage(aClass : TPasClassType);
 
 var
   ParaEl,TableEl, TREl, TDEl, CodeEl: TDOMElement;
-  ThisClass, PrevClass: TPasClassType;
+  ThisClass, PrevClass: TPasType;
   ThisTreeNode: TPasElementNode;
 begin
   //WriteLn('@ClassPageBody.CreateMainPage Class=', AClass.Name);
@@ -1799,11 +1808,14 @@ begin
   TDEl := CreateTD(TREl);
   CodeEl := CreateCode(CreatePara(TDEl));
   AppendKw(CodeEl, 'type');
+
+  if not Assigned(AClass.GenericTemplateTypes) then
+      Dolog('ERROR generic init: %s', [AClass.name]);
   if AClass.GenericTemplateTypes.Count>0 then
-    AppendKw(CodeEl, ' generic ');
-  AppendText(CodeEl, ' ' + UTF8Decode(AClass.Name) + ' ');
-  if AClass.GenericTemplateTypes.Count>0 then
-    AppendGenericTypes(CodeEl,AClass.GenericTemplateTypes,false);
+    AppendGeneric(CodeEl, AClass)
+  else
+    AppendText(CodeEl, ' ' + UTF8Decode(AClass.Name) + ' ');
+
   AppendSym(CodeEl, '=');
   AppendText(CodeEl, ' ');
   AppendKw(CodeEl, UTF8Decode(ObjKindNames[AClass.ObjKind]));
@@ -1816,16 +1828,23 @@ begin
   else
     ThisTreeNode := TreeClass.GetPasElNode(AClass);
   if not Assigned(ThisTreeNode) Then
-    DoLog('EROOR Tree Class information: '+ThisClass.PathName);
+    DoLog('ERROR Tree Class information: '+ThisClass.PathName);
 
   if Assigned(AClass.AncestorType) then
   begin
     AppendSym(CodeEl, '(');
     // Show parent class information
-    //TODO: Specialized generic classes is not processed now.
-    //      TLazFixedRoundBufferListMemBase as example
-    AppendHyperlink(CodeEl, AClass.AncestorType);
-    AppendInterfaceInfo(CodeEl, AClass);
+    if (AClass.AncestorType is TPasSpecializeType) then
+    begin
+      AppendText(CodeEl, 'specialize ');
+      AppendHyperlink(CodeEl, TPasSpecializeType(AClass.AncestorType).DestType);
+      AppendText(CodeEl, '<,>');
+    end
+    else
+    begin
+      AppendHyperlink(CodeEl, AClass.AncestorType);
+      AppendInterfaceInfo(CodeEl, AClass);
+    end;
     AppendSym(CodeEl, ')');
   end;
   // Class members
@@ -1847,8 +1866,8 @@ begin
 
     // Show class item
     AppendHyperlink(CodeEl, ThisClass);
-    if Assigned(PrevClass) then // Interfaces from prevClass
-      AppendInterfaceInfo(CodeEl, PrevClass);
+    if Assigned(PrevClass) and (PrevClass Is TPasClassType)  then // Interfaces from prevClass
+      AppendInterfaceInfo(CodeEl, TPasClassType(PrevClass));
     AppendShortDescrCell(TREl, ThisClass);
 
     if Assigned(ThisTreeNode) then

utils/fpdoc/dw_markdown.pp

@@ -421,7 +421,7 @@ begin
           break;
         ThisPackage := ThisPackage.NextSibling;
         end;
-      if Length(s) = 0 then
+      if (Length(s) = 0) and Assigned(Module) then
         begin
         { Okay, then we have to try all imported units of the current module }
         UnitList := Module.InterfaceSection.UsesList;
@@ -1577,7 +1577,7 @@ procedure TMarkdownWriter.CreateClassMainPage(aClass : TPasClassType);
 var
   i: Integer;
   ThisInterface,
-  ThisClass: TPasClassType;
+  ThisClass: TPasType;
   ThisTreeNode: TPasElementNode;
   DocNode: TDocNode;
 
@@ -1627,12 +1627,12 @@ begin
     // Show class item
     if Assigned(ThisClass) Then
       AppendHyperlink(ThisClass);
-    if Assigned(ThisClass) and (ThisClass.Interfaces.count>0) then
+    if Assigned(ThisClass) and (AClass.Interfaces.count>0) then
       begin
       AppendText('(');
-      for i:=0 to ThisClass.interfaces.count-1 do
+      for i:=0 to AClass.interfaces.count-1 do
         begin
-        ThisInterface:=TPasClassType(ThisClass.Interfaces[i]);
+        ThisInterface:= TPasType(AClass.Interfaces[i]);
         if I>0 then
           AppendText(', ');
         AppendHyperlink( ThisInterface);

utils/fpdoc/dwriter.pp

@@ -256,6 +256,8 @@ Type
     FModule: TPasModule;
     FPageInfos: TFPObjectList;     // list of TPageInfo objects
     FLinkUnresolvedCnt: Integer;
+    FOutputPageNames: TStringList;
+    function GetOutputPageNames: TStrings;
     function GetPageCount: Integer;
     function LinkFix(ALink:String):String;
   Protected
@@ -286,6 +288,7 @@ Type
     function  ModuleHasClasses(AModule: TPasModule): Boolean;
     // Allocate pages etc.
     Procedure DoWriteDocumentation; override;
+    Function MustGeneratePage(aFileName : String) : Boolean; virtual;
 
     Property PageInfos : TFPObjectList Read FPageInfos;
     Property SubPageNames: Boolean Read FSubPageNames;
@@ -298,6 +301,7 @@ Type
     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
+    Property OutputPageNames : TStrings Read GetOutputPageNames;
  end;
 
   TFPDocWriterClass = Class of TFPDocWriter;
@@ -328,7 +332,7 @@ function SortPasElements(Item1, Item2: Pointer): Integer;
 
 implementation
 
-uses fpdocstrs;
+uses strutils, fpdocstrs;
 
 function SortPasElements(Item1, Item2: Pointer): Integer;
 begin
@@ -418,6 +422,16 @@ begin
   Result := PageInfos.Count;
 end;
 
+function TMultiFileDocWriter.GetOutputPageNames: TStrings;
+begin
+  If (FoutputPageNames=Nil) then
+    begin
+    FOutputPageNames:=TStringList.Create;
+    FOutputPageNames.Sorted:=True;
+    end;
+  Result:=FOutputPageNames;
+end;
+
 procedure TMultiFileDocWriter.OutputResults();
 begin
   DoLog('Unresolved links: %d', [FLinkUnresolvedCnt]);
@@ -826,22 +840,59 @@ begin
      with TPageInfo(PageInfos[i]) do
        begin
        FileName:= Allocator.GetFilename(Element, SubpageIndex);
-       FinalFilename := GetFileBaseDir(Engine.Output) + FileName;
-       CreatePath(FinalFilename);
-       WriteDocPage(FileName,ELement,SubPageIndex);
+       if MustGeneratePage(FileName) then
+         begin
+         FinalFilename := GetFileBaseDir(Engine.Output) + FileName;
+         CreatePath(FinalFilename);
+         WriteDocPage(FileName,ELement,SubPageIndex);
+         end;
        end;
 end;
 
+function TMultiFileDocWriter.MustGeneratePage(aFileName: String): Boolean;
+begin
+  Result:=Not Assigned(FOutputPageNames);
+  if Not Result then
+    Result:=FOutputPageNames.IndexOf(aFileName)<>-1;
+  Writeln(afilename ,': ',result);
+end;
+
 class procedure TMultiFileDocWriter.Usage(List: TStrings);
 begin
   List.AddStrings(['--use-subpagenames', SUsageSubNames]);
+  List.AddStrings(['--only-pages=LIST', SUsageOnlyPages]);
 end;
 
 function TMultiFileDocWriter.InterPretOption(const Cmd, Arg: String): boolean;
+
+Var
+  I : Integer;
+  FN : String;
+
 begin
+  Writeln('Cmd : ',Cmd);
   Result := True;
   if Cmd = '--use-subpagenames' then
     FSubPageNames:= True
+  else
+  if Cmd = '--only-pages' then
+    begin
+    Result:=Arg<>'';
+    if Result then
+      begin
+      if Arg[1]='@' then
+        begin
+        FN:=Copy(Arg,2,Length(Arg)-1);
+        OutputPageNames.LoadFromFile(FN);
+        end
+      else
+        begin
+        For I:=1 to WordCount(Arg,[',']) do
+          OutputPageNames.Add(ExtractWord(I,Arg,[',']));
+        end;
+      Writeln('OutputPagenames ',OutputPagenames.CommaText);
+      end
+    end
   else
     Result:=inherited InterPretOption(Cmd, Arg);
 end;

utils/fpdoc/fpdoc.lpi

@@ -158,8 +158,8 @@
       </Debugging>
     </Linking>
     <Other>
-      <CustomOptions Value="-dCheckPasTreeRefCount
--dDebugRefCount"/>
+      <CustomOptions Value="-dCheckPasTreeRefCountx
+-dDebugRefCountx"/>
       <OtherDefines Count="1">
         <Define0 Value="CheckPasTreeRefCount"/>
       </OtherDefines>

utils/fpdoc/fpdocclasstree.pp

@@ -16,17 +16,17 @@ Type
 
   TPasElementNode = Class
   Private
-    FElement : TPasClassType;
+    FElement : TPasType;
     FParentNode: TPasElementNode;
     FChildren : TFPObjectList;
     function GetChild(aIndex : Integer): TPasElementNode;
     function GetChildCount: Integer;
   Public
-    Constructor Create (aElement : TPasClassType);
+    Constructor Create (aElement : TPasType);
     Destructor Destroy; override;
     Procedure AddChild(C : TPasElementNode);
     Procedure SortChildren;
-    Property Element : TPasClassType Read FElement;
+    Property Element : TPasType Read FElement;
     Property ParentNode : TPasElementNode read  FParentNode;
     Property Children [aIndex : Integer] : TPasElementNode Read GetChild;
     Property ChildCount : Integer Read GetChildCount;
@@ -45,7 +45,7 @@ Type
     FRootObjectName : string;
     FRootObjectPathName : string;
   Protected
-    function AddToList(aElement: TPasClassType): TPasElementNode;
+    function AddToList(aElement: TPasType): TPasElementNode;
   Public
     Constructor Create(AEngine:TFPDocEngine; APackage : TPasPackage;
                           AObjectKind : TPasObjKindSet = okWithFields);
@@ -85,7 +85,7 @@ begin
     Result:=0
 end;
 
-constructor TPasElementNode.Create(aElement: TPasClassType);
+constructor TPasElementNode.Create(aElement: TPasType);
 begin
   FElement:=aElement;
 end;
@@ -154,30 +154,42 @@ begin
   Inherited;
 end;
 
-function TClassTreeBuilder.AddToList ( aElement: TPasClassType
+function TClassTreeBuilder.AddToList ( aElement: TPasType
   ) : TPasElementNode;
 
 Var
   aParentNode : TPasElementNode;
   aName : String;
+  aElementClass: TPasClassType;
 
 begin
-  Result:= nil;
-  if not (aElement.ObjKind in FObjectKind) then exit;
+  Result:= nil; aElementClass:=nil;
+  if  (aElement is TPasClassType) then
+    aElementClass:= TPasClassType(aElement);
+  if Assigned(aElementClass) and not (aElementClass.ObjKind in FObjectKind) then exit;
+  if not Assigned(aElementClass) and not (aElement is TPasAliasType) then exit;
 
   aParentNode:= nil;
   if aElement=Nil then
     aName:=FRootObjectName
+  else if (aElement is TPasAliasType) then
+    aName:=TPasAliasType(aElement).DestType.FullName
   else
     aName:=aElement.PathName;
   Result:=TPasElementNode(FElementList.Items[aName]);
   if (Result=Nil) then
   begin
-    if aElement.AncestorType is TPasClassType then
-      aParentNode:=AddToList(aElement.AncestorType as TPasClassType);
+    if Assigned(aElementClass) and (
+        (aElementClass.AncestorType is TPasClassType) or
+        (aElementClass.AncestorType is TPasAliasType)
+                                    ) then
+       aParentNode:=AddToList(aElementClass.AncestorType);
     if not Assigned(aParentNode) then
       aParentNode:=FRootNode;
-    Result:=TPasElementNode.Create(aElement);
+    if (aElement is TPasAliasType) then
+      Result:=TPasElementNode.Create(TPasAliasType(TPasType(aElement)).DestType)
+    else
+      Result:=TPasElementNode.Create(aElement);
     aParentNode.AddChild(Result);
     Result.FParentNode := aParentNode;
     FElementList.Add(aName,Result);

utils/fpdoc/fpdocstrs.pp

@@ -189,6 +189,7 @@ resourcestring
   SUsageOption310  = '--write-project=file';
   SUsageOption320  = '                  Write all command-line options to a project file';
   SUsageSubNames   = 'Use the file subnames instead the indexes as postfixes';
+  SUsageOnlyPages  = 'Only write pages in LIST, LIST is comma-separated list of filenames or @filename where the named file contains 1 file per line.';
 
   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.';