Merge branch 'main' into wasm_reference_types

compiler/globals.pas

@@ -653,7 +653,7 @@ interface
     function getrealtime(const st: TSystemTime) : real;
     function getrealtime : real;
 
-    procedure DefaultReplacements(var s:ansistring);
+    procedure DefaultReplacements(var s:ansistring; substitute_env_variables:boolean=true);
 
     function  GetEnvPChar(const envname:ansistring):pchar;
     procedure FreeEnvPChar(p:pchar);
@@ -952,7 +952,7 @@ implementation
 ****************************************************************************}
 
 
-     procedure DefaultReplacements(var s:ansistring);
+     procedure DefaultReplacements(var s:ansistring; substitute_env_variables:boolean=true);
 {$ifdef mswindows}
        procedure ReplaceSpecialFolder(const MacroName: string; const ID: integer);
          begin
@@ -1024,6 +1024,8 @@ implementation
          Replace(s,'$OPENBSD_LOCALBASE',GetOpenBSDLocalBase);
          Replace(s,'$OPENBSD_X11BASE',GetOpenBSDX11Base);
 {$endif openbsd}
+         if not substitute_env_variables then
+           exit;
          { Replace environment variables between dollar signs }
          i := pos('$',s);
          while i>0 do

compiler/verbose.pas

@@ -622,7 +622,7 @@ implementation
       { Create status info }
         UpdateStatus;
       { Fix replacements }
-        DefaultReplacements(s);
+        DefaultReplacements(s,false);
       { show comment }
         if do_comment(l,s) or dostop then
           raise ECompilerAbort.Create;
@@ -754,7 +754,7 @@ implementation
       { fix status }
         UpdateStatus;
       { Fix replacements }
-        DefaultReplacements(s);
+        DefaultReplacements(s,false);
         if status.showmsgnrs and ((v and V_Normal)=0) then
           s:='('+tostr(w)+') '+s;
         if doqueue then

packages/fcl-fpcunit/src/fpcunit.pp

@@ -229,6 +229,7 @@ type
     function CreateResultAndRun: TTestResult; virtual;
     procedure Run(AResult: TTestResult); override;
     function AsString: string;
+    class function Suite : TTestSuite;
     property TestSuiteName: string read GetTestSuiteName write SetTestSuiteName;
     Property ExpectedExceptionFailMessage  : String Read FExpectedExceptionFailMessage;
     Property ExpectedException : TClass Read FExpectedException;
@@ -1012,6 +1013,11 @@ begin
   Result := TestName + '(' + ClassName + ')';
 end;
 
+class function TTestCase.Suite: TTestSuite;
+begin
+  Result:=TTestSuite.Create(Self.ClassType);
+end;
+
 
 function TTestCase.CountTestCases: integer;
 begin

packages/fcl-fpcunit/src/testregistry.pp

@@ -34,6 +34,10 @@ procedure RegisterTest(const ASuitePath: String; ATest: TTest); overload;
 procedure RegisterTests(ATests: Array of TTestCaseClass);
 procedure RegisterTests(const ASuitePath: String; ATests: Array of TTestCaseClass);
 
+procedure RegisterTest(aSuite: TTestSuite);
+procedure RegisterTest(const aSuitePath : String; aSuite: TTestSuite);
+
+
 procedure RegisterTestDecorator(ADecoratorClass: TTestDecoratorClass; ATestClass: TTestCaseClass);
 
 function NumberOfRegisteredTests: longint;
@@ -151,6 +155,16 @@ begin
     end;
 end;
 
+procedure RegisterTest(aSuite: TTestSuite);
+begin
+  GetTestRegistry.AddTest(aSuite);
+end;
+
+procedure RegisterTest(const aSuitePath: String; aSuite: TTestSuite);
+begin
+  RegisterTestInSuite(GetTestRegistry, aSuitePath, aSuite);
+end;
+
 
 function NumberOfRegisteredTests: longint;
 begin

packages/fcl-fpcunit/src/tests/asserttest.pp

@@ -403,12 +403,12 @@ begin
   ts := TTestSuite.Create(TTestIgnore);
   try
     AssertTrue('EnableIgnores must be True at creation', ts.EnableIgnores);
-    for i := 0 to ts.Tests.Count - 1 do
-      AssertTrue('EnableIgnores of Test ' + IntToStr(i) + ' must be True at creation', TTest(ts.Tests[i]).EnableIgnores);
+    for i := 0 to ts.ChildTestCount - 1 do
+      AssertTrue('EnableIgnores of Test ' + IntToStr(i) + ' must be True at creation', ts.Test[i].EnableIgnores);
     ts.EnableIgnores := False; 
     AssertFalse('EnableIgnores was not set to false', ts.EnableIgnores);
-    for i := 0 to ts.Tests.Count - 1 do
-      AssertFalse('EnableIgnores of Test ' + IntToStr(i) + ' was not set to False', TTest(ts.Tests[i]).EnableIgnores);
+    for i := 0 to ts.ChildTestCount - 1 do
+      AssertFalse('EnableIgnores of Test ' + IntToStr(i) + ' was not set to False', ts.Test[i].EnableIgnores);
   finally
     ts.Free;
   end;

packages/fcl-fpcunit/src/tests/suitetest.pp

@@ -53,6 +53,8 @@ type
     procedure Test2;
   end;
 
+  { TSuiteTest }
+
   TSuiteTest = class(TTestCase)
   private
     FResult: TTestResult;
@@ -70,6 +72,7 @@ type
     procedure testShadowedTests;
     procedure testAddTestSuiteFromClass;
     procedure testCreateTestSuiteFromArray;
+    procedure testTestCaseAsSuite;
   end;
 
 
@@ -217,6 +220,20 @@ begin
   end;
 end;
 
+procedure TSuiteTest.testTestCaseAsSuite;
+var
+  ts: TTestSuite;
+begin
+  ts := TOneTestCase.Suite;
+  try
+    AssertEquals(1, ts.CountTestCases);
+    AssertEquals(1, ts.Tests.Count);
+    AssertEquals('OnlyOneTestCase', ts[0].TestName);
+  finally
+    ts.Free;
+  end;
+end;
+
 initialization
 
   RegisterTests([TSuiteTest]);

packages/fcl-image/fpmake.pp

@@ -299,19 +299,19 @@ begin
       AddUnit('fpqrcodegen');
       end;
     // qoi  
-    T:=P.Targets.AddUnit('qoicomn.pp');
+    T:=P.Targets.AddUnit('qoicomn.pas');
       with T.Dependencies do
         begin
           AddUnit('fpimage');
           AddUnit('fpimgcmn');
         end;
-    T:=P.Targets.AddUnit('fpreadqoi.pp');
+    T:=P.Targets.AddUnit('fpreadqoi.pas');
       with T.Dependencies do
         begin
           AddUnit('fpimage');
           AddUnit('qoicomn');
         end;
-    T:=P.Targets.AddUnit('fpwriteqoi.pp');
+    T:=P.Targets.AddUnit('fpwriteqoi.pas');
       with T.Dependencies do
         begin
           AddUnit('fpimage');

packages/fcl-web/src/base/fphttpserver.pp

@@ -89,7 +89,7 @@ Type
     // Read the request content
     procedure ReadRequestContent(ARequest: TFPHTTPConnectionRequest); virtual;
     // Allow descendents to handle unknown headers
-    procedure UnknownHeader(ARequest: TFPHTTPConnectionRequest; const AHeader: String); virtual;
+    procedure UnknownHeader({%H-}ARequest: TFPHTTPConnectionRequest; const {%H-}AHeader: String); virtual;
     // Handle request error, calls OnRequestError
     procedure HandleRequestError(E : Exception); virtual;
     // Handle unexpected error, calls OnUnexpectedError
@@ -190,13 +190,12 @@ Type
 
   TFPHTTPServerConnectionListHandler = Class(TFPHTTPServerConnectionHandler)
   Private
-
     FList: TConnectionList;
   Protected
     Type
       TConnectionIterator = Procedure (aConnection :TFPHTTPConnection; var aContinue : boolean) of object;
     Function CreateList : TConnectionList;
-    Procedure CloseConnectionSocket(aConnection :TFPHTTPConnection; var aContinue : boolean);
+    Procedure CloseConnectionSocket(aConnection :TFPHTTPConnection; var {%H-}aContinue : boolean);
     Procedure Foreach(aIterator : TConnectionIterator);
     Procedure RemoveConnection(aConnection :TFPHTTPConnection); override;
   Public
@@ -255,8 +254,8 @@ Type
          Property OnDone : TNotifyEvent Read FOnDone;
        end;
     procedure ConnectionDone(Sender: TObject); virtual;
-    procedure ScheduleRequest(aConnection: TFPHTTPConnection);virtual;
-    procedure CheckRequest(aConnection: TFPHTTPConnection; var aContinue : Boolean);virtual;
+    procedure ScheduleRequest(aConnection: TFPHTTPConnection); virtual;
+    procedure CheckRequest(aConnection: TFPHTTPConnection; var {%H-}aContinue: Boolean); virtual;
   Public
     Procedure CloseSockets; override;
     procedure CheckRequests; override;
@@ -300,7 +299,6 @@ Type
 
   { TConnectionList }
 
-
   THTTPLogEvent = Procedure (aSender : TObject; aType: TEventType; Const Msg : String) of object;
   // Events in the lifetime of a request that are logged
   THTTPLogMoment = (hlmStartSocket,hlmCloseSocket,hlmConnect,hlmNoHTTPProtocol, hlmEmptyRequest, hlmRequestStart,hlmHeaders,hlmRequestDone,hlmUpgrade,hlmDisconnect,hlmError);
@@ -347,7 +345,7 @@ Type
     procedure SetActive(const AValue: Boolean);
     procedure SetCertificateData(AValue: TCertificateData);
     procedure SetHostName(const AValue: string);
-    procedure SetIdle(AValue: TNotifyEvent);
+    procedure SetIdle(const AValue: TNotifyEvent);
     procedure SetOnAllowConnect(const AValue: TConnectQuery);
     procedure SetAddress(const AValue: string);
     procedure SetPort(const AValue: Word);
@@ -364,9 +362,9 @@ Type
     Procedure DoLog(aMoment : THTTPLogMoment; const Fmt : String; Const Args : Array of const); overload;
     Function CheckUpgrade(aConnection : TFPHTTPConnection; aRequest : TFPHTTPConnectionRequest) : Boolean;
     // Override this to create Descendent
-    Function CreateUpgradeHandlerList : TUpgradeHandlerList;
+    Function CreateUpgradeHandlerList : TUpgradeHandlerList; virtual;
     // Override this to create descendent
-    function CreateSSLSocketHandler: TSocketHandler;
+    function CreateSSLSocketHandler: TSocketHandler; virtual;
     // Override this to create descendent
     Function CreateCertificateData : TCertificateData; virtual;
     // Override this to create descendent
@@ -374,20 +372,20 @@ Type
     // Override these to create descendents of the request/response instead.
     Function CreateRequest : TFPHTTPConnectionRequest; virtual;
     Function CreateResponse(ARequest : TFPHTTPConnectionRequest) : TFPHTTPConnectionResponse; virtual;
