View Issue Details

IDProjectCategoryView StatusLast Update
0038109LazarusIDEpublic2020-11-22 07:28
ReporterOkobaPatino Assigned ToJuha Manninen  
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Product Version2.1 (SVN) 
Summary0038109: JCF fails generic method in a unit and in objfpc mode:
DescriptionJCF fails to resolve this in mode objfpc and in a unit
unit Unit1;

{$mode objfpc}{$H+}

interface

generic function Test<T>(const A: T): integer;

implementation

end.
Additional InformationIt can resolve this in a project:
program Project1;

{$MODE objfpc}

  generic function Test<T>(const A: T): integer;
  begin

  end;

begin

end.
Tagsgenerics
Fixed in Revisionr64153
LazTarget-
Widgetset
Attached Files

Relationships

related to 0038110 closedJuha Manninen JCF fails generic method after type in mode objfpc 

Activities

Domingo Galmés

2020-11-21 16:01

reporter   ~0127083

This patch solves the issues 38109,38110 with generic functions and refactorize ParseTreeNodeType.pas.
Thanks for reporting the bugs.
JCF_generic_proc_0038109_0038110.patch (11,950 bytes)   
From 3ebe293816679770064997e0318043ec698d71fe Mon Sep 17 00:00:00 2001
From: DomingoGP <dgalmesp@gmail.com>
Date: Sat, 21 Nov 2020 15:54:24 +0100
Subject: [PATCH] Solves issues 38109,38110 with generic functions and
 refactorize ParseTreeNodeType.pas.

---
 components/jcf2/Parse/BuildParseTree.pas    |  30 ++-
 components/jcf2/Parse/ParseTreeNodeType.pas | 275 +++-----------------
 2 files changed, 52 insertions(+), 253 deletions(-)

diff --git a/components/jcf2/Parse/BuildParseTree.pas b/components/jcf2/Parse/BuildParseTree.pas
index 196b3e0fce..b8035c8e0b 100644
--- a/components/jcf2/Parse/BuildParseTree.pas
+++ b/components/jcf2/Parse/BuildParseTree.pas
@@ -803,7 +803,7 @@ begin
       RecogniseTypeSection(false);
     ttVar, ttThreadvar:
       RecogniseVarSection(false);
-    ttProcedure, ttFunction, ttOperator:
+    ttProcedure, ttFunction, ttOperator,ttGeneric:
       RecogniseExportedHeading;
     ttOpenSquareBracket:
       RecogniseAttributes;
@@ -837,16 +837,23 @@ begin
 
   case lt of
     ttProcedure:
-    begin
       RecogniseProcedureHeading(False, False);
-    end;
     ttFunction:
-    begin
       RecogniseFunctionHeading(False, False);
-    end;
     ttOperator:
-    begin
       RecogniseOperator(false);
+    ttGeneric:
+    begin
+      case fcTokenList.SolidTokenType(2) of
+        ttProcedure:
+          RecogniseProcedureHeading(False, False);
+        ttFunction:
+          RecogniseFunctionHeading(False, False);
+        ttOperator:
+          RecogniseOperator(false);
+        else
+          TEParseError.Create('Expected function or procedure', lc);
+        end;
     end
     else
       raise TEParseError.Create('Expected function or procedure', lc);
@@ -1037,6 +1044,11 @@ begin
         break;
       if leFirstTokenType in [ttClass,ttVar,ttThreadVar,ttConst,ttFunction,ttProcedure,ttOperator,ttConstructor,ttDestructor,ttProperty] then
         break;
+    end
+    else
+    begin
+      if (fcTokenList.FirstSolidTokenType = ttGeneric) and (fcTokenList.SolidTokenType(2) in [ttFunction,ttProcedure,ttOperator]) then
+        break;
     end;
 
     // can be followed by an operator decl in FreePascal
@@ -1113,8 +1125,12 @@ begin
         break;
       if fcTokenList.FirstSolidTokenType in [ttClass,ttVar,ttThreadVar, ttConst,ttFunction,ttProcedure,ttOperator,ttConstructor,ttDestructor,ttProperty] then
         break;
