Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-pascal / 2019-07

TParamFlags and fpc 3.2.0.

41 messages · 2 people · –

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

fredvs

Hello.

I try to make msegui/mseide compatible with fpc 3.2.0.

Thanks to Graeme fixes, interfaces of msegui is now compatible with fpc 3.2.0.

But there is still problem with the use of TParamFlags with fp 3.2.0 and mseide.

Now, using TParamFlags add by default "$self: Pointer" parameter, example:

procedure onexec($self: Pointer; const sender: Tobject);

How to hide that "$self: Pointer" parameter and have the same behavior as fpc 3.0.2 / fpc 3.0.4 ?

How to use TParamFlags to have the same result as using fpc 3.0.2 / fpc 3.0.4 ?

Thanks.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Di., 23. Juli 2019, 12:52:

Show quoted text 20 lines
Hello. I try to make msegui/mseide compatible with fpc 3.2.0. Thanks to Graeme fixes, interfaces of msegui is now compatible with fpc 3.2.0. But there is still problem with the use of TParamFlags with fp 3.2.0 and mseide. Now, using TParamFlags add by default "$self: Pointer" parameter, example: procedure onexec($self: Pointer; const sender: Tobject); How to hide that "$self: Pointer" parameter and have the same behavior as fpc 3.0.2 / fpc 3.0.4 ? How to use TParamFlags to have the same result as using fpc 3.0.2 / fpc 3.0.4 ?

Check for pfHidden.

Regards,
Sven

Reply by email

fredvs
to Sven Barth

Hello.

Check for pfHidden.

Thanks Sven for helping.
But I do not catch how to hide those "self" parameter.

IMHO, the guilty is here, in Martin's code msedisignparser.pas (Sadly I did not find any example how to use TParameterFlag. The goal is to ignore first parameter if fpc >= 3.2.x) ___________________________________________________

procedure getmethodparaminfo(const atype: ptypeinfo;
                                         var info: methodparaminfoty);
begin
...
      for int1:= 0 to paramcount - 1 do begin
      with params[int1] do begin

-----> //////////// Here flags must be adapted for fpc 3.2.0

      flags:= tparamflags(
         {$ifde mse_fpc_3_0_2}wordset{$else}byteset{$endif}(pbyte(po1)^));
       inc(po1,{$ifdef mse_fpc_3_2}2{$else}1{$endif});

--------------------------------------------------------------- It seems that there is a problem with pfSelf parameter and last fpc 3.2.0, it
is always set to true.

I did some test with flags.

Using  flags:= [] shows always self-parameter.
And using flags:= [pfSelf] or no has no difference, it is always pfSelf on
(and so first parameter added).

I did test all other parameters:
pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut,pfConstRef,pfHidden,pfHigh,pfSelf,pfVmt,pfResult

All others have influence to enable/disable it but for pfSelf, it is always true.

Sure, one more time, I miss something.

Thanks.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Mi., 24. Juli 2019, 08:10:

Show quoted text 25 lines
Hello. > Check for pfHidden. Thanks Sven for helping. But I do not catch how to hide those "self" parameter. IMHO, the guilty is here, in Martin's code msedisignparser.pas (Sadly I did not find any example how to use TParameterFlag. The goal is to ignore first parameter if fpc >= 3.2.x) ___________________________________________________ procedure getmethodparaminfo(const atype: ptypeinfo; var info: methodparaminfoty); begin ... for int1:= 0 to paramcount - 1 do begin with params[int1] do begin -----> //////////// Here flags must be adapted for fpc 3.2.0 flags:= tparamflags( {$ifde mse_fpc_3_0_2}wordset{$else}byteset{$endif}(pbyte(po1)^)); inc(po1,{$ifdef mse_fpc_3_2}2{$else}1{$endif});

Shouldn't the first $ifdef check for mse_fpc_3_2 as well?

I don't know the surrounding code, but in the end you should skip to insert the parameter into whatever structure you're generating if "pfHidden in flags", but you nevertheless need to advance your pointer to the next parameter.

Regards,
Sven

Reply by email

fredvs
to Sven Barth
Shouldn't the first $ifdef check for mse_fpc_3_2 as well?

In mse code, mse_fpc_3_0_2 and mse_fpc_3_0_4 are defined with this:

{$if FPC_FULLVERSION >= 030100} {$define mse_fpc_3_2} {$endif}