-    Procedure InitRequest(ARequest : TFPHTTPConnectionRequest); virtual;
-    Procedure InitResponse(AResponse : TFPHTTPConnectionResponse); virtual;
+    Procedure InitRequest({%H-}ARequest : TFPHTTPConnectionRequest); virtual;
+    Procedure InitResponse({%H-}AResponse : TFPHTTPConnectionResponse); virtual;
     // Called on accept errors
-    procedure DoAcceptError(Sender: TObject; ASocket: Longint; E: Exception;  var ErrorAction: TAcceptErrorAction);
+    procedure DoAcceptError(Sender: TObject; {%H-}ASocket: Longint; {%H-}E: Exception;  var ErrorAction: TAcceptErrorAction); virtual;
     // Called when accept is idle. Will check for new requests.
-    procedure DoAcceptIdle(Sender: TObject);
+    procedure DoAcceptIdle(Sender: TObject); virtual;
     // Called when KeepConnection is idle.
-    procedure DoKeepConnectionIdle(Sender: TObject);
+    procedure DoKeepConnectionIdle(Sender: TObject); virtual;
     // Create a connection handling object.
     function CreateConnection(Data : TSocketStream) : TFPHTTPConnection; virtual;
     // Create a connection handler object depending on threadmode
     Function CreateConnectionHandler : TFPHTTPServerConnectionHandler; virtual;
     // Check if server is inactive
-    Procedure CheckInactive;
+    Procedure CheckInactive; virtual;
     // Called by TInetServer when a new connection is accepted.
     Procedure DoConnect(Sender : TObject; Data : TSocketStream); virtual;
     // Create and configure TInetServer
@@ -424,7 +422,7 @@ Type
     class constructor init;
     Constructor Create(AOwner : TComponent); override;
     Destructor Destroy; override;
-    Function RegisterUpdateHandler(Const aName : string;  OnCheck : THandlesUpgradeEvent; OnUpgrade : TUpgradeConnectionEvent) : TUpgradeHandlerItem;
+    Function RegisterUpdateHandler(Const aName : string; const OnCheck : THandlesUpgradeEvent; const OnUpgrade : TUpgradeConnectionEvent) : TUpgradeHandlerItem;
     Procedure UnRegisterUpdateHandler(Const aName : string);
   protected
     // Set to true to start listening.
@@ -580,12 +578,13 @@ begin
     Result:=GetHandlerItem(Idx);
 end;
 
-function TUpgradeHandlerList.AddHandler(const aName: String; aOnCheck: THandlesUpgradeEvent; aOnUpgrade: TUpgradeConnectionEvent
+function TUpgradeHandlerList.AddHandler(const aName: String;
+  aOnCheck: THandlesUpgradeEvent; aOnUpgrade: TUpgradeConnectionEvent
   ): TUpgradeHandlerItem;
 begin
   if IndexOfName(aName)<>-1 then
     Raise EHTTPServer.CreateFmt(SErrDuplicateUpgradeHandler,[aName]);
-  Result:=add as TUpgradeHandlerItem;
+  Result:=Add as TUpgradeHandlerItem;
   Result.Name:=aName;
   Result.OnHandleUpgrade:=aOnCheck;
   Result.OnUpgrade:=aOnUpgrade;
@@ -977,7 +976,7 @@ begin
       On E : exception do
         HandleUnexpectedError(E);
     end
- else if Assigned(Server) and Server.CanLog(hlmError) then
+  else if Assigned(Server) and Server.CanLog(hlmError) then
     Server.DoLog(hlmError,SErrorDuringRequest,[E.ClassName,E.Message]);
 end;
 
@@ -1026,7 +1025,8 @@ begin
   ARequest.SetFieldByName(N,V);
 end;
 
-procedure TFPHTTPConnection.ParseStartLine(Request : TFPHTTPConnectionRequest; AStartLine : String);
+procedure TFPHTTPConnection.ParseStartLine(Request : TFPHTTPConnectionRequest;
+  AStartLine : String);
 
   Function GetNextWord(Var S : String) : string;
 
@@ -1468,7 +1468,7 @@ begin
         StartServerSocket;
       finally
         FreeServerSocket;
-      end
+      end;
       end
     else
       StopServerSocket;
@@ -1485,7 +1485,7 @@ begin
   FCertificateData.HostName:=aValue;
 end;
 
-procedure TFPCustomHttpServer.SetIdle(AValue: TNotifyEvent);
+procedure TFPCustomHttpServer.SetIdle(const AValue: TNotifyEvent);
 begin
   FOnAcceptIdle:=AValue;
   if Assigned(FServer) then
@@ -1607,7 +1607,6 @@ begin
   FConnectionHandler:=CreateConnectionHandler();
 end;
 
-
 function TFPCustomHttpServer.CanLog(aMoment: THTTPLogMoment): Boolean;
 begin
   Result:=aMoment in FLogMoments;
@@ -1632,13 +1631,11 @@ begin
     DoLog(aMoment,Format(Fmt,Args));
 end;
 
-
 function TFPCustomHttpServer.CheckUpgrade(aConnection: TFPHTTPConnection; aRequest: TFPHTTPConnectionRequest): Boolean;
 
 Var
   I : Integer;
   Handler : TUpgradeHandlerItem;
-  S : String;
 
 begin
   Result:=HasUpdateHandlers;
@@ -1673,7 +1670,7 @@ end;
 procedure TFPCustomHttpServer.HandleUnexpectedError(Sender: TObject; E: Exception);
 begin
   if CanLog(hlmError) then
-     DoLog(hlmError,SErrorDuringRequest,[E.ClassName,E.Message]);
+    DoLog(hlmError,SErrorDuringRequest,[E.ClassName,E.Message]);
   If Assigned(FOnUnexpectedError) then
     FOnUnexpectedError(Sender,E);
 end;
@@ -1800,8 +1797,9 @@ begin
   inherited Destroy;
 end;
 
-function TFPCustomHttpServer.RegisterUpdateHandler(const aName: string; OnCheck: THandlesUpgradeEvent;
-  OnUpgrade: TUpgradeConnectionEvent): TUpgradeHandlerItem;
+function TFPCustomHttpServer.RegisterUpdateHandler(const aName: string;
+  const OnCheck: THandlesUpgradeEvent; const OnUpgrade: TUpgradeConnectionEvent
+  ): TUpgradeHandlerItem;
 begin
   With UpdateHandlers do
     Result:=AddHandler(aName,OnCheck,OnUpgrade)

packages/rtl-objpas/src/inc/rtti.pp

@@ -49,6 +49,11 @@ type
   TRttiProperty = class;
   TRttiInstanceType = class;
 
+  TCustomAttributeClass = class of TCustomAttribute;
+  TRttiClass = class of TRttiObject;
+
+  TCustomAttributeArray = specialize TArray<TCustomAttribute>;
+
   TFunctionCallCallback = class
   protected
     function GetCodeAddress: CodePointer; virtual; abstract;
@@ -220,7 +225,11 @@ type
   protected
     function GetHandle: Pointer; virtual; abstract;
   public
-    function GetAttributes: specialize TArray<TCustomAttribute>; virtual; abstract;
+    function HasAttribute(aClass: TCustomAttributeClass): Boolean;
+    function GetAttribute(aClass: TCustomAttributeClass): TCustomAttribute;
+    generic function GetAttribute<T>: T;
+    generic function HasAttribute<T>: Boolean;
+    function GetAttributes: TCustomAttributeArray; virtual; abstract;
     property Handle: Pointer read GetHandle;
   end;
 
@@ -230,6 +239,7 @@ type
   protected
     function GetName: string; virtual;
   public
+    function HasName(const aName: string): Boolean;
     property Name: string read GetName;
   end;
 
@@ -239,7 +249,7 @@ type
   private
     FTypeInfo: PTypeInfo;
     FAttributesResolved: boolean;
-    FAttributes: specialize TArray<TCustomAttribute>;
+    FAttributes: TCustomAttributeArray;
     FMethods: specialize TArray<TRttiMethod>;
     function GetAsInstance: TRttiInstanceType;
   protected
@@ -257,7 +267,7 @@ type
   public
     constructor Create(ATypeInfo : PTypeInfo);
     destructor Destroy; override;
-    function GetAttributes: specialize TArray<TCustomAttribute>; override;
+    function GetAttributes: TCustomAttributeArray; override;
     function GetProperties: specialize TArray<TRttiProperty>; virtual;
     function GetProperty(const AName: string): TRttiProperty; virtual;
     function GetMethods: specialize TArray<TRttiMethod>; virtual;
@@ -323,6 +333,13 @@ type
     property StringKind: TRttiStringKind read GetStringKind;
   end;
 
+  TRttiAnsiStringType = class(TRttiStringType)
+  private
+    function GetCodePage: Word;
+  public
+    property CodePage: Word read GetCodePage;
+  end;
+
   TRttiPointerType = class(TRttiType)
   private
     function GetReferredType: TRttiType;
@@ -377,7 +394,7 @@ type
   private
     FPropInfo: PPropInfo;
     FAttributesResolved: boolean;
-    FAttributes: specialize TArray<TCustomAttribute>;
+    FAttributes: TCustomAttributeArray;
     function GetPropertyType: TRttiType;
     function GetIsWritable: boolean;
     function GetIsReadable: boolean;
@@ -388,7 +405,7 @@ type
   public
     constructor Create(AParent: TRttiType; APropInfo: PPropInfo);
     destructor Destroy; override;
-    function GetAttributes: specialize TArray<TCustomAttribute>; override;
+    function GetAttributes: TCustomAttributeArray; override;
     function GetValue(Instance: pointer): TValue;
     procedure SetValue(Instance: pointer; const AValue: TValue);
     property PropertyType: TRttiType read GetPropertyType;
@@ -396,6 +413,7 @@ type
     property IsWritable: boolean read GetIsWritable;
     property Visibility: TMemberVisibility read GetVisibility;
   end;
+  TRttiPropertyArray = specialize TArray<TRttiProperty>;
 
   TRttiParameter = class(TRttiNamedObject)
   private
@@ -408,6 +426,7 @@ type
     property Flags: TParamFlags read GetFlags;
     function ToString: String; override;
   end;
+  TRttiParameterArray = specialize TArray<TRttiParameter>;
 
   TMethodImplementationCallbackMethod = procedure(aUserData: Pointer; const aArgs: TValueArray; out aResult: TValue) of object;
   TMethodImplementationCallbackProc = procedure(aUserData: Pointer; const aArgs: TValueArray; out aResult: TValue);
@@ -423,11 +442,12 @@ type
     fFlags: TFunctionCallFlags;
     fResult: PTypeInfo;
     fCC: TCallConv;
-    function GetCodeAddress: CodePointer;
     procedure InitArgs;
     procedure HandleCallback(const aArgs: specialize TArray<Pointer>; aResult: Pointer; aContext: Pointer);
     constructor Create(aCC: TCallConv; aArgs: specialize TArray<TFunctionCallParameterInfo>; aResult: PTypeInfo; aFlags: TFunctionCallFlags; aUserData: Pointer; aCallback: TMethodImplementationCallbackMethod);
     constructor Create(aCC: TCallConv; aArgs: specialize TArray<TFunctionCallParameterInfo>; aResult: PTypeInfo; aFlags: TFunctionCallFlags; aUserData: Pointer; aCallback: TMethodImplementationCallbackProc);
+  Protected
+    function GetCodeAddress: CodePointer; inline;
   public
     constructor Create;
     destructor Destroy; override;
@@ -436,7 +456,7 @@ type
 
   TRttiInvokableType = class(TRttiType)
   protected
-    function GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>; virtual; abstract;
+    function GetParameters(aWithHidden: Boolean): TRttiParameterArray; virtual; abstract;
     function GetCallingConvention: TCallConv; virtual; abstract;
     function GetReturnType: TRttiType; virtual; abstract;
     function GetFlags: TFunctionCallFlags; virtual; abstract;
@@ -444,34 +464,36 @@ type
     TCallbackMethod = procedure(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue) of object;
     TCallbackProc = procedure(aInvokable: TRttiInvokableType; const aArgs: TValueArray; out aResult: TValue);
   public
-    function GetParameters: specialize TArray<TRttiParameter>; inline;
+    function GetParameters: TRttiParameterArray; inline;
     property CallingConvention: TCallConv read GetCallingConvention;
     property ReturnType: TRttiType read GetReturnType;
     function Invoke(const aProcOrMeth: TValue; const aArgs: array of TValue): TValue; virtual; abstract;
     { Note: once "reference to" is supported these will be replaced by a single method }
     function CreateImplementation(aCallback: TCallbackMethod): TMethodImplementation;
     function CreateImplementation(aCallback: TCallbackProc): TMethodImplementation;
+    function ToString : string; override;
   end;
 
   TRttiMethodType = class(TRttiInvokableType)
   private
     FCallConv: TCallConv;
     FReturnType: TRttiType;
-    FParams, FParamsAll: specialize TArray<TRttiParameter>;
+    FParams, FParamsAll: TRttiParameterArray;
   protected
-    function GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>; override;
+    function GetParameters(aWithHidden: Boolean): TRttiParameterArray; override;
     function GetCallingConvention: TCallConv; override;
     function GetReturnType: TRttiType; override;
     function GetFlags: TFunctionCallFlags; override;
   public
     function Invoke(const aCallable: TValue; const aArgs: array of TValue): TValue; override;
+    function ToString: string; override;
   end;
 
   TRttiProcedureType = class(TRttiInvokableType)
   private
-    FParams, FParamsAll: specialize TArray<TRttiParameter>;
+    FParams, FParamsAll: TRttiParameterArray;
   protected
-    function GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>; override;
+    function GetParameters(aWithHidden: Boolean): TRttiParameterArray; override;
     function GetCallingConvention: TCallConv; override;
     function GetReturnType: TRttiType; override;
     function GetFlags: TFunctionCallFlags; override;
@@ -505,7 +527,7 @@ type
     function GetMethodKind: TMethodKind; virtual; abstract;
     function GetReturnType: TRttiType; virtual; abstract;
     function GetVirtualIndex: SmallInt; virtual; abstract;
-    function GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>; virtual; abstract;
+    function GetParameters(aWithHidden: Boolean): TRttiParameterArray; virtual; abstract;
   public
     property CallingConvention: TCallConv read GetCallingConvention;
     property CodeAddress: CodePointer read GetCodeAddress;
@@ -519,7 +541,7 @@ type
     property ReturnType: TRttiType read GetReturnType;
     property VirtualIndex: SmallInt read GetVirtualIndex;
     function ToString: String; override;
-    function GetParameters: specialize TArray<TRttiParameter>; inline;
+    function GetParameters: TRttiParameterArray; inline;
     function Invoke(aInstance: TObject; const aArgs: array of TValue): TValue;
     function Invoke(aInstance: TClass; const aArgs: array of TValue): TValue;
     function Invoke(aInstance: TValue; const aArgs: array of TValue): TValue;
@@ -798,7 +820,7 @@ type
   private
     FIntfMethodEntry: PIntfMethodEntry;
     FIndex: SmallInt;
-    FParams, FParamsAll: specialize TArray<TRttiParameter>;
+    FParams, FParamsAll: TRttiParameterArray;
   protected
     function GetHandle: Pointer; override;
     function GetName: String; override;
@@ -813,7 +835,7 @@ type
     function GetMethodKind: TMethodKind; override;
     function GetReturnType: TRttiType; override;
     function GetVirtualIndex: SmallInt; override;
-    function GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>; override;
+    function GetParameters(aWithHidden: Boolean): TRttiParameterArray; override;
   public
     constructor Create(AParent: TRttiType; AIntfMethodEntry: PIntfMethodEntry; AIndex: SmallInt);
   end;
@@ -2712,7 +2734,7 @@ begin
   FuncCallMgr[aCallConv].Invoke(aCodeAddress, funcargs, aCallConv, aResultType, Result.GetReferenceToRawData, flags);
 end;
 
-function Invoke(const aName: String; aCodeAddress: CodePointer; aCallConv: TCallConv; aStatic: Boolean; aInstance: TValue; constref aArgs: array of TValue; const aParams: specialize TArray<TRttiParameter>; aReturnType: TRttiType): TValue;
+function Invoke(const aName: String; aCodeAddress: CodePointer; aCallConv: TCallConv; aStatic: Boolean; aInstance: TValue; constref aArgs: array of TValue; const aParams: TRttiParameterArray; aReturnType: TRttiType): TValue;
 var
   param: TRttiParameter;
   unhidden, highs, i: SizeInt;
@@ -3209,7 +3231,7 @@ begin
   FIndex := AIndex;
 end;
 
-function TRttiIntfMethod.GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>;
+function TRttiIntfMethod.GetParameters(aWithHidden: Boolean): TRttiParameterArray;
 var
   param: PVmtMethodParam;
   total, visible: SizeInt;
@@ -3513,7 +3535,7 @@ begin
     Include(Result, fcfStatic);
 end;
 
-function TRttiMethod.GetParameters: specialize TArray<TRttiParameter>;
+function TRttiMethod.GetParameters: TRttiParameterArray;
 begin
   Result := GetParameters(False);
 end;
@@ -3522,7 +3544,7 @@ function TRttiMethod.ToString: String;
 var
   ret: TRttiType;
   n: String;
-  params: specialize TArray<TRttiParameter>;
+  params: TRttiParameterArray;
   i: LongInt;
 begin
   if FString = '' then begin
@@ -3619,7 +3641,7 @@ end;
 
 function TRttiMethod.CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackMethod): TMethodImplementation;
 var
