From 91ed2c4d9d13f92eafd2e897ea9b28e177062c72 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Thu, 4 May 2017 15:54:12 +0000 Subject: [PATCH] fcl-passrc: resolver type alias with dotted unit name git-svn-id: trunk@36084 - --- packages/fcl-passrc/src/pasresolver.pp | 126 +++++++++++++++------ packages/fcl-passrc/src/pasuseanalyzer.pas | 2 +- packages/fcl-passrc/tests/tcresolver.pas | 8 ++ 3 files changed, 100 insertions(+), 36 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index f4f3513021..da1f582462 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -134,9 +134,10 @@ Works: - pointer TPasPointerType - nil, assigned(), typecast, class, classref, dynarray, procvar - emit hints platform, deprecated, experimental, library, unimplemented +- dotted unitnames ToDo: -- test forward class in argument +- @@ - fix slow lookup declaration proc in PParser - fail to write a loop var inside the loop - warn: create class with abstract methods @@ -151,6 +152,7 @@ ToDo: - pointer of record - proc: check if forward and impl default values match - call array of proc without () +- array+array - pointer type, ^type, @ operator, [] operator - type alias type - object @@ -158,12 +160,12 @@ ToDo: - implements, supports - TPasResString - generics, nested param lists -- dotted unitnames - type helpers - record/class helpers - generics - operator overload -- is nested +- attributes +- anonymous functions - TPasFileType - labels - many more: search for "ToDo:" @@ -1039,7 +1041,7 @@ type FLastSourcePos: TPasSourcePos; FOptions: TPasResolverOptions; FPendingForwards: TFPList; // list of TPasElement needed to check for forward procs - FRootElement: TPasElement; + FRootElement: TPasModule; FScopeClass_Class: TPasClassScopeClass; FScopeClass_WithExpr: TPasWithExprScopeClass; FScopeCount: integer; @@ -1485,7 +1487,7 @@ type property BaseTypeLength: TResolverBaseType read FBaseTypeLength write FBaseTypeLength; // parsed values property DefaultNameSpace: String read FDefaultNameSpace; - property RootElement: TPasElement read FRootElement; + property RootElement: TPasModule read FRootElement; // scopes property StoreSrcColumns: boolean read FStoreSrcColumns write FStoreSrcColumns; { If true Line and Column is mangled together in TPasElement.SourceLineNumber. @@ -1526,6 +1528,7 @@ procedure SetResolverValueExpr(out ResolvedType: TPasResolverResult; function ProcNeedsImplProc(Proc: TPasProcedure): boolean; function ChompDottedIdentifier(const Identifier: string): string; +function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean; function dbgs(const Flags: TPasResolverComputeFlags): string; overload; function dbgs(const a: TResolvedRefAccess): string; @@ -1806,9 +1809,21 @@ begin while (p>0) do begin if Identifier[p]='.' then - exit(LeftStr(Identifier,p-1)); + break; dec(p); end; + Result:=LeftStr(Identifier,p-1); +end; + +function IsDottedIdentifierPrefix(const Prefix, Identifier: string): boolean; +var + l: Integer; +begin + l:=length(Prefix); + if (l>length(Identifier)) + or (CompareText(Prefix,LeftStr(Identifier,l))<>0) then + exit(false); + Result:=(length(Identifier)=l) or (Identifier[l+1]='.'); end; function dbgs(const Flags: TPasResolverComputeFlags): string; @@ -8355,7 +8370,7 @@ begin El.SourceFilename:=ASrcPos.FileName; El.SourceLinenumber:=SrcY; if FRootElement=nil then - FRootElement:=Result; + FRootElement:=Result as TPasModule; // create scope if (AClass=TPasVariable) @@ -8419,12 +8434,15 @@ begin end; function TPasResolver.FindElement(const aName: String): TPasElement; -// called by TPasParser +// called by TPasParser for direct types, e.g. type t = ns1.unit1.tobj.tsub var p: SizeInt; RightPath, CurName: String; NeedPop: Boolean; - CurScopeEl, NextEl, ErrorEl: TPasElement; + CurScopeEl, NextEl, ErrorEl, BestEl: TPasElement; + CurSection: TPasSection; + i: Integer; + UsesUnit: TPasUsesUnit; begin //writeln('TPasResolver.FindElement Name="',aName,'"'); ErrorEl:=nil; // use nil to use scanner position as error position @@ -8452,7 +8470,6 @@ begin {$ENDIF} if not IsValidIdent(CurName) then RaiseNotYetImplemented(20170328000033,ErrorEl); - if CurScopeEl<>nil then begin NeedPop:=true; @@ -8460,21 +8477,70 @@ begin // check visibility PushClassDotScope(TPasClassType(CurScopeEl)) else if CurScopeEl is TPasModule then - PushModuleDotScope(TPasModule(CurScopeEl)); + PushModuleDotScope(TPasModule(CurScopeEl)) + else + RaiseInternalError(20170504174021); end else NeedPop:=false; NextEl:=FindElementWithoutParams(CurName,ErrorEl,true); - if RightPath<>'' then + if NextEl is TPasModule then begin - if (NextEl is TPasModule) then + if CurScopeEl is TPasModule then + RaiseXExpectedButYFound(20170328001619,'class',NextEl.ElementTypeName+' '+NextEl.Name,ErrorEl); + if Pos('.',NextEl.Name)>0 then begin - if CurScopeEl is TPasModule then - RaiseXExpectedButYFound(20170328001619,'class',NextEl.ElementTypeName+' '+NextEl.Name,ErrorEl); - CurScopeEl:=NextEl; - end - else if (CurScopeEl is TPasClassType) then + // dotted module name -> check if the full module name is in aName + if CompareText(NextEl.Name+'.',LeftStr(aName,length(NextEl.Name)+1))<>0 then + begin + if CompareText(NextEl.Name,aName)=0 then + RaiseXExpectedButYFound(20170504165825,'type',NextEl.ElementTypeName,ErrorEl) + else + RaiseIdentifierNotFound(20170504165412,aName,ErrorEl); + end; + RightPath:=copy(aName,length(NextEl.Name)+2,length(aName)); + end; + CurScopeEl:=NextEl; + end + else if NextEl.ClassType=TPasUsesUnit then + begin + // the first name of a used unit matches -> find longest match + CurSection:=NextEl.Parent as TPasSection; + i:=length(CurSection.UsesClause)-1; + BestEl:=nil; + while i>=0 do + begin + UsesUnit:=CurSection.UsesClause[i]; + CurName:=UsesUnit.Name; + if IsDottedIdentifierPrefix(CurName,aName) + and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then + BestEl:=UsesUnit; + dec(i); + if (i<0) and (CurSection.ClassType=TImplementationSection) then + begin + CurSection:=(CurSection.Parent as TPasModule).InterfaceSection; + if CurSection=nil then break; + i:=length(CurSection.UsesClause)-1; + end; + end; + // check module name too + CurName:=RootElement.Name; + if IsDottedIdentifierPrefix(CurName,aName) + and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then + BestEl:=RootElement; + + if BestEl=nil then + RaiseIdentifierNotFound(20170504172440,aName,ErrorEl); + RightPath:=copy(aName,length(BestEl.Name)+2,length(aName)); + if BestEl.ClassType=TPasUsesUnit then + CurScopeEl:=TPasUsesUnit(BestEl).Module + else + CurScopeEl:=BestEl; + end + else if RightPath<>'' then + begin + if (CurScopeEl is TPasClassType) then CurScopeEl:=NextEl else RaiseIdentifierNotFound(20170328001941,CurName,ErrorEl); @@ -8544,7 +8610,7 @@ var BestEl: TPasElement; aName, CurName: String; Clause: TPasUsesClause; - i, CurLen: Integer; + i: Integer; Section: TPasSection; begin {$IFDEF VerbosePasResolver} @@ -8576,14 +8642,9 @@ begin begin CurUsesUnit:=Clause[i]; CurName:=CurUsesUnit.Name; - CurLen:=length(CurName); - if (CompareText(CurName,LeftStr(aName,CurLen))=0) - and ((CurLen=length(aName)) or (aName[CurLen+1]='.')) then - begin - // a match - if (BestEl=nil) or (CurLen>length(BestEl.Name)) then - BestEl:=CurUsesUnit; // a better match - end; + if IsDottedIdentifierPrefix(CurName,aName) + and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then + BestEl:=CurUsesUnit; // a better match end; if Section is TImplementationSection then begin @@ -8599,14 +8660,9 @@ begin // check module name CurName:=El.GetModule.Name; - CurLen:=length(CurName); - if (CompareText(CurName,LeftStr(aName,CurLen))=0) - and ((CurLen=length(aName)) or (aName[CurLen+1]='.')) then - begin - // a match - if (BestEl=nil) or (CurLen>length(BestEl.Name)) then - BestEl:=El.GetModule; // a better match - end; + if IsDottedIdentifierPrefix(CurName,aName) + and ((BestEl=nil) or (length(CurName)>length(BestEl.Name))) then + BestEl:=El.GetModule; // a better match if BestEl=nil then begin // no dotted module name fits the expression diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index aeeda11968..a58020dda5 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/packages/fcl-passrc/src/pasuseanalyzer.pas @@ -616,7 +616,7 @@ begin El:=El.Parent; until not (El is TPasType); end - else if C.InheritsFrom(TPasModule) then + else if (C.InheritsFrom(TPasModule)) or (C=TPasUsesUnit) then // e.g. unitname.identifier -> the module is used by the identifier else RaiseNotSupported(20170307090947,El); diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 7ae096639b..7c76c936c3 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -3676,6 +3676,7 @@ procedure TTestResolver.TestUnitUseIntf; begin AddModuleWithIntfImplSrc('unit2.pp', LinesToStr([ + 'type TListCallBack = procedure;', 'var i: longint;', 'procedure DoIt;', '']), @@ -3684,6 +3685,7 @@ begin StartProgram(true); Add('uses unit2;'); + Add('type TListCB = unit2.tlistcallback;'); Add('begin'); Add(' if i=2 then'); Add(' DoIt;'); @@ -3802,12 +3804,14 @@ begin MainFilename:='unitdots.main1.pas'; AddModuleWithIntfImplSrc('unitdots.unit1.pp', LinesToStr([ + 'type TColor = longint;', 'var i1: longint;']), LinesToStr([ ''])); AddModuleWithIntfImplSrc('unitdots.pp', LinesToStr([ + 'type TBright = longint;', 'var j1: longint;']), LinesToStr([ ''])); @@ -3815,6 +3819,10 @@ begin StartProgram(true); Add([ 'uses unitdots.unit1, unitdots;', + 'type', + ' TPrgBright = unitdots.tbright;', + ' TPrgColor = unitdots.unit1.tcolor;', + ' TStrange = unitdots.main1.tprgcolor;', 'var k1: longint;', 'begin', ' if unitdots.main1.k1=0 then ;',