+    end
+    else
+    begin
+      if (fcTokenList.FirstSolidTokenType = ttGeneric) and (fcTokenList.SolidTokenType(2) in [ttFunction,ttProcedure,ttOperator]) then
+        break;
     end;
-
     lc := fcTokenList.FirstSolidToken;
   end;
 
diff --git a/components/jcf2/Parse/ParseTreeNodeType.pas b/components/jcf2/Parse/ParseTreeNodeType.pas
index bf4016bc11..064c2b8b4c 100644
--- a/components/jcf2/Parse/ParseTreeNodeType.pas
+++ b/components/jcf2/Parse/ParseTreeNodeType.pas
@@ -190,258 +190,41 @@ const
   MethodHeadings: TParseTreeNodeTypeSet =
     [nFunctionHeading, nProcedureHeading, nConstructorHeading, nDestructorHeading];
 
-function NodeTypeToString(const pe: TParseTreeNodeType): string;
+function NodeTypeToString(const pe: TParseTreeNodeType): string; inline;
 
 implementation
 
 uses SysUtils;
 
+const
+  TreeNodeTypeNames: array[TParseTreeNodeType] of string = (
+    'UnkNown', 'Leaf', 'Program', 'Unit', 'Unit header', 'Unit name', 'Package', 'Library', 'Uses',
+    'Uses Item', 'Requires', 'Contains', 'ident list', 'Identifier', 'Interface section',
+    'Implementation section', 'Block', 'Statement list', 'Decl section', 'Label decl section',
+    'const section', 'Const decl', 'type section', 'Type Decl', 'Array constant', 'Record Constant',
+    'Field constant', 'Type', 'Restricted type', 'Subrange type', 'Enumerated type', 'Array type',
+    'record type', 'Field declarations', 'Record variant section', 'Record variant', 'Set type',
+    'procedure type', 'Var section', 'Var decl', 'Absolute var', 'Variable init', 'Designator',
+    'Expression', 'Term', 'Unary op', 'Actual params', 'Statement', 'Assignment', 'Inline',
+    'Inline item', 'Statement label', 'Compound statement', 'If Condition', 'If Block', 'Else block',
+    'Case statement', 'Case selector', 'Case labels', 'Case label', 'else case', 'Repeat statement',
+    'While Statement', 'Loop header expr', 'Block header expr', 'For statement', 'With statement',
+    'try and handler block', 'try block', 'finally block', 'except block', 'Exception handlers',
+    'On exception handler', 'Procedure decl', 'Function Decl', 'Constructor decl', 'Destructor decl',
+    'Function heading', 'Procedure Heading', 'Constructor Heading', 'Destructor heading',
+    'Formal params', 'formal param', 'Function Return type', 'Procedure directives',
+    'external directive', 'object type', 'init section', 'class type', 'class heritage',
+    'class body', 'class visiblity', 'class declarations', 'property', 'property param list',
+    'property specifier', 'interface type', 'interface heritage', 'interface type guid',
+    'interface body', 'bracketed qual', 'asm', 'asm statement', 'asm ident',
+    'asm opcode', 'asm param', 'asm label', 'hint directives', 'property directive',
+    'exports', 'exported proc', 'literal string', 'hash literal char', 'hat literal char',
+    'Attribute', 'Class vars', 'Generic', 'Anonymous method', 'Method reference type'
+    );
+
 function NodeTypeToString(const pe: TParseTreeNodeType): string;
 begin