-  params: specialize TArray<TRttiParameter>;
+  params: TRttiParameterArray;
   args: specialize TArray<TFunctionCallParameterInfo>;
   res: PTypeInfo;
   restype: TRttiType;
@@ -3654,7 +3676,7 @@ end;
 
 function TRttiMethod.CreateImplementation(aUserData: Pointer; aCallback: TMethodImplementationCallbackProc): TMethodImplementation;
 var
-  params: specialize TArray<TRttiParameter>;
+  params: TRttiParameterArray;
   args: specialize TArray<TFunctionCallParameterInfo>;
   res: PTypeInfo;
   restype: TRttiType;
@@ -3689,14 +3711,14 @@ end;
 
 { TRttiInvokableType }
 
-function TRttiInvokableType.GetParameters: specialize TArray<TRttiParameter>;
+function TRttiInvokableType.GetParameters: TRttiParameterArray;
 begin
   Result := GetParameters(False);
 end;
 
 function TRttiInvokableType.CreateImplementation(aCallback: TCallbackMethod): TMethodImplementation;
 var
-  params: specialize TArray<TRttiParameter>;
+  params: TRttiParameterArray;
   args: specialize TArray<TFunctionCallParameterInfo>;
   res: PTypeInfo;
   restype: TRttiType;
@@ -3731,7 +3753,7 @@ end;
 
 function TRttiInvokableType.CreateImplementation(aCallback: TCallbackProc): TMethodImplementation;
 var