Yes, Martin did use "fpc_3_2" to define fpc > 3.0.x

Note that using fpc 3.0.2 or fpc 3.0.4 is totally ok.

But for fpc 3.1.x and fpc 3.2.x, nothing was prepared yet.

Do you know what modifs in TParamFlags were done in fpc 3.2.0 versus fpc 3.0.4 ?

Note also I did try adding pfHidden flag but the "$self: Pointer" first parameter is alway there, using fpc 3.2.0.

By the way, many thanks for the help.

Fre;D

-----
Many thanks ;-)

Reply by email

fredvs
to Sven Barth: fredvs schrieb am Mi., 24. Juli 2019, 08:10: Shouldn't the first $ifdef check for…

Re-hello.

Shouldn't the first $ifdef check for mse_fpc_3_2 as well?

Ooops, of course, there was a bad copy-paste, the original code was this:

  {$ifdef mse_fpc_3_2}wordset{$else}byteset{$endif}(pbyte(po1)^));
       inc(po1,{$ifdef mse_fpc_3_2}2{$else}1{$endif});

Note that previous post is valid, you only need to know that, at the moment, in mse code,
"mse_fpc_3_2" point to fpc > 3.0.0. (so fpc 3.0.1, fpc 3.0.2, fpc 3.0.3 and fpc 3.0.4).

For fpc > 3.1.x, nothing was defined yet in mse code.

Maybe if I may compare the modifs done in fpc code for TParamFlags from fpc 3.0.4 to fpc 3.2.0 it will give more light.

Huh, of course if somebody has a idea how to hide that first "$self: Pointer" parameter, he is welcome to share it.

Last thing, after Googling a while about "fpc" + "TParamFlags" I did only find this:

https://forum.lazarus.freepascal.org/index.php/topic,27538.15.html?PHPSESSID=3ovhgvat82bssshp06eq81m8s3

... and that post was from Martin that seems to be the only one that used and understood TParamFlags.

Fre;D

-----
Many thanks ;-)

Reply by email

fredvs
to Sven Barth: fredvs schrieb am Mi., 24. Juli 2019, 08:10: Shouldn't the first $ifdef check for…

Re-re hello.

Maybe with video it will be more easy to explain the problem.

Here video of mseide in action compiled with fpc 3.0.4 ---> all ok.

mseide_fpc304_good.mp4
<http://free-pascal-general.1045716.n5.nabble.com/file/t339155/mseide_fpc304_good.mp4>

And here video video of mseide in action compiled with fpc 3.2.0 ---> not good, first parameter added.

mseide_fpc320_bad.mp4
<http://free-pascal-general.1045716.n5.nabble.com/file/t339155/mseide_fpc320_bad.mp4>

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Do., 25. Juli 2019, 15:08:

Re-re hello. Maybe with video it will be more easy to explain the problem.

It would help more if you'd point me exactly at the code in question.

Regards,
Sven

Reply by email

fredvs
to Sven Barth
It would help more if you'd point me exactly at the code in question.

OK, now that you see the problem, here the code in mse-ide project:

In msedesignparser.pas, procedure getmethodparaminfo: (Please take a look at the // in code that follow --> paramlist has one more entry in fpc 320)

--------------------------------------------------------
procedure getmethodparaminfo(const atype: ptypeinfo;
                                         var info: methodparaminfoty);
  function getshortstring(var po: pchar): string;
  begin
   setlength(result,byte(po^));
   inc(po);
   move(po^,pointer(result)^,length(result));
   inc(po,length(result));
  end;
type
 pparamflags = ^tparamflags;
 paramrecty = record
               Flags : TParamFlags;
              end;
var
 isfunction: boolean;
 int1: integer;
 po1: pchar;
begin
 with info do begin
  kind:= methodkindty(-1);
  params:= nil;
  if (atype^.Kind = tkmethod) then begin
   with gettypedata(atype)^ do begin
    kind:= tmethodkindtomethodkind[methodkind];
    int1:= paramcount;
    isfunction:= methodkind = mkfunction;
    if isfunction then begin
     inc(int1);
    end;
    if isfunction or (methodkind = mkprocedure) then begin
     setlength(params,int1);
 po1:= @paramlist;
// there is now one more first parameter that must be ommited
   for int1:= 0 to paramcount - 1 do begin
      with params[int1] do begin
       flags:= tparamflags(
         {$ifdef mse_fpc_3_2}wordset{$else}byteset{$endif}(pbyte(po1)^));
       inc(po1,{$ifdef mse_fpc_3_2}2{$else}1{$endif});
       name:= getshortstring(po1);
       typename:= getshortstring(po1);
       if (typename = 'WideString') or (typename = 'UnicodeString') then
begin
        typename:= 'msestring';
       end
       else begin
        if typename = 'LongInt' then begin
         typename:= 'Integer';
        end
        else begin
         if typename = 'Double' then begin
          typename:= 'Real';
         end;
        end;
       end;
      end;
     end;
     if isfunction then begin
      params[high(params)].typename:= getshortstring(po1);
     end;
    end;
   end;
  end;
 end;
end;
------------------------------------------------------------------------

I did not find how to do for paramlist does not add that first parameter (maybe it is not possible).

So, as work-around, now in function that parse the code into the source-editor: tsourceupdater.composeproceduretext(). there is a filter: ----> if name = '$self' then result := '',

With this the problem is fixed.

I have to fix too function parametersmatch() because for matching, first parameter must be omitted.

To resume: if somebody knows how to not add by default the first $self parameter in paramlist, I vote for that solution.

Otherwise maybe I will propose the work-around (that works perfectly)  ---->
if name = '$self' then result := '';

Many thanks Sven.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Fr., 26. Juli 2019, 09:06:

Show quoted text 8 lines
> It would help more if you'd point me exactly at the code in question. OK, now that you see the problem, here the code in mse-ide project: In msedesignparser.pas, procedure getmethodparaminfo: (Please take a look at the // in code that follow --> paramlist has one more entry in fpc 320)

I'll do my changes inline:

Show quoted text 21 lines
-------------------------------------------------------- procedure getmethodparaminfo(const atype: ptypeinfo; var info: methodparaminfoty); function getshortstring(var po: pchar): string; begin setlength(result,byte(po^)); inc(po); move(po^,pointer(result)^,length(result)); inc(po,length(result)); end; type pparamflags = ^tparamflags; paramrecty = record Flags : TParamFlags; end; var isfunction: boolean; int1: integer;
  count: Integer;
Show quoted text 18 lines
po1: pchar; begin with info do begin kind:= methodkindty(-1); params:= nil; if (atype^.Kind = tkmethod) then begin with gettypedata(atype)^ do begin kind:= tmethodkindtomethodkind[methodkind]; int1:= paramcount; isfunction:= methodkind = mkfunction; if isfunction then begin inc(int1); end; if isfunction or (methodkind = mkprocedure) then begin setlength(params,int1); po1:= @paramlist;
  count := 0;
Show quoted text 6 lines
// there is now one more first parameter that must be ommited for int1:= 0 to paramcount - 1 do begin with params[int1] do begin
// replace previous line with:
  with params[count] do begin
flags:= tparamflags( {$ifdef mse_fpc_3_2}wordset{$else}byteset{$endif}(pbyte(po1)^)); inc(po1,{$ifdef mse_fpc_3_2}2{$else}1{$endif});
  {$ifdef mse_fpc_3_2}
  // skip hidden parameters ($self, $high, etc.)
  if pfHidden in flags then
    Continue;
  {$endif}
  Inc(count);
Show quoted text 19 lines
name:= getshortstring(po1); typename:= getshortstring(po1); if (typename = 'WideString') or (typename = 'UnicodeString') then begin typename:= 'msestring'; end else begin if typename = 'LongInt' then begin typename:= 'Integer'; end else begin if typename = 'Double' then begin typename:= 'Real'; end; end; end; end; end;
      // adjust array now that we know the real count
    SetLength(params, count);
Show quoted text 9 lines
if isfunction then begin params[high(params)].typename:= getshortstring(po1); end; end; end; end; end; end;

To resume: if somebody knows how to not add by default the first $self

parameter in paramlist, I vote for that solution.

The above changes should help.

Regards,
Sven

Reply by email

fredvs
to Sven Barth: fredvs schrieb am Fr., 26. Juli 2019, 09:06: I'll do my changes inline: count: Integer;…

Hello Sven.

I did try your code but it has still problems.
Here the result I get:

 procedure onexec(var elfPointer
...
 procedure tmainfo.onexec(var elfPointer

It should be:

 procedure onexec(const sender: TObject);
...
 procedure tmainfo.onex(const sender: TObject);

There is something strange in the behavior of "if pfHidden in flags then". It is the reason why, after many try, I stop to use filter in TParamFlags.

In last mse commit it keep all default parameters and do the filter when parsing the method-code in the editor.
It works perfectly.

And to fix the parameter-matcher, a work-around ignore the first parameter like this:

function parametersmatch(const a: ptypeinfo; const b: methodparaminfoty):
boolean;
var
 a1: methodparaminfoty;
 {$if FPC_FULLVERSION > 030200}
 params1: paraminfoarty;
 x : integer;
 {$endif}
begin
 getmethodparaminfo(a,a1);
 {$if FPC_FULLVERSION > 030200}
 setlength(params1,length(a1.params)-1);
 for x:=0 to length(params1) -1 do
 params1[x] := a1.params[x+1];
 a1.params := params1;
 {$endif}
 result:= parametersmatch1(a1,b);
end;

So, mse-ide side, with last commit, all is fixed, mse is still in the game and is fpc > 3.1.0 compatible.
https://github.com/mse-org/mseide-msegui/commit/44f515f90ba5b8c553c7b5b52d845e870e3c9de3

But, imho, there is problem with the behavior of fpc-ptypeinfo and filter in TParamFlags.
Dont worry, I will not annoy you with this.

Many thanks Sven and your help is highly appreciated.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs
fredvs wrote
But, imho, there is problem with the behavior of fpc-ptypeinfo and filter in TParamFlags. Dont worry, I will not annoy you with this.

There is no problem with PTypeInfo or TParamFlags. The tests for these functionalities pass without any issues on multiple platforms.

You should fix the cause (ignoring hidden parameters) and not the symptoms (hidding "$self"), because the latter will cause you a headache further down (e.g. if you have a function with an open array parameter which will have a "$highArgN" parameter for each open array).

That said the code I showed you had an issue which might explain the behaviour you got:

=== code begin ===

  for int1:= 0 to paramcount - 1 do begin
       with params[int1] do begin
// replace previous line with:
   with params[count] do begin
            flags:= tparamflags(
              {$ifdef
    mse_fpc_3_2}wordset{$else}byteset{$endif}(pbyte(po1)^));
            inc(po1,{$ifdef mse_fpc_3_2}2{$else}1{$endif});
// the following code block of mine
{$ifdef mse_fpc_3_2}
   // skip hidden parameters ($self, $high, etc.)
   if pfHidden in flags then
     Continue;
   {$endif}
   Inc(count);
// up until here, needs to be further down (see below)
// so remove this block again
        name:= getshortstring(po1);
        typename:= getshortstring(po1);
        if (typename = 'WideString') or (typename = 'UnicodeString') then
begin
         typename:= 'msestring';
        end
        else begin
         if typename = 'LongInt' then begin
          typename:= 'Integer';
         end
         else begin
          if typename = 'Double' then begin
           typename:= 'Real';
          end;
         end;
        end;
       end; // I think this is the end of the with-clause
// we adjust the code a little bit as the continue is not needed at this
location
// this way we always increase the count on < 3.2 and only if it's not
hidden
// on >= 3.2; we need to put this at the end so that po1 is advanced
correctly
{$ifdef mse_fpc_3_2}
   // skip hidden parameters ($self, $high, etc.)
   if not (pfHidden in flags) then
   {$endif}
   Inc(count);
      end;

=== code end ===

This should hopefully solve the issue.

Regards,
Sven

Reply by email

fredvs
to Sven Barth

Hello Sven.

That said the code I showed you had an issue which might explain the behaviour you got:

I did try your new code but get that error message at compilation:

msedesignparser.pas(722,11) Error: Incompatible types: got "TParamFlag" expected "methodflagty"
msedesignparser.pas(2238) Fatal: There were 1 errors compiling module, stopping
Fatal: Compilation aborted

-------> Line 722,11 = "if not (pfHidden in flags) then"

The complete code used, following your advice, is this:

.......................

procedure getmethodparaminfo(const atype: ptypeinfo;
                                         var info: methodparaminfoty);
  function getshortstring(var po: pchar): string;
  begin
   setlength(result,byte(po^));
   inc(po);
   move(po^,pointer(result)^,length(result));
   inc(po,length(result));
  end;
type
 pparamflags = ^tparamflags;
 paramrecty = record
               Flags : TParamFlags;
    end;
var
 isfunction: boolean;
 int1: integer;
 count: Integer= 0;
 po1: pchar;
begin
 with info do begin
  kind:= methodkindty(-1);
  params:= nil;
  if (atype^.Kind = tkmethod) then begin
   with gettypedata(atype)^ do begin
    kind:= tmethodkindtomethodkind[methodkind];
    int1:= paramcount;
    isfunction:= methodkind = mkfunction;
    if isfunction then begin
     inc(int1);
    end;
    if isfunction or (methodkind = mkprocedure) then begin
     setlength(params,int1);
     po1:= @paramlist;
     for int1:= 0 to paramcount - 1 do begin
      //with params[int1] do begin
       with params[count] do begin
       flags:= tparamflags(
         {$if FPC_FULLVERSION >= 030100}
wordset{$else}byteset{$endif}(pbyte(po1)^));
       inc(po1,{$ifdef mse_fpc_3_2}2{$else}1{$endif});
      {$if FPC_FULLVERSION > 030200}
     // skip hidden parameters ($self, $high, etc.)
       if pfHidden in flags then  Continue;
       {$endif}
       Inc(count);
       name:= getshortstring(po1);
       typename:= getshortstring(po1);
       if (typename = 'WideString') or (typename = 'UnicodeString') then
begin
        typename:= 'msestring';
       end
       else begin
        if typename = 'LongInt' then begin
         typename:= 'Integer';
        end
        else begin
         if typename = 'Double' then begin
          typename:= 'Real';
         end;
        end;
       end;
      end;
  {$if FPC_FULLVERSION > 030200}
  // skip hidden parameters ($self, $high, etc.)
  if not (pfHidden in flags) then  // line 722 ------------> complier error
message.
  {$endif}
  Inc(count);
     end;
     if isfunction then begin
      params[high(params)].typename:= getshortstring(po1);
     end;
    end;
   end;
  end;
 end;
end;

------------------------------------

You should fix the cause (ignoring hidden parameters) and not the symptoms (hidding "$self")

I totally agree with you (if it is possible to do).

Thanks.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Sa., 27. Juli 2019, 17:54:

Show quoted text 16 lines
Hello Sven. > That said the code I showed you had an issue which might explain the > behaviour you got: I did try your new code but get that error message at compilation: msedesignparser.pas(722,11) Error: Incompatible types: got "TParamFlag" expected "methodflagty" msedesignparser.pas(2238) Fatal: There were 1 errors compiling module, stopping Fatal: Compilation aborted -------> Line 722,11 = "if not (pfHidden in flags) then"

Ah, right, of course. You need the part I added *inside* the with block of params[count]. My fault (I'm doing this here on the fly, not testing it).

Regards,
Sven

Reply by email

fredvs
to Sven Barth

Re-hello.

Imho, it seems that in your code "if not (pfHidden in flags) then" was placed one "end;" too far.

So trying with this code, compilation is ok:

.......

procedure getmethodparaminfo(const atype: ptypeinfo;
                                         var info: methodparaminfoty);
  function getshortstring(var po: pchar): string;
  begin
   setlength(result,byte(po^));
   inc(po);
   move(po^,pointer(result)^,length(result));
   inc(po,length(result));
  end;
type
 pparamflags = ^tparamflags;
 paramrecty = record
               Flags : TParamFlags;
              end;
var
 isfunction: boolean;
 int1: integer;
 count: Integer= 0;
 po1: pchar;
begin
 with info do begin
  kind:= methodkindty(-1);
  params:= nil;
  if (atype^.Kind = tkmethod) then begin
   with gettypedata(atype)^ do begin
    kind:= tmethodkindtomethodkind[methodkind];
    int1:= paramcount;
    isfunction:= methodkind = mkfunction;
    if isfunction then begin
     inc(int1);
    end;
    if isfunction or (methodkind = mkprocedure) then begin
     setlength(params,int1);
     po1:= @paramlist;
     for int1:= 0 to paramcount - 1 do begin
      //with params[int1] do begin
       with params[count] do begin
       flags:= tparamflags(
         {$if FPC_FULLVERSION >= 030100}
wordset{$else}byteset{$endif}(pbyte(po1)^));
       inc(po1,{$if FPC_FULLVERSION >= 030100}2{$else}1{$endif});
       {$if FPC_FULLVERSION > 030200}
     // skip hidden parameters ($self, $high, etc.)
       if pfHidden in flags then  Continue;
       {$endif}
       Inc(count);
       name:= getshortstring(po1);
       typename:= getshortstring(po1);
       if (typename = 'WideString') or (typename = 'UnicodeString') then
begin
        typename:= 'msestring';
       end
       else begin
        if typename = 'LongInt' then begin
         typename:= 'Integer';
        end
        else begin
         if typename = 'Double' then begin
          typename:= 'Real';
         end;
        end;
       end;
    // ----->  here one "end;" before.
        {$if FPC_FULLVERSION > 030200}
  // skip hidden parameters ($self, $high, etc.)
  if not (pfHidden in flags) then
  {$endif}
  Inc(count);
     end;
     end;
     if isfunction then begin
      params[high(params)].typename:= getshortstring(po1);
     end;
    end;
   end;
  end;
 end;
end;

----------------------------------------------

Compliation is ok, but the result gives this:

   procedure onexec(var elfPointer
   procedure tmainfo.onexec(var elfPointer

It should be:

 procedure onexec(const sender: TObject);
 procedure tmainfo.onex(const sender: TObject);

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs
fredvs wrote
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.

fredvs wrote
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

Reply by email

fredvs
to fredvs

Hello.

Sorry, I am not the skill to find the problem with your code. I did try but I loose.

So, I still followed your advices to remove all pfHidden stuff. It is done at end of the procedure, updating the "info" variable.

Here code fully working.
You may take a look at end of code:
-----------------------------------------

procedure getmethodparaminfo(const atype: ptypeinfo;
                                         var info: methodparaminfoty);
  function getshortstring(var po: pchar): string;
  begin
   setlength(result,byte(po^));
   inc(po);
   move(po^,pointer(result)^,length(result));
   inc(po,length(result));
  end;
type
 pparamflags = ^tparamflags;
 paramrecty = record
               Flags : TParamFlags;
              end;
var
 isfunction: boolean;
 int1: integer;
 po1: pchar;
 {$if FPC_FULLVERSION > 030200}
 params1: paraminfoarty;
 x : integer;
 {$endif}
begin
 with info do begin
  kind:= methodkindty(-1);
  params:= nil;
  if (atype^.Kind = tkmethod) then begin
   with gettypedata(atype)^ do begin
    kind:= tmethodkindtomethodkind[methodkind];
    int1:= paramcount;
    isfunction:= methodkind = mkfunction;
    if isfunction then begin
     inc(int1);
    end;
    if isfunction or (methodkind = mkprocedure) then begin
     setlength(params,int1);
     po1:= @paramlist;
     for int1:= 0 to paramcount - 1 do begin
     with params[int1] do begin
     flags:= tparamflags(
         {$if FPC_FULLVERSION >= 030100}
       wordset{$else}byteset{$endif}(pbyte(po1)^));
       inc(po1,{$if FPC_FULLVERSION >= 030100}2{$else}1{$endif});
       name:= getshortstring(po1);
       typename:= getshortstring(po1);
       if (typename = 'WideString') or (typename = 'UnicodeString') then
begin
        typename:= 'msestring';
       end
       else begin
        if typename = 'LongInt' then begin
         typename:= 'Integer';
        end
        else begin
         if typename = 'Double' then begin
          typename:= 'Real';
         end;
        end;
       end;
     end;
     end;
     if isfunction then begin
      params[high(params)].typename:= getshortstring(po1);
     end;
    end;
   end;
  end;
 end;
 // here filter of pfHidden in flags
 {$if FPC_FULLVERSION > 030200}
  setlength(params1,0);
 for x:=0 to length(info.params) -1 do
 with info.params[x] do if not (pfHidden in flags) then
 begin
 setlength(params1,length(params1)+1);
 params1[length(params1)-1] := info.params[x];
 end;
 info.params := params1;
 {$endif}
end;

-----------------------------------------

So, many, many thanks for your light and help Sven, without you I could not do it.

Fre;D

PS: If you know what makes the problems in your code, I am very curious to know what is the solution.

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs
fredvs wrote
PS: If you know what makes the problems in your code, I am very curious to know what is the solution.

I'm no fan of those nested with-blocks so I definitely won't try to fix that code.

Regrds,
Sven

Reply by email

Sven Barth
to fredvs
fredvs wrote
> I'm no fan of those nested with-blocks Same for me. Did you see my fixes, do you agree with it ?

It's not beautiful if you mean that, but it will work...

Oh and just in case you want more headaches: the current code will bomb on current FPC trunk on targets that have strict alignment requirements (e.g. ARM). I think it /should/ work however if you add a "{$if FPC_FULLVERSION >= 030300}po1 := AlignTParamFlags(po1);{$endif}" directly before the assignment to "flags".

Regards,
Sven

Reply by email

fredvs
to Sven Barth
It's not beautiful if you mean that, but it will work...

OK, I will make it nicer.

Oh and just in case you want more headaches...

Yes, please, I adore it.
By the way, about headache, may I ask what number of FPC_FULLVERSION will be used for that wonderful new feature?

OK, nice fight and we win twice:

First, now fpc has a wonderful full working, clear TParamFlags demo. And mse is still on the road.

Thanks Sven.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs
fredvs wrote
> It's not beautiful if you mean that, but it will work... OK, I will make it nicer.

Well, nicer would be if you'd do it inside the main for-loop.

> Oh and just in case you want more headaches... Yes, please, I adore it. By the way, about headache, may I ask what number of FPC_FULLVERSION will be used for that wonderful new feature?

What do you mean? If you mean the AlignTParamFlags then I already showed that?

Regards,
Sven

Reply by email

fredvs
to Sven Barth
Well, nicer would be if you'd do it inside the main for-loop.

Yes, I 100 % agree with that but...
After *lot of* try and *lot of* headaches I give up.

I perfectly understood (I think) your code with filter inside the loop, it should work but the result is not ok.
There s a strange $self first parameter added in the params-array. I do not understand why.

That said, the procedure is used to parse code via the mse designer, using only methods of msegui widgets.
So speed is not really important.
And I doubt that doing the filter after the loop will take lot of more time and resource that doing inside.

What do you mean?

What number FPC_FULLVERSION will be used for the new feature of TParamsFlag?

For example, if FPC_FULLVERSION >= 030100 then tparamsflag uses wordset (otherwise byteset).
if FPC_FULLVERSION >= 030200 (not sure of the number) then use pfHidden flag.
if FPC_FULLVERSION >= ?????? then use new feature you are talking.

Thanks.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am So., 28. Juli 2019, 22:26:

Show quoted text 14 lines
>. I think it /should/ work however if you add a "{$if > FPC_FULLVERSION >= 030300} Oops, sorry, you writed it already: if > FPC_FULLVERSION >= 030300 OK thanks. Huh, and for: > if FPC_FULLVERSION >= 030200 (not sure of the number) > then use pfHidden flag. Is 030200 the right number?

You should also use 030100 here as that was added at the same time as the switch to Word size.

Regards,
Sven

Reply by email

fredvs
to Sven Barth: fredvs schrieb am So., 28. Juli 2019, 22:26: You should also use 030100 here as that was…
You should also use 030100 here as that was added at the same time as the

switch to Word size.

Ha, ok (so Martin only had begin the work for 030100, I was thinking that fpc > 030100 = fpc > 3.0.0., like fpc 3.0.2. or fpc 3.0.4).

So the logic is ok, fpc > 030100 = fpc > 3.1.0.

Many, many thanks Sven for all your light.

Fre;D.

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Mo., 29. Juli 2019, 11:42:

Show quoted text 8 lines
> You should also use 030100 here as that was added at the same time as the switch to Word size. Ha, ok (so Martin only had begin the work for 030100, I was thinking that fpc > 030100 = fpc > 3.0.0., like fpc 3.0.2. or fpc 3.0.4). So the logic is ok, fpc > 030100 = fpc > 3.1.0.

The full version numbers for 3.0.0, 3.0.2 and 3.0.4 are 030000, 030002 and 030004 respectively. And 3.1.1 is 030101 and can simply be checked for with

030100 which is also always > 0300xx. ;)

Regards,
Sven

Reply by email

fredvs
to Sven Barth

Thanks Sven! (and sorry for the delay)

Huh, if you see other things that I have to check for compatibility of fpc => 030100 vs fpc < 030100, please dont hesitate to advice.

At the moment this is used:

// I do not know what those warnings are about but added by Martin
 {$if fpc_fullversion >= 030100}
  {$warn 5089 off}
  {$warn 5090 off}
  {$warn 5093 off}
  {$warn 6058 off}
 {$endif}
 {$if fpc_fullversion >= 030100}
 --> tparamsflag uses wordset (otherwise byteset).
 {$endif}
 {$if fpc_fullversion >= 030100}
 --> use pfHidden flag.
 {$endif}
 {$if FPC_FULLVERSION >= 030300}
--> use AlignTParamFlags
{$endif}

Thanks.

Fre;D

-----
Many thanks ;-)

Reply by email

fredvs
to fredvs

Hello.

{$if FPC_FULLVERSION >= 030300} paramlist1 := AlignTParamFlags(paramlist1); {$endif}

Hum, with fpc 3.3.1. [2019/04/24] there is that error message:

msedesignparser.pas(694,43) Error: Identifier not found "AlignTParamFlags".

Could it be that the full-version used for "AlignTParamFlags" is 030302 ?

 {$if FPC_FULLVERSION >= 030302}
 paramlist1 := AlignTParamFlags(paramlist1);
 {$endif}

?

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs
fredvs wrote 16 lines
Hello. > {$if FPC_FULLVERSION >= 030300} > paramlist1 := AlignTParamFlags(paramlist1); > {$endif} Hum, with fpc 3.3.1. [2019/04/24] there is that error message: msedesignparser.pas(694,43) Error: Identifier not found "AlignTParamFlags". Could it be that the full-version used for "AlignTParamFlags" is 030302 ? {$if FPC_FULLVERSION >= 030302} paramlist1 := AlignTParamFlags(paramlist1); {$endif} ?

No, It's > 030300, but your version of trunk is too old, the function was only added a few days ago.

Regards,
Sven

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Fr., 2. Aug. 2019, 13:27:

Show quoted text 5 lines
> No, It's > 030300, but your version of trunk is too old, the function > was only added a few days ago. Ha, ok. (but a few tricky, a new number for a new feature would be ok too).

By definition only the latest version of trunk is considered supported. Also that's the version number of the compiler. That won't be increased for every little thing that gets added.

That said instead of checking for the version you can also check for the existence of the function:

{$if declared(AlignTParamFlags)}

This works with any identifier that is in scope (e.g. in this case the TypInfo unit must be used, but that is the case here anyway).

Regards,
Sven

Reply by email

fredvs
to Sven Barth

Hello Sven.

{$if declared(AlignTParamFlags)}

Excellent!

If, by chance, you're running out of ideas for new methods for fpc 3.3.1 trunk and have nothing to do or you're bored...
For people that are not fan of headaches (so not for me), add this method: RemovepfHiddeninTParamFlags(Pparamlist).
This should be used the same way that for AlignTParamFlags(Pparamlist), just before assigning the flags.

Fre;D

-----
Many thanks ;-)

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Fr., 2. Aug. 2019, 15:11:

Show quoted text 13 lines
Hello Sven. > {$if declared(AlignTParamFlags)} Excellent! If, by chance, you're running out of ideas for new methods for fpc 3.3.1 trunk and have nothing to do or you're bored... For people that are not fan of headaches (so not for me), add this method: RemovepfHiddeninTParamFlags(Pparamlist). This should be used the same way that for AlignTParamFlags(Pparamlist), just before assigning the flags.

That is something each application needs to handle itself as the list management needs to be handled by itself cause the type information is read only.

And if someone is not able to check for a simple flag then they shouldn't work with the RTTI.

Regards,
Sven

Reply by email

Sven Barth
to fredvs

fredvs schrieb am Fr., 2. Aug. 2019, 18:32:

Show quoted text 13 lines
> cause the type information is read only. Yes, it is why I will not jump into that proposition. > And if someone is not able to check for a simple flag then they shouldn't > work with the RTTI. Huh, like in your code-fix? ;-) Ok, all is ok, many thanks Sven and have a perfect summer.

The check for the flag worked. It's the remainder of the code that's broken.

Regards,
Sven

Reply by email

fredvs
to Sven Barth
The check for the flag worked.

Yes and many thanks for your clear demo program tmethodinfo. This removed all my doubts.

t's the remainder of the code that's broken.

Yes and I did not find how to fix it in the main loop (and I am tired for this now).
All the tests I did checking flag after the main loop succeed and I will use that fix until I get some more energy.

Fre;D

-----
Many thanks ;-)

Reply by email