-  case pe of
-    nUnknown:
-      Result := 'Unknown';
-    nLeaf:
-      Result := 'Leaf';
-    nProgram:
-      Result := 'Program';
-    nUnit:
-      Result := 'Unit';
-    nUnitHeader:
-      Result := 'Unit header';
-    nUnitName:
-      Result := 'Unit name';
-    nPackage:
-      Result := 'Package';
-    nLibrary:
-      Result := 'Library';
-    nUses:
-      Result := 'Uses';
-    nUsesItem:
-      Result := 'Uses Item';
-    nRequires:
-      Result := 'Requires';
-    nContains:
-      Result := 'Contains';
-    nIdentList:
-      Result := 'ident list';
-    nIdentifier:
-      Result := 'Identifier';
-    nInterfaceSection:
-      Result := 'Interface section';
-    nImplementationSection:
-      Result := 'Implementation section';
-    nBlock:
-      Result := 'Block';
-    nStatementList:
-      Result := 'Statement list';
-    nDeclSection:
-      Result := 'Decl section';
-    nLabelDeclSection:
-      Result := 'Label decl section';
-    nConstSection:
-      Result := 'const section';
-    nConstDecl:
-      Result := 'Const decl';
-    nTypeSection:
-      Result := 'type section';
-    nTypeDecl:
-      Result := 'Type Decl';
-    nArrayConstant:
-      Result := 'Array constant';
-    nRecordConstant:
-      Result := 'Record Constant';
-    nRecordFieldConstant:
-      Result := 'Field constant';
-    nType:
-      Result := 'Type';
-    nRestrictedType:
-      Result := 'Restricted type';
-    nSubrangeType:
-      Result := 'Subrange type';
-    nEnumeratedType:
-      Result := 'Enumerated type';
-    nArrayType:
-      Result := 'Array type';
-    nRecordType:
-      Result := 'record type';
-    nFieldDeclaration:
-      Result := 'Field declarations';
-    nRecordVariantSection:
-      Result := 'Record variant section';
-    nRecordVariant:
-      Result := 'Record variant';
-    nSetType:
-      Result := 'Set type';
-    nProcedureType:
-      Result := 'procedure type';
-    nVarSection:
-      Result := 'Var section';
-    nVarDecl:
-      Result := 'Var decl';
-    nVarAbsolute:
-      Result := 'Absolute var';
-    nVariableInit:
-      Result := 'Variable init';
-    nDesignator:
-      Result := 'Designator';
-    nExpression:
-      Result := 'Expression';
-    nTerm:
-      Result := 'Term';
-    nUnaryOp:
-      Result := 'Unary op';
-    nActualParams:
-      Result := 'Actual params';
-    nStatement:
-      Result := 'Statement';
-    nAssignment:
-      Result := 'Assignment';
-    nInline:
-      Result := 'Inline';
-    nInlineItem:
-      Result := 'Inline item';
-    nStatementLabel:
-      Result := 'Statement label';
-    nCompoundStatement:
-      Result := 'Compound statement';
-    nIfCondition:
-      Result := 'If Condition';
-    nIfBlock:
-      Result := 'If Block';
-    nElseBlock:
-      Result := 'Else block';
-    nCaseStatement:
-      Result := 'Case statement';
-    nCaseSelector:
-      Result := 'Case selector';
-    nCaseLabels:
-      Result := 'Case labels';
-    nCaseLabel:
-      Result := 'Case label';
-    nElseCase:
-      Result := 'else case';
-    nRepeatStatement:
-      Result := 'Repeat statement';
-    nWhileStatement:
-      Result := 'While Statement';
-    nLoopHeaderExpr:
-      Result := 'Loop header expr';
-    nBlockHeaderExpr:
-      Result := 'Block header expr';
-    nForStatement:
-      Result := 'For statement';
-    nWithStatement:
-      Result := 'With statement';
-    nTryAndHandlerBlock:
-      Result := 'try and handler block';
-    nTryBlock:
-      Result := 'try block';
-    nFinallyBlock:
-      Result := 'finally block';
-    nExceptBlock:
-      Result := 'except block';
-    nExceptionHandlers:
-      Result := 'Exception handlers';
-    nOnExceptionHandler:
-      Result := 'On exception handler';
-    nProcedureDecl:
-      Result := 'Procedure decl';
-    nFunctionDecl:
-      Result := 'Function Decl';
-    nConstructorDecl:
-      Result := 'Constructor decl';
-    nDestructorDecl:
-      Result := 'Destructor decl';
-    nFunctionHeading:
-      Result := 'Function heading';
-    nProcedureHeading:
-      Result := 'Procedure Heading';
-    nConstructorHeading:
-      Result := 'Constructor Heading';
-    nDestructorHeading:
-      Result := 'Destructor heading';
-    nFormalParams:
-      Result := 'Formal params';
-    nFormalParam:
-      Result := 'formal param';
-    nFunctionReturnType:
-      Result := 'Function Return type';
-    nProcedureDirectives:
-      Result := 'Procedure directives';
-    nExternalDirective:
-      Result := 'external directive';
-    nObjectType:
-      Result := 'object type';
-    nInitSection:
-      Result := 'init section';
-    nClassType:
-      Result := 'class type';
-    nClassHeritage:
-      Result := 'class heritage';
-    nClassBody:
-      Result := 'class body';
-    nClassVisibility:
-      Result := 'class visiblity';
-    nClassDeclarations:
-      Result := 'class declarations';
-    nProperty:
-      Result := 'property';
-    nPropertyParameterList:
-      Result := 'property param list';
-    nPropertySpecifier:
-      Result := 'property specifier';
-    nInterfaceType:
-      Result := 'interface type';
-    nInterfaceHeritage:
-      Result := 'interface heritage';
-    nInterfaceTypeGuid:
-      Result := 'interface type guid';
-    nInterfaceBody:
-      Result := 'interface body';
-    nBracketedQual:
-      Result := 'bracketed qual';
-    nAsm:
-      Result := 'asm';
-    nAsmStatement:
-      Result := 'asm statement';
-    nAsmIdent:
-      Result := 'asm ident';
-    nAsmOpcode:
-      Result := 'asm opcode';
-    nAsmParam:
-      Result := 'asm param';
-    nAsmLabel:
-      Result := 'asm label';
-    nHintDirectives:
-      Result := 'hint directives';
-    nPropertyDirective:
-      Result := 'property directive';
-    nExports:
-      Result := 'exports';
-    nExportedProc:
-      Result := 'exported proc';
-    nLiteralString:
-      Result := 'literal string';
-    nHashLiteralChar:
-      Result := 'hash literal char';
-    nHatLiteralChar:
-      Result := 'hat literal char';
-    nAttribute:
-      Result := 'Attribute';
-    nGeneric:
-      Result := 'Generic';
-    nAnonymousMethod:
-      Result := 'Anonymous method';
-    nClassVars:
-      Result := 'Class vars';
-    nMethodReferenceType:
-      Result := 'Method reference type';
-    else
-      Result := 'Bad node type ' + IntToStr(Ord(pe));
-
-  end;
-end;
-
+  Result := TreeNodeTypeNames[pe];
+end;    
 
 end.
