TParamFlags and fpc 3.2.0.

classic Classic list List threaded Threaded
41 messages Options
123
Reply | Threaded
Open this post in threaded view
|

TParamFlags and fpc 3.2.0.

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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

Free Pascal - General mailing list
fredvs <[hidden email]> schrieb am Di., 23. Juli 2019, 12:52:
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 

_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

Free Pascal - General mailing list
fredvs <[hidden email]> schrieb am Mi., 24. Juli 2019, 08:10:
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 

_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
> 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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
In reply to this post by Free Pascal - General mailing list
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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
In reply to this post by Free Pascal - General mailing list
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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

Free Pascal - General mailing list
fredvs <[hidden email]> 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 

_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
> 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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

Free Pascal - General mailing list
fredvs <[hidden email]> schrieb am Fr., 26. Juli 2019, 09:06:
> 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:


--------------------------------------------------------
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;
 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;

// 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);
       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);
     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

_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
Hello Sven.

Thanks for your code, I will deeply study it.

Write you later.

Fre;D



-----
Many thanks ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
In reply to this post by Free Pascal - General mailing list
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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

Free Pascal - General mailing list
Am 26.07.2019 um 14:50 schrieb fredvs:
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

_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

Free Pascal - General mailing list
fredvs <[hidden email]> schrieb am Sa., 27. Juli 2019, 17:54:
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 

_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

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.

Fre;D



-----
Many thanks ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

Free Pascal - General mailing list
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
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

fredvs
> That's what I meant in the mail you replied t

Yes, sorry, when I sent it, you just post yours before I read t.

> So it definitely works

Good news.

> now you only need to figure out the problem in your code.

Huh, it comes from your code.

Thanks Sven.

Fre;D





-----
Many thanks ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
Reply | Threaded
Open this post in threaded view
|

Re: TParamFlags and fpc 3.2.0.

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 ;-)
--
Sent from: http://free-pascal-general.1045716.n5.nabble.com/
_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
Many thanks ;-)
123