Codetools generic constants

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

Codetools generic constants

Free Pascal - General mailing list
I got the Lazarus sources on svn and I'm not sure how to make a diff! Here are changes I propose to allow generic constants (I believe this is Mattias's code so he'll understand). It's just a few lines in a single function. Not sure about the error message but I think this is more or less the right idea. Let me know how we can get this integrated. Thanks.

procedure TPascalParserTool.ReadGenericParamList(Must, AllowConstraints: boolean);
{ At start cursor is on <
  At end cursor is on atom after >

 Examples:
  <> = type;  // fpc style
  <name>=type;  // this is the only case where >= are two operators
  <name,name> = type;  // delphi style
  <T1: record; T2,T3: class; T4: constructor; T5: name> = type
}
var
  RequiresConstraint: boolean = false;
  HasConstraint: boolean = false;
begin
  if not AtomIsChar('<') then begin
    if Must then
      SaveRaiseCharExpectedButAtomFound(20171106143341,'<');
    exit;
  end else if not (Scanner.CompilerMode in cmAllModesWithGeneric) then
    exit;
  CreateChildNode;
  CurNode.Desc:=ctnGenericParams;
  ReadNextAtom;
  // param is a constant which requires constraints
  if UpAtomIs('CONST') then
    begin
      RequiresConstraint:=true;
      ReadNextAtom;
    end;
  //debugln(['TPascalParserTool.ReadGenericParamList START ctnGenericParams ',GetAtom]);
  if AtomIsIdentifier then begin
    CreateChildNode;
    CurNode.Desc:=ctnGenericParameter;
    CurNode.EndPos:=CurPos.EndPos;
    ReadNextAtom;
    repeat
      // read name
      //debugln(['TPascalParserTool.ReadGenericParamList AFTER NAMESTART ctnGenericParams ',GetAtom]);
      if AtomIs('>=') then begin
        // this is the rare case where >= are two separate atoms
        dec(CurPos.EndPos);
      end;
      if CurPos.Flag in [cafComma,cafSemicolon] then begin
        // read next name
        EndChildNode;
        ReadNextAtom;
        AtomIsIdentifierSaveE(20180411194201);
        CreateChildNode;
        CurNode.Desc:=ctnGenericParameter;
        CurNode.EndPos:=CurPos.EndPos;
        ReadNextAtom;
      end else if AtomIsChar('>') then begin
        break;
      end else if AllowConstraints and (CurPos.Flag=cafColon) then begin
        // read constraints
        HasConstraint:=true;
        ReadNextAtom;
        if CurPos.Flag<>cafNone then begin
          CreateChildNode;
          CurNode.Desc:=ctnGenericConstraint;
        end;
        repeat
          CurNode.EndPos:=CurPos.EndPos;
          CurNode.Parent.EndPos:=CurPos.EndPos;
          if UpAtomIs('RECORD') or UpAtomIs('CLASS') or UpAtomIs('CONSTRUCTOR')
          then begin
            // keyword
            ReadNextAtom;
          end else begin
            // a type
            AtomIsIdentifierSaveE(20180411194204);
            ReadNextAtom;
          end;
          if AtomIs('>=') then begin
            // this is the rare case where >= are two separate atoms
            dec(CurPos.EndPos);
          end;
          if (CurPos.Flag=cafSemicolon) or AtomIsChar('>') then begin
            break;
          end else if CurPos.Flag<>cafComma then
            SaveRaiseCharExpectedButAtomFound(20170421195740,'>');
          ReadNextAtom;
        until false;
        // close ctnGenericConstraint
        EndChildNode;
        if AtomIsChar('>') then break;
        // cursor is now on ;
      end else
        SaveRaiseCharExpectedButAtomFound(20170421195742,'>');
    until false;
    // give an error if no constraint was found
    // note(ryan): what error should be given, any error at all??
    if RequiresConstraint and not HasConstraint then
      SaveRaiseUnexpectedKeyWord(20170421195742);
    RequiresConstraint:=false;
    HasConstraint:=false;
    // close ctnGenericParameter
    EndChildNode;
  end else begin
    if AtomIs('>=') then begin
      // this is the rare case where >= are two separate atoms
      dec(CurPos.EndPos);
      LastAtoms.SetCurrent(CurPos);
    end;
    if not AtomIsChar('>') then
      SaveRaiseCharExpectedButAtomFound(20170421195745,'>');
  end;
  // close ctnGenericParams
  CurNode.EndPos:=CurPos.EndPos;
  EndChildNode;
  ReadNextAtom;
end;


Regards,
        Ryan Joseph

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

Re: Codetools generic constants

Free Pascal - General mailing list
On Fri, 26 Jun 2020 11:36:18 +0700
Ryan Joseph via fpc-pascal <[hidden email]> wrote:

> I got the Lazarus sources on svn and I'm not sure how to make a diff!
> Here are changes I propose to allow generic constants (I believe this
> is Mattias's code so he'll understand). It's just a few lines in a
> single function. Not sure about the error message but I think this is
> more or less the right idea. Let me know how we can get this
> integrated. Thanks.

The preferred way is:
There is a testsuite components/codetools/runtestscodetools.lpi
Run it. It should run without errors.
Do your changes and add a test.
Run it and fix any bugs.
Create patch:
cd /path/lazarussvn
svn diff > mytopic.patch

Create bug report with the patch.

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

Re: Codetools generic constants

Free Pascal - General mailing list
On Fri, 26 Jun 2020 06:48:52 +0200
Mattias Gaertner via fpc-pascal <[hidden email]> wrote:

> On Fri, 26 Jun 2020 11:36:18 +0700
> Ryan Joseph via fpc-pascal <[hidden email]> wrote:
>
> > I got the Lazarus sources on svn and I'm not sure how to make a
> > diff! Here are changes I propose to allow generic constants (I
> > believe this is Mattias's code so he'll understand). It's just a
> > few lines in a single function. Not sure about the error message
> > but I think this is more or less the right idea. Let me know how we
> > can get this integrated. Thanks.  
>
> The preferred way is:
> There is a testsuite components/codetools/runtestscodetools.lpi
> Run it.

I forgot: it's a cmd line utility:

./runtestscodetools --all
or
./runtestscodetools --suite=SingleTestName

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

Codetools find references

Free Pascal - General mailing list
I'm finally revising this problem I had over a month ago with find references not working. I'm going to just post this code here and see if you see anything strange (most of it is from your example code).

What happens is that the unit graph seems to be incomplete if the units are in another directory and I use -Fu via FPCOptions (if supply no FPCOptions then it fails completely). If I take the units out of the directory the graph is complete and all references are found. Strangely it DOES find the first unit but none after that. Bugs or misuse?

============

FPC$ /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/TestCodeTools
main program: /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/test.pas
Found identifier: TSomeType
4 in unit graph
searching /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/units/utypes.pas...
searching /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/units/utypes.pas...
searching /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/test.pas...
searching /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/units/utypes.pas...
  found: /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/units/utypes.pas @ 10,3
  found: /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/units/utypes.pas @ 12,24
  found: /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/units/utypes.pas @ 16,24
  found: /Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools/test/test.pas @ 11,6


============


{$mode objfpc}

program test;
uses
  ugenconst, uother, utypes;

{$include hidden.inc}

var
  c: TSomeClass;
  t: TSomeType = HIDDEN_VALUE;
begin
  t := TSomeValue;
  DoThis(t);
  PrintType(t);
end.


============


{$mode objfpc}{$H+}

program TestCodeTools;
uses
  SysUtils, Classes, DateUtils,
  fpjson, fpjsonrtti,
  CodeToolManager, CodeToolsConfig, CodeCache, IdentCompletionTool,
  BasicCodeTools, CodeTree, FindDeclarationTool, PascalParserTool,
  KeywordFuncLists, DefineTemplates, LazFileUtils, Laz_AVL_Tree,CTUnitGraph;

procedure InitCodeTools(Switches: array of string);
var
  CodeToolsOptions: TCodeToolsOptions;
  Switch: String;
begin
  CodeToolsOptions := TCodeToolsOptions.Create;
  with CodeToolsOptions do
  begin
    //FPCSrcDir := '/usr/local/share/fpcsrc';
    //FPCPath := '/usr/local/lib/fpc/3.0.4/ppcx64';
    InitWithEnvironmentVariables;
    for Switch in Switches do
      FPCOptions := FPCOptions + switch + ' ';
  end;
  with CodeToolBoss do
  begin
    Init(CodeToolsOptions);
    IdentifierList.SortForHistory := True;
    IdentifierList.SortForScope := True;
  end;
end;

procedure CheckSyntax(Code: TCodeBuffer);
var
  Tool: TCodeTool;
begin
  if not CodeToolBoss.Explore(Code,Tool,true) then
    if CodeToolBoss.ErrorCode <> nil then
      writeln('Syntax Error -> '+CodeToolBoss.ErrorCode.FileName+': "'+CodeToolBoss.ErrorMessage+'" @ '+IntToStr(CodeToolBoss.ErrorLine)+':'+IntToStr(CodeToolBoss.ErrorColumn))
    else
      writeln('Syntax Error -> '+CodeToolBoss.ErrorMessage);
end;