-- 
2.29.1.windows.1

Juha Manninen

2020-11-21 18:22

developer   ~0127085

Applied, thanks.

OkobaPatino

2020-11-22 07:28

reporter   ~0127090

Checked and it is fixed.
Thank you.

Issue History

Date Modified Username Field Change
2020-11-21 09:09 OkobaPatino New Issue
2020-11-21 09:10 OkobaPatino Tag Attached: generics
2020-11-21 09:12 OkobaPatino Issue cloned: 0038110
2020-11-21 09:12 OkobaPatino Relationship added related to 0038110
2020-11-21 16:01 Domingo Galmés Note Added: 0127083
2020-11-21 16:01 Domingo Galmés File Added: JCF_generic_proc_0038109_0038110.patch
2020-11-21 18:00 Juha Manninen Assigned To => Juha Manninen
2020-11-21 18:00 Juha Manninen Status new => assigned
2020-11-21 18:22 Juha Manninen Status assigned => resolved
2020-11-21 18:22 Juha Manninen Resolution open => fixed
2020-11-21 18:22 Juha Manninen Fixed in Revision => r64153
2020-11-21 18:22 Juha Manninen LazTarget => -
2020-11-21 18:22 Juha Manninen Note Added: 0127085
2020-11-22 07:28 OkobaPatino Status resolved => closed
2020-11-22 07:28 OkobaPatino Note Added: 0127090