-  params: specialize TArray<TRttiParameter>;
+  params: TRttiParameterArray;
   args: specialize TArray<TFunctionCallParameterInfo>;
   res: PTypeInfo;
   restype: TRttiType;
@@ -3764,9 +3786,40 @@ begin
   Result := TMethodImplementation.Create(GetCallingConvention, args, res, GetFlags, Self, TMethodImplementationCallbackProc(aCallback));
 end;
 
+function TRttiInvokableType.ToString: string;
+
+var
+  P : TRTTIParameter;
+  A : TRTTIParameterArray;
+  I : integer;
+  RT : TRttiType;
+
+begin
+  RT:=GetReturnType;
+  if RT=nil then
+    Result:=name+' = procedure ('
+  else
+    Result:=name+' = function (';
+  A:=GetParameters(False);
+  for I:=0 to Length(a)-1 do
+    begin
+      P:=A[I];
+      if I>0 then
+        Result:=Result+'; ';
+      Result:=Result+P.Name;
+      if Assigned(P.ParamType) then
+        Result:=Result+' : '+P.ParamType.Name;
+    end;
+  result:=Result+')';
+  if Assigned(RT) then
+    Result:=Result+' : '+RT.Name;
+end;
+
+
+
 { TRttiMethodType }
 
-function TRttiMethodType.GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>;
+function TRttiMethodType.GetParameters(aWithHidden: Boolean): TRttiParameterArray;
 type
   TParamInfo = record
     Handle: Pointer;
@@ -3891,6 +3944,13 @@ begin
   Result := [];
 end;
 
+function TRttiMethodType.ToString: string;
+
+begin
+  Result:=Inherited ToString;
+  Result:=Result+' of object';
+end;
+
 function TRttiMethodType.Invoke(const aCallable: TValue; const aArgs: array of TValue): TValue;
 var
   method: PMethod;
@@ -3909,7 +3969,7 @@ end;
 
 { TRttiProcedureType }
 
-function TRttiProcedureType.GetParameters(aWithHidden: Boolean): specialize TArray<TRttiParameter>;
+function TRttiProcedureType.GetParameters(aWithHidden: Boolean): TRttiParameterArray;
 var
   visible, i: SizeInt;
   param: PProcedureParam;
@@ -4005,6 +4065,12 @@ begin
   end;
 end;
 
+function TRttiAnsiStringType.GetCodePage: Word;
+
+begin
+  Result:=FTypeData^.CodePage;
+end;
+
 { TRttiInterfaceType }
 
 function TRttiInterfaceType.IntfMethodCount: Word;
@@ -4232,7 +4298,7 @@ begin
   inherited Destroy;
 end;
 
-function TRttiProperty.GetAttributes: specialize TArray<TCustomAttribute>;
+function TRttiProperty.GetAttributes: TCustomAttributeArray;
 var
   i: SizeInt;
   at: PAttributeTable;
@@ -4244,7 +4310,7 @@ begin
         begin
           SetLength(FAttributes, at^.AttributeCount);
           for i := 0 to High(FAttributes) do
-            FAttributes[i] := TCustomAttribute(GetAttribute(at, i));
+            FAttributes[i] := TCustomAttribute(typinfo.GetAttribute(at, i));
         end;
       FAttributesResolved:=true;
     end;
