fcl-passrc: parser: export unit.symbol, resolver: started library export

git-svn-id: trunk@48003 -

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 }

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

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;

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;

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