procedure FindReferences(Filename, MainFilename: String; Y, X: Integer);
var
  DeclCode, StartSrcCode, Code: TCodeBuffer;
  ListOfPCodeXYPosition: TFPList;
  DeclX, DeclY, DeclTopLine, i: Integer;
  Identifier: string;
  Graph: TUsesGraph;
  Cache: TFindIdentifierReferenceCache;
  TreeOfPCodeXYPosition: TAVLTree;
  ANode, Node: TAVLTreeNode;
  CodePos: PCodeXYPosition;
  Files: TStringList;
  Completed: boolean;
  UGUnit: TUGUnit;
begin

  // Step 1: load the file
  StartSrcCode:=CodeToolBoss.LoadFile(Filename,false,false);
  CheckSyntax(StartSrcCode);

  // Step 2: find the main declaration
  if not CodeToolBoss.FindMainDeclaration(StartSrcCode,
    X,Y,
    DeclCode,DeclX,DeclY,DeclTopLine) then
  begin
    writeln('FindMainDeclaration failed in '+StartSrcCode.FileName+' at '+IntToStr(Y)+':'+IntToStr(X));
    ExitCode:=-1;
    exit;
  end;

  CheckSyntax(DeclCode);

  // Step 3: get identifier
  CodeToolBoss.GetIdentifierAt(DeclCode,DeclX,DeclY,Identifier);
  writeln('Found identifier: ',Identifier);

  // Step 4: collect all modules of program
  Files:=TStringList.Create;
  ListOfPCodeXYPosition:=nil;
  TreeOfPCodeXYPosition:=nil;
  Cache:=nil;
  try
    Files.Add(DeclCode.Filename);
    if CompareFilenames(DeclCode.Filename,StartSrcCode.Filename)<>0 then
      Files.Add(DeclCode.Filename);

    // parse all used units
    Graph:=CodeToolBoss.CreateUsesGraph;
    try
      Graph.AddStartUnit(MainFilename);
      Graph.AddTargetUnit(DeclCode.Filename);
      Graph.Parse(true,Completed);
      Node:=Graph.FilesTree.FindLowest;
      while Node<>nil do begin
        UGUnit:=TUGUnit(Node.Data);
        Files.Add(UGUnit.Filename);
        Node:=Node.Successor;
      end;
    finally
      Graph.Free;
    end;

    // Step 5: find references in all files
    writeln(Files.count, ' in unit graph');
    for i:=0 to Files.Count-1 do begin
      writeln('searching ', Files[i], '...');
      Code:=CodeToolBoss.LoadFile(Files[i],true,false);
      if Code=nil then begin
        writeln('unable to load "',Files[i],'"');
        continue;
      end;
      // check Syntax
      CheckSyntax(Code);
      // search references
      CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
      if not CodeToolBoss.FindReferences(
        DeclCode,DeclX,DeclY,
        Code, true, ListOfPCodeXYPosition, Cache) then
      begin
        writeln('FindReferences failed in "'+Code.Filename+'"');
        continue;
      end;
      if ListOfPCodeXYPosition=nil then continue;
      // In order to show all references after any parser error, they are
      // collected in a tree
      if TreeOfPCodeXYPosition=nil then
        TreeOfPCodeXYPosition:=CodeToolBoss.CreateTreeOfPCodeXYPosition;
      CodeToolBoss.AddListToTreeOfPCodeXYPosition(ListOfPCodeXYPosition,
                                              TreeOfPCodeXYPosition,true,false);
    end;

    // Step 6: show references
    if TreeOfPCodeXYPosition=nil then begin
      // No references found
      exit;
    end;
    ANode:=TreeOfPCodeXYPosition.FindHighest;
    while ANode<>nil do begin
      CodePos:=PCodeXYPosition(ANode.Data);
      writeln('  found: ', CodePos^.Code.Filename, ' @ ', CodePos^.Y, ',',CodePos^.X);
      ANode:=TreeOfPCodeXYPosition.FindPrecessor(ANode);
    end;

  finally
    Files.Free;
    CodeToolBoss.FreeListOfPCodeXYPosition(ListOfPCodeXYPosition);
    CodeToolBoss.FreeTreeOfPCodeXYPosition(TreeOfPCodeXYPosition);
    Cache.Free;
  end;
end;

var
  Path, ProgramPath: String;
begin
  ChDir('/Users/ryanjoseph/Developer/Projects/FPC/TestCodeTools');
  InitCodeTools([
      '-Fu'+ExpandFileName('./test/units'),
      '-Fi'+ExpandFileName('./test/include')
    ]);

  ProgramPath := ExpandFileName('./test/test.pas');
  Path := ProgramPath;

  writeln('main program: ', ProgramPath);
  FindReferences(Path, ProgramPath, 11, 13);
end.

Regards,
        Ryan Joseph

_______________________________________________
fpc-pascal maillist  -  [hidden email]
https://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal