[fpc-pascal] TParamFlags and fpc 3.2.0.

[Sven Barth]

Am 27.07.2019 um 19:02 schrieb fredvs:
> Imho, it seems that in your code  "if not (pfHidden in flags) then" was
> placed one "end;" too far.
That's what I meant in the mail you replied to.

Am 27.07.2019 um 19:07 schrieb fredvs:
> Sven, did you try a simple code, it seems that "$self" first parameter is
> always added into params list, even if you filter it with "pfHidden" flag.
This example works as intended:

=== code begin ===

program tmethodinfo;

{$mode objfpc}{$H+}

uses
   typinfo, classes, sysutils;

{$M+}
type
   TMyMethod1 = procedure(const aSender: TObject) of object;
   TMyMethod2 = function(var aArg: LongInt; aArr: array of LongInt): 
String of object;
{$M-}

function FuncToString(aTI: PTypeInfo): String;
var
   td: PTypeData;
   pb: PByte;
   args: TStrings;
   flags: TParamFlags;
   res, s, prefix, argname, argtype: String;
   i: SizeInt;
begin
   if aTI^.Kind <> tkMethod then
     raise Exception.Create('Method type information expected');

   td := GetTypeData(aTI);
   args := TStringList.Create;
   try
     args.Delimiter := ';';
     args.QuoteChar := #0;

     pb := @td^.ParamList;
     for i := 0 to td^.ParamCount - 1 do begin
       flags := TParamFlags(PWord(pb)^);
       Inc(pb, SizeOf(TParamFlags));
       argname := PShortString(pb)^;
       Inc(pb, SizeOf(Byte) + Length(argname));
       argtype := PShortString(pb)^;
       Inc(pb, SizeOf(Byte) + Length(argtype));
       if pfHidden in flags then
         Continue;
       prefix := '';
       if pfConst in flags then
         prefix := 'const'
       else if pfConstRef in flags then
         prefix := 'constref'
       else if pfVar in flags then
         prefix := 'var'
       else if pfOut in flags then
         prefix := 'out';
       s := '';
       if prefix <> '' then
         s := prefix + ' ';
       s := s + argname + ': ';
       if pfArray in flags then
         s := s + 'array of ';
       s := s + argtype;
       args.Add(s);
     end;
     if td^.MethodKind in [mkFunction, mkClassFunction] then
       res := PShortString(pb)^
     else
       res := '';

     Result := '';
     if td^.MethodKind in [mkClassFunction, mkClassProcedure, 
mkClassConstructor, mkClassDestructor] then
       Result := 'class ';
     if td^.MethodKind in [mkClassFunction, mkFunction] then
       Result := Result + 'function '
     else if td^.MethodKind in [mkClassProcedure, mkProcedure] then
       Result := Result + 'procedure '
     else if td^.MethodKind in [mkConstructor, mkClassConstructor] then
       Result := Result + 'constructor '
     else if td^.MethodKind in [mkDestructor, mkClassDestructor] then
       Result := Result + 'destructor '
     else
       Result := Result + 'unknown ';
     Result := Result + aTI^.Name + ' ';
     if args.Count > 0 then
       Result := Result + '(' + args.DelimitedText + ')';
     if res <> '' then
       Result := Result + ': ' + res;
   finally
     args.Free;
   end;
end;

begin
   Writeln(FuncToString(TypeInfo(TMyMethod1)));
   Writeln(FuncToString(TypeInfo(TMyMethod2)));
end.

=== code end ===

And will print the following:

=== code begin ===

procedure TMyMethod1 ( const aSender: TObject )
function TMyMethod2 ( var aArg: LongInt ; aArr: array of LongInt ): 
AnsiString

=== code end ===

So it definitely works, now you only need to figure out the problem in 
your code.

Regards,
Sven