@@ -4545,7 +4611,7 @@ begin
   inherited;
 end;
 
-function TRttiType.GetAttributes: specialize TArray<TCustomAttribute>;
+function TRttiType.GetAttributes: TCustomAttributeArray;
 var
   i: Integer;
   at: PAttributeTable;
@@ -4557,7 +4623,7 @@ begin
       begin
       setlength(FAttributes,at^.AttributeCount);
       for i := 0 to at^.AttributeCount-1 do
-        FAttributes[i]:=GetAttribute(at,i);
+        FAttributes[i]:=TypInfo.GetAttribute(at,i);
       end;
     FAttributesResolved:=true;
     end;
@@ -4628,6 +4694,11 @@ begin
   result := '';
 end;
 
+function TRttiNamedObject.HasName(const aName: string): Boolean;
+begin
+  Result:=SameText(Name,AName);
+end;
+
 { TRttiContext }
 
 class function TRttiContext.Create: TRttiContext;
@@ -4828,6 +4899,36 @@ begin
     fOnInvoke(TRttiMethod(aUserData), aArgs, aResult);
 end;
 
+function TRttiObject.GetAttribute(aClass: TCustomAttributeClass): TCustomAttribute;
+
+var
+  attrarray : TCustomAttributeArray;
+  a: TCustomAttribute;
+
+begin
+  Result:=nil;
+  attrarray:=GetAttributes;
+  for a in attrarray do
+    if a.InheritsFrom(aClass) then
+      Exit(a);
+end;
+
+function TRttiObject.HasAttribute(aClass: TCustomAttributeClass): Boolean;
+begin
+  Result:=Assigned(GetAttribute(aClass));
+end;
+
+generic function TRttiObject.GetAttribute<T>: T;
+begin
+  Result:=T(GetAttribute(T));
+end;
+
+generic function TRttiObject.HasAttribute<T>: Boolean;
+begin
+  Result:=HasAttribute(T);
+end;
+
+
 {$ifndef InLazIDE}
 {$if defined(CPUI386) or (defined(CPUX86_64) and defined(WIN64))}
 {$I invoke.inc}

packages/rtl-objpas/tests/tests.rtti.pas

@@ -60,7 +60,7 @@ type
     procedure TestGetIsReadable;
     procedure TestIsWritable;
 
-
+    procedure TestGetAttribute;
 
     procedure TestInterface;
 {$ifdef fpc}
@@ -74,6 +74,7 @@ type
     procedure TestMethod;
 
     procedure TestRawThunk;
+
   private
 {$ifndef fpc}
     procedure Ignore(const aMsg: String);
@@ -189,6 +190,34 @@ begin
   end;
 end;
 
+procedure TTestRTTI.TestGetAttribute;
+// TMyAnnotatedClass
+// TMyAttribute
+
+var
+  c: TRttiContext;
+  aType: TRttiType;
+  aClass : TMyAnnotatedClass;
+  custAttr : TCustomAttribute;
+  myAttr : TMyAttribute absolute custattr;
+
+begin
+  aType:=nil;
+  custAttr:=Nil;
+  c := TRttiContext.Create;
+  try
+    aClass:=TMyAnnotatedClass.Create;
+    aType := c.GetType(aClass.ClassInfo);
+    custAttr:=aType.GetAttribute(TMyAttribute);
+    CheckEquals(custAttr.ClassType,TMyAttribute,'Correct class');
+    CheckEquals('something',MyAttr.value,'Correct value');
+  finally
+    aClass.Free;
+//    custAttr.Free;
+    C.Free;
+  end;
+end;
+
 
 procedure TTestRTTI.TestPropGetValueBoolean;
 var

packages/rtl-objpas/tests/tests.rtti.types.pas

@@ -3,6 +3,7 @@ unit tests.rtti.types;
 {$ifdef fpc}
 {$mode objfpc}{$H+}
 {$modeswitch advancedrecords}
+{$modeswitch prefixedattributes}
 {$endif}
 
 interface
@@ -152,6 +153,27 @@ Type
   {$POP}
   {$endif}
 
+  { TMyAttribute }
+
+  TMyAttribute = class(TCustomAttribute)
+  private
+    FValue: string;
+  public
+    constructor create(const avalue : string);
+    property value : string read FValue;
+  end;
+
+
+  { TMyAnnotatedClass }
+
+  [TMyAttribute('something')]
+  TMyAnnotatedClass = class
+  private
+    FSomething: String;
+  Published
+    Property Something : String Read FSomething Write FSomeThing;
+  end;
+
 implementation
 
 { TTestValueClass }
@@ -181,6 +203,13 @@ begin
   // Do nothing
 end;
 
+{ TMyAttribute }
+
+constructor TMyAttribute.create(const avalue: string);
+begin
+  FValue:=aValue;
+end;
+
 {$ifdef fpc}
 class operator TManagedRecOp.AddRef(var  a: TManagedRecOp);
 begin

packages/winunits-base/src/commctrl.pp

@@ -5905,14 +5905,6 @@ Type
                                  iSelectedImage : cint;
                                  cChildren    : cint;
                                  lParam       : LPARAM;
-{$ifdef ie6plus}
-                                 uStateEx     : cUINT;
-                                 hwnd         : HWND;
-                                 iExpandedImage  : cint;
-{$endif}
-{$ifdef NTDDI_WIN7}
-				 iPadding        : cint;
-{$endif}
                                  END;
          TVITEMA              = tagTVITEMA;
          LPTVITEMA            = ^tagTVITEMA;
@@ -5931,14 +5923,6 @@ Type
                                  iSelectedImage : cint;
                                  cChildren    : cint;
                                  lParam       : LPARAM;
