diff options
Diffstat (limited to 'packages/fcl-passrc')
| -rw-r--r-- | packages/fcl-passrc/src/pasresolveeval.pas | 2 | ||||
| -rw-r--r-- | packages/fcl-passrc/src/pasresolver.pp | 66 | ||||
| -rw-r--r-- | packages/fcl-passrc/src/pastree.pp | 3 | ||||
| -rw-r--r-- | packages/fcl-passrc/src/pparser.pp | 56 | ||||
| -rw-r--r-- | packages/fcl-passrc/tests/tcresolver.pas | 20 |
5 files changed, 118 insertions, 29 deletions
diff --git a/packages/fcl-passrc/src/pasresolveeval.pas b/packages/fcl-passrc/src/pasresolveeval.pas index a2d654cb21..c570595277 100644 --- a/packages/fcl-passrc/src/pasresolveeval.pas +++ b/packages/fcl-passrc/src/pasresolveeval.pas @@ -208,6 +208,7 @@ const nClassTypesAreNotRelatedXY = 3142; nDirectiveXNotAllowedHere = 3143; nAwaitWithoutPromise = 3144; + nSymbolCannotExportedFromALibrary = 3145; // using same IDs as FPC nVirtualMethodXHasLowerVisibility = 3250; // was 3050 @@ -363,6 +364,7 @@ resourcestring sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related'; sDirectiveXNotAllowedHere = 'Directive "%s" not allowed here'; sAwaitWithoutPromise = 'Await without promise'; + sSymbolCannotExportedFromALibrary = 'The symbol cannot be exported from a library'; type { TResolveData - base class for data stored in TPasElement.CustomData } diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 77630339f3..9fe78b10ff 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1612,6 +1612,7 @@ type procedure AddClassType(El: TPasClassType; TypeParams: TFPList); virtual; procedure AddVariable(El: TPasVariable); virtual; procedure AddResourceString(El: TPasResString); virtual; + procedure AddExportSymbol(El: TPasExportSymbol); virtual; procedure AddEnumType(El: TPasEnumType); virtual; procedure AddEnumValue(El: TPasEnumValue); virtual; procedure AddProperty(El: TPasProperty); virtual; @@ -9139,7 +9140,7 @@ end; procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol); - procedure CheckExpExpr(Expr: TPasExpr; Kinds: TREVKinds; const Expected: string); + procedure CheckConstExpr(Expr: TPasExpr; Kinds: TREVKinds; const Expected: string); var Value: TResEvalValue; ResolvedEl: TPasResolverResult; @@ -9157,9 +9158,40 @@ procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol); RaiseXExpectedButYFound(20210101194628,Expected,GetTypeDescription(ResolvedEl),Expr); end; +var + Expr: TPasExpr; + DeclEl: TPasElement; + FindData: TPRFindData; + Ref: TResolvedReference; + ResolvedEl: TPasResolverResult; begin - CheckExpExpr(El.ExportIndex,[revkInt,revkUInt],'integer'); - CheckExpExpr(El.ExportName,[revkString,revkUnicodeString],'string'); + Expr:=El.NameExpr; + if Expr<>nil then + begin + ResolveExpr(Expr,rraRead); + //ResolveGlobalSymbol(Expr); + ComputeElement(Expr,ResolvedEl,[rcConstant]); + DeclEl:=ResolvedEl.IdentEl; + if DeclEl=nil then + RaiseMsg(20210103012907,nXExpectedButYFound,sXExpectedButYFound,['symbol',GetTypeDescription(ResolvedEl)],Expr); + if not (DeclEl.Parent is TPasSection) then + RaiseMsg(20210103012908,nXExpectedButYFound,sXExpectedButYFound,['global symbol',GetElementTypeName(DeclEl)],Expr); + end + else + begin + FindFirstEl(El.Name,FindData,El); + DeclEl:=FindData.Found; + if DeclEl=nil then + RaiseMsg(20210103002747,nIdentifierNotFound,sIdentifierNotFound,[El.Name],El); + if not (DeclEl.Parent is TPasSection) then + RaiseMsg(20210103003244,nXExpectedButYFound,sXExpectedButYFound,['global symbol',GetObjPath(DeclEl)],El); + Ref:=CreateReference(DeclEl,El,rraRead,@FindData); + CheckFoundElement(FindData,Ref); + end; + + // check index and name + CheckConstExpr(El.ExportIndex,[revkInt,revkUInt],'integer'); + CheckConstExpr(El.ExportName,[revkString,revkUnicodeString],'string'); end; procedure TPasResolver.FinishProcParamAccess(ProcType: TPasProcedureType; @@ -10276,7 +10308,7 @@ begin if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then begin {$IFDEF VerbosePasResolver} - writeln('TPasResolver.ResolveNameExpr ',GetObjName(El)); + writeln('TPasResolver.ResolveNameExpr ',GetObjPath(El)); {$ENDIF} RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo, sWrongNumberOfParametersForCallTo,[Proc.Name],El); @@ -12205,6 +12237,14 @@ begin AddIdentifier(TPasIdentifierScope(TopScope),El.Name,El,pikSimple); end; +procedure TPasResolver.AddExportSymbol(El: TPasExportSymbol); +begin + {$IFDEF VerbosePasResolver} + writeln('TPasResolver.AddExportSymbol ',GetObjName(El)); + {$ENDIF} + // Note: export symbol is not added to scope +end; + procedure TPasResolver.AddEnumType(El: TPasEnumType); var CanonicalSet: TPasSetType; @@ -17452,6 +17492,8 @@ begin AddProcedureType(TPasProcedureType(SpecEl),nil); SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl),nil); end + else if C=TPasExportSymbol then + RaiseMsg(20210101234958,nSymbolCannotExportedFromALibrary,sSymbolCannotExportedFromALibrary,[],GenEl) else RaiseNotYetImplemented(20190728151215,GenEl); end; @@ -20866,6 +20908,7 @@ begin // resolved when finished else if AClass=TPasAttributes then else if AClass=TPasExportSymbol then + AddExportSymbol(TPasExportSymbol(El)) else if AClass=TPasUnresolvedUnitRef then RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El) else @@ -28209,10 +28252,12 @@ function TPasResolver.ExprIsAddrTarget(El: TPasExpr): boolean; e.g. '@p().o[].El' or '@El[]' b) mode delphi: the last element of a right side of an assignment c) an accessor function, e.g. property P read El; + d) an export } var Parent: TPasElement; Prop: TPasProperty; + C: TClass; begin Result:=false; if El=nil then exit; @@ -28221,31 +28266,34 @@ begin repeat Parent:=El.Parent; //writeln('TPasResolver.ExprIsAddrTarget El=',GetObjName(El),' Parent=',GetObjName(Parent)); - if Parent.ClassType=TUnaryExpr then + C:=Parent.ClassType; + if C=TUnaryExpr then begin if TUnaryExpr(Parent).OpCode=eopAddress then exit(true); end - else if Parent.ClassType=TBinaryExpr then + else if C=TBinaryExpr then begin if TBinaryExpr(Parent).right<>El then exit; if TBinaryExpr(Parent).OpCode<>eopSubIdent then exit; end - else if Parent.ClassType=TParamsExpr then + else if C=TParamsExpr then begin if TParamsExpr(Parent).Value<>El then exit; end - else if Parent.ClassType=TPasProperty then + else if C=TPasProperty then begin Prop:=TPasProperty(Parent); Result:=(Prop.ReadAccessor=El) or (Prop.WriteAccessor=El) or (Prop.StoredAccessor=El); exit; end - else if Parent.ClassType=TPasImplAssign then + else if C=TPasImplAssign then begin if TPasImplAssign(Parent).right<>El then exit; if (msDelphi in CurrentParser.CurrentModeswitches) then exit(true); exit; end + else if C=TPasExportSymbol then + exit(true) else exit; El:=TPasExpr(Parent); diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp index 819fe25907..709090d435 100644 --- a/packages/fcl-passrc/src/pastree.pp +++ b/packages/fcl-passrc/src/pastree.pp @@ -975,6 +975,7 @@ type TPasExportSymbol = class(TPasElement) public + NameExpr: TPasExpr; // only if name is not a simple identifier ExportName : TPasExpr; ExportIndex : TPasExpr; Destructor Destroy; override; @@ -2601,6 +2602,7 @@ end; destructor TPasExportSymbol.Destroy; begin + ReleaseAndNil(TPasElement(NameExpr){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.NameExpr'{$ENDIF}); ReleaseAndNil(TPasElement(ExportName){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.ExportName'{$ENDIF}); ReleaseAndNil(TPasElement(ExportIndex){$IFDEF CheckPasTreeRefCount},'TPasExportSymbol.ExportIndex'{$ENDIF}); inherited Destroy; @@ -2624,6 +2626,7 @@ procedure TPasExportSymbol.ForEachCall(const aMethodCall: TOnForEachPasElement; const Arg: Pointer); begin inherited ForEachCall(aMethodCall, Arg); + ForEachChildCall(aMethodCall,Arg,NameExpr,false); ForEachChildCall(aMethodCall,Arg,ExportName,false); ForEachChildCall(aMethodCall,Arg,ExportIndex,false); end; diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index 467a7fa721..1e8a23c240 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/packages/fcl-passrc/src/pparser.pp @@ -4341,27 +4341,43 @@ end; procedure TPasParser.ParseExportDecl(Parent: TPasElement; List: TFPList); Var E : TPasExportSymbol; + aName: String; + NameExpr: TPasExpr; begin - Repeat - if List.Count<>0 then - ExpectIdentifier; - E:=TPasExportSymbol(CreateElement(TPasExportSymbol,CurtokenString,Parent)); - List.Add(E); - NextToken; - if CurTokenIsIdentifier('INDEX') then - begin - NextToken; - E.Exportindex:=DoParseExpression(E,Nil) - end - else if CurTokenIsIdentifier('NAME') then - begin - NextToken; - E.ExportName:=DoParseExpression(E,Nil) - end; - if not (CurToken in [tkComma,tkSemicolon]) then - ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon); - Engine.FinishScope(stDeclaration,E); - until (CurToken=tkSemicolon); + try + Repeat + if List.Count>0 then + ExpectIdentifier; + aName:=ReadDottedIdentifier(Parent,NameExpr,true); + E:=TPasExportSymbol(CreateElement(TPasExportSymbol,aName,Parent)); + if NameExpr.Kind=pekIdent then + // simple identifier -> no need to store NameExpr + NameExpr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF} + else + begin + E.NameExpr:=NameExpr; + NameExpr.Parent:=E; + end; + NameExpr:=nil; + List.Add(E); + if CurTokenIsIdentifier('INDEX') then + begin + NextToken; + E.Exportindex:=DoParseExpression(E,Nil) + end + else if CurTokenIsIdentifier('NAME') then + begin + NextToken; + E.ExportName:=DoParseExpression(E,Nil) + end; + if not (CurToken in [tkComma,tkSemicolon]) then + ParseExc(nParserExpectedCommaSemicolon,SParserExpectedCommaSemicolon); + Engine.FinishScope(stDeclaration,E); + until (CurToken=tkSemicolon); + finally + if NameExpr<>nil then + NameExpr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF} + end; end; function TPasParser.ParseProcedureType(Parent: TPasElement; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index c1000b6150..587d86c3bf 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -986,6 +986,7 @@ type Procedure TestLibrary_ExportFunc_IndexStringFail; Procedure TestLibrary_ExportVar; // ToDo Procedure TestLibrary_Initialization_Finalization; + Procedure TestLibrary_ExportFuncOverloadFail; // ToDo // ToDo Procedure TestLibrary_UnitExports; end; @@ -18833,6 +18834,25 @@ begin ParseLibrary; end; +procedure TTestResolver.TestLibrary_ExportFuncOverloadFail; +begin + exit; + + StartLibrary(false); + Add([ + 'procedure Run(w: word); overload;', + 'begin', + 'end;', + 'procedure Run(d: double); overload;', + 'begin', + 'end;', + 'exports', + ' Run,', + ' afile.run;', + 'begin']); + CheckResolverException('The symbol cannot be exported from a library',123); +end; + initialization RegisterTests([TTestResolver]); |