-{$ifdef ie6plus}
-                                 uStateEx     : cUINT;
-                                 hwnd         : HWND;
-                                 iExpandedImage  : cint;
-{$endif}
-{$ifdef NTDDI_WIN7}
-				 iPadding        : cint;
-{$endif}
                                  END;
          TVITEMW              = tagTVITEMW;
          LPTVITEMW            = ^tagTVITEMW;
@@ -5960,6 +5944,14 @@ Type
                                  cChildren    : cint;
                                  lParam       : LPARAM;
                                  iIntegral    : cint;
+{$ifdef ie6plus}
+                                 uStateEx     : cUINT;
+                                 hwnd         : HWND;
+                                 iExpandedImage  : cint;
+{$endif}
+{$ifdef NTDDI_WIN7}
+                                 iPadding        : cint;
+{$endif}
                                  END;
          TVITEMEXA            = tagTVITEMEXA;
          LPTVITEMEXA          = ^tagTVITEMEXA;
@@ -5979,6 +5971,14 @@ Type
                                  cChildren    : cint;
                                  lParam       : LPARAM;
                                  iIntegral    : cint;
+{$ifdef ie6plus}
+                                 uStateEx     : cUINT;
+                                 hwnd         : HWND;
+                                 iExpandedImage  : cint;
+{$endif}
+{$ifdef NTDDI_WIN7}
+                                 iPadding        : cint;
+{$endif}
                                  END;
          TVITEMEXW            = tagTVITEMEXW;
          LPTVITEMEXW          = ^tagTVITEMEXW;

rtl/inc/objpas.inc

@@ -1165,6 +1165,33 @@
         result:=longint(E_NOINTERFACE);
     end;
 
+{****************************************************************************
+                               TNoRefCountObject
+****************************************************************************}
+
+    function TNoRefCountObject.QueryInterface( {$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+
+      begin
+         if getinterface(iid,obj) then
+           result:=S_OK
+         else
+           result:=longint(E_NOINTERFACE);
+      end;
+
+    function TNoRefCountObject._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+
+      begin
+         Result:=-1;
+      end;
+
+    function TNoRefCountObject._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+
+      begin
+         Result:=-1;
+      end;
+
+
+
 {****************************************************************************
                                TCustomAttribute
 ****************************************************************************}

rtl/inc/objpash.inc

@@ -334,6 +334,14 @@
            function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;virtual; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
          end;
 
+       TNoRefCountObject =  class(TObject, IInterface)
+         protected
+           function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+           function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+           function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+       end;
+                   
+
        { some pointer definitions }
        PUnknown = ^IUnknown;
        PPUnknown = ^PUnknown;

rtl/objpas/sysutils/fina.inc

@@ -123,10 +123,10 @@ begin
     Dec(I);
   if (I > 0) and (FileName[I] = ExtensionSeparator) then
     begin
-	SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
-	if (Not SOF) or FirstDotAtFileNameStartIsExtension then
-	  Result := Copy(FileName, I, MaxInt);
-	end  
+	  SOF:=(I=1) or (FileName[i-1] in AllowDirectorySeparators);
+	  if (Not SOF) or FirstDotAtFileNameStartIsExtension then
+	    Result := Copy(FileName, I, MaxInt);
+	  end
   else
     Result := '';
 end;

rtl/objpas/typinfo.pp

@@ -339,6 +339,7 @@ unit TypInfo;
         Name: ShortString;
       end;
 
+      PProcedureSignature = ^TProcedureSignature;
       TProcedureSignature =
       {$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
       packed

utils/fpdoc/unitdiff.pp

@@ -85,6 +85,9 @@ function TSkelEngine.CreateElement(AClass: TPTreeElement; const AName: String;
 
   begin
     Result:=Assigned(AParent) and (Length(AName) > 0) and
+            (not aPasElement.InheritsFrom(TPasUnresolvedTypeRef)) and
+            (not aPasElement.InheritsFrom(TPasUnresolvedUnitRef)) and
+            (not aPasElement.InheritsFrom(TPasUsesUnit)) and
             (not DisableArguments or ((APasElement.ClassType <> TPasArgument) and (not (aParent is TPasArgument)))) and
             (not DisableFunctionResults or (APasElement.ClassType <> TPasResultElement)) and
             (not DisablePrivate or (AVisibility<>visPrivate)) and
@@ -109,6 +112,7 @@ begin
   Writeln(' --disable-arguments Do not check function arguments.');
   Writeln(' --disable-private   Do not check class private fields.');
   Writeln(' --disable-protected Do not check class protected fields.');
+  Writeln(' --disable-result    Do not check Function results.');
   Writeln(' --input=cmdline     Input file to create skeleton for. Specify twice, once for each file.');
   Writeln('                     Use options as for compiler.');
   Writeln(' --lang=language     Use selected language.');
@@ -139,10 +143,14 @@ begin
     CmdLineAction := actionHelp
   else if s = '--disable-arguments' then
     DisableArguments := True
+  else if s = '--disable-result' then
+    DisableFunctionResults:=True
   else if s = '--disable-private' then
     DisablePrivate := True
   else if s = '--sparse' then
     SparseList := True
+  else if s = '--list' then
+    cmdLineAction := ActionList
   else if s = '--disable-protected' then
     begin
     DisableProtected := True;
@@ -240,8 +248,8 @@ begin
   For I:=0 to List.Count-1 do
     begin
     If Not SparseList then
-      Write(GetTypeDescription(TPasElement(List.Objects[i])),' : ');
-    Writeln(List[i]);
+      Write(F,GetTypeDescription(TPasElement(List.Objects[i])),' : ');
+    Writeln(F,List[i]);
     end;
 end;