pastojs: export from units

packages/fcl-passrc/src/pasresolveeval.pas

@@ -208,7 +208,7 @@ const
   nClassTypesAreNotRelatedXY = 3142;
   nDirectiveXNotAllowedHere = 3143;
   nAwaitWithoutPromise = 3144;
-  nSymbolCannotExportedFromALibrary = 3145;
+  nSymbolCannotBeExportedFromALibrary = 3145;
 
   // using same IDs as FPC
   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
@@ -364,7 +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';
+  sSymbolCannotBeExportedFromALibrary = 'The symbol cannot be exported from a library';
 
 type
   { TResolveData - base class for data stored in TPasElement.CustomData }

packages/fcl-passrc/src/pasresolver.pp

@@ -9241,11 +9241,10 @@ procedure TPasResolver.FinishExportSymbol(El: TPasExportSymbol);
 
 var
   Expr: TPasExpr;
-  DeclEl: TPasElement;
+  DeclEl, DuplicateEl: TPasElement;
   FindData: TPRFindData;
   Ref: TResolvedReference;
   ResolvedEl: TPasResolverResult;
-  Section: TPasSection;
   Scope: TPasIdentifierScope;
   ScopeIdent: TPasIdentifier;
 begin
@@ -9257,7 +9256,15 @@ begin
     DeclEl:=ResolvedEl.IdentEl;
     if DeclEl=nil then
       RaiseMsg(20210103012907,nXExpectedButYFound,sXExpectedButYFound,['symbol',GetTypeDescription(ResolvedEl)],Expr);
-    if not (DeclEl.Parent is TPasSection) then
+    if DeclEl.Parent=nil then
+      RaiseMsg(20220206142147,nSymbolCannotBeExportedFromALibrary,
+        sSymbolCannotBeExportedFromALibrary,[],El);
+    if DeclEl.Parent is TPasSection then
+      // global
+    else if (DeclEl.Parent is TPasMembersType) and (DeclEl is TPasProcedure)
+        and (TPasProcedure(DeclEl).IsStatic) then
+      // static proc
+    else
       RaiseMsg(20210103012908,nXExpectedButYFound,sXExpectedButYFound,['global symbol',GetElementTypeName(DeclEl)],Expr);
     end
   else
@@ -9272,16 +9279,25 @@ begin
     CheckFoundElement(FindData,Ref);
     end;
 
-  if DeclEl is TPasProcedure then
+  if DeclEl.Parent.CustomData is TPasIdentifierScope then
     begin
-    Section:=DeclEl.Parent as TPasSection;
+    Scope:=DeclEl.Parent.CustomData as TPasIdentifierScope;
-    Scope:=Section.CustomData as TPasIdentifierScope;
     ScopeIdent:=Scope.FindLocalIdentifier(DeclEl.Name);
     if (ScopeIdent=nil) then
       RaiseNotYetImplemented(20210106103001,El,GetObjPath(DeclEl));
     if ScopeIdent.NextSameIdentifier<>nil then
+      if DeclEl is TPasProcedure then
         RaiseMsg(20210106103320,nCantDetermineWhichOverloadedFunctionToCall,
-        sCantDetermineWhichOverloadedFunctionToCall,[],El);
+          sCantDetermineWhichOverloadedFunctionToCall,[],El)
+      else
+        begin
+        if ScopeIdent.Element=DeclEl then
+          DuplicateEl:=ScopeIdent.NextSameIdentifier.Element
+        else
+          DuplicateEl:=ScopeIdent.Element;
+        RaiseMsg(20220206141619,nDuplicateIdentifier,
+          sDuplicateIdentifier,[DuplicateEl.Name,GetElementSourcePosStr(DuplicateEl)],El);
+        end;
     end;
 
   // check index and name
@@ -17673,7 +17689,7 @@ begin
     SpecializeProcedureType(TPasProcedureType(GenEl),TPasProcedureType(SpecEl),nil);
     end
   else if C=TPasExportSymbol then
-    RaiseMsg(20210101234958,nSymbolCannotExportedFromALibrary,sSymbolCannotExportedFromALibrary,[],GenEl)
+    RaiseMsg(20210101234958,nSymbolCannotBeExportedFromALibrary,sSymbolCannotBeExportedFromALibrary,[],GenEl)
   else
     RaiseNotYetImplemented(20190728151215,GenEl);
 end;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1304,6 +1304,7 @@ begin
   else if C=TPasGenericTemplateType then
     begin
     if ScopeModule=nil then
+      // Note: filer can write generics, the converter cannot
       RaiseNotSupported(20190817110226,El);
     end
   else

packages/pastojs/src/fppas2js.pp

@@ -509,7 +509,6 @@ const
   nDuplicateMessageIdXAtY = 4029;
   nDispatchRequiresX = 4030;
   nConstRefNotForXAsConst = 4031;
-  nSymbolCannotBeExportedFromALibrary = 4032;
 // resourcestring patterns of messages
 resourcestring
   sPasElementNotSupported = 'Pascal element not supported: %s';
@@ -543,7 +542,6 @@ resourcestring
   sDuplicateMessageIdXAtY = 'Duplicate message id "%s" at %s';
   sDispatchRequiresX = 'Dispatch requires %s';
   sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const';
-  sSymbolCannotBeExportedFromALibrary = 'The symbol cannot be exported from a library';
 
 const
   ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
@@ -4932,11 +4930,21 @@ begin
   if DeclEl=nil then
     RaiseMsg(20210106223620,nSymbolCannotBeExportedFromALibrary,
       sSymbolCannotBeExportedFromALibrary,[],El);
-  if not (DeclEl.Parent is TPasSection) then
+  if DeclEl is TPasResultElement then
+    DeclEl:=DeclEl.Parent.Parent;
+
+  if DeclEl.Parent=nil then
+    RaiseMsg(20220206142534,nSymbolCannotBeExportedFromALibrary,
+      sSymbolCannotBeExportedFromALibrary,[],El);
+  if DeclEl.Parent is TPasSection then
+    // global
+  else if (DeclEl is TPasProcedure) and TPasProcedure(DeclEl).IsStatic then
+    // static proc
+  else
     RaiseMsg(20210106224436,nSymbolCannotBeExportedFromALibrary,
       sSymbolCannotBeExportedFromALibrary,[],El);
 
-  if not (DeclEl.Parent is TLibrarySection) then
+  if not (El.Parent is TLibrarySection) then
     // disable exports in units
     RaiseMsg(20211022224239,nSymbolCannotBeExportedFromALibrary,
       sSymbolCannotBeExportedFromALibrary,[],El);

packages/pastojs/tests/tcmodules.pas

@@ -915,9 +915,11 @@ type
     // Library
     Procedure TestLibrary_Empty;
     Procedure TestLibrary_ExportFunc;
+    Procedure TestLibrary_ExportFuncOverloadedFail;
     Procedure TestLibrary_Export_Index_Fail;
     Procedure TestLibrary_ExportVar;
     Procedure TestLibrary_ExportUnitFunc;
+    // todo: test fail on export overloaded function
     // ToDo: test delayed specialization init
     // ToDo: analyzer
   end;
@@ -34164,6 +34166,24 @@ begin
   CheckResolverUnexpectedHints();
 end;
 
+procedure TTestModule.TestLibrary_ExportFuncOverloadedFail;
+begin
+  StartLibrary(false);
+  Add([
+  'procedure Run(w: word); overload;',
+  'begin',
+  'end;',
+  'procedure Run(s: string); overload;',
+  'begin',
+  'end;',
+  'exports',
+  '  Run;',
+  '']);
+  SetExpectedPasResolverError(sCantDetermineWhichOverloadedFunctionToCall,
+                              nCantDetermineWhichOverloadedFunctionToCall);
+  ConvertLibrary;
+end;
+
 procedure TTestModule.TestLibrary_Export_Index_Fail;
 begin
   StartLibrary(false);
@@ -34199,7 +34219,38 @@ end;
 
 procedure TTestModule.TestLibrary_ExportUnitFunc;
 begin
+  AddModuleWithIntfImplSrc('Unit1.pas',
+    LinesToStr([
+    'type',
+    '  TAnt = class',
+    '    class function Crawl: word; static;',
+    '  end;',
+    'function Fly: word;',
+    '']),
+    LinesToStr([
+    'function Fly: word;',
+    'begin',
+    'end;',
+    'class function TAnt.Crawl: word;',
+    'begin',
+    'end;',
+    '']));
 
+  StartLibrary(true,[supTObject]);
+  Add([
+  'uses unit1;',
+  'exports',
+  '  Fly;',
+  '  TAnt.Crawl;',
+  '']);
+  ConvertLibrary;
+  CheckSource('TestLibrary_ExportUnitFunc',
+    LinesToStr([ // statements
+    'export { pas.Unit1.Fly as Fly, pas.Unit1.TAnt.Crawl as Crawl };',
+    '']),
+    LinesToStr([
+    '']));
+  CheckResolverUnexpectedHints();
 end;
 
 Initialization

packages/pastojs/tests/tcprecompile.pas

@@ -68,6 +68,7 @@ type
     procedure TestPCU_CheckVersionMain;
     procedure TestPCU_CheckVersionMain2;
     procedure TestPCU_CheckVersionSystem;
+    procedure TestPCU_RecordGeneric_TValueInference; // ToDo
   end;
 
 function LinesToList(const Lines: array of string): TStringList;
@@ -667,6 +668,59 @@ begin
     Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
 end;
 
+procedure TTestCLI_Precompile.TestPCU_RecordGeneric_TValueInference;
+begin
+  exit;
+
+  AddUnit('src/system.pp',[
+  'type',
+  '  integer = longint;',
+  '  TObject = class',
+  '  end;',
+  ''],['']);
+  AddUnit('src/typinfo.pas',[
+  '{$modeswitch externalclass}',
+  'type',
+  '  TTypeInfo = class external name ''rtl.tTypeInfo''',
+  '  end;',
+  '  TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
+  '  end;',
+  '  PTypeInfo = Pointer;',
+  ''],[
+  '']);
+  AddUnit('src/unit1.pas',[
+  '{$modeswitch AdvancedRecords}',
+  'uses typinfo;',
+  'type',
+  '  TValue = record',
+  '  private',
+  '    FTypeInfo: TTypeInfo;',
+  '    FData: JSValue;',
+  '  public',
+  '    generic class function From<T>(const Value: T): TValue; static;',
+  '    class procedure Make(ABuffer: JSValue; ATypeInfo: PTypeInfo; var Result: TValue); overload; static;',
+  '  end;',
+  ''],[
+  'generic class function TValue.From<T>(const Value: T): TValue;',
+  'begin',
+  '  if Value=3 then ;',
+  //'  Make(Value, TypeInfo(T), Result);',
+  'end;',
+  'class procedure TValue.Make(ABuffer: JSValue; ATypeInfo: PTypeInfo; var Result: TValue);',
+  'begin',
+  //'  Result.FData := ABuffer;',
+  //'  Result.FTypeInfo := ATypeInfo;',
+  'end;',
+  '']);
+  AddFile('test1.pas',[
+  '{$mode Delphi}',
+  'uses unit1;',
+  'begin',
+  '  TValue.From<longint>(1234);',
+  'end.']);
+  CheckPrecompile('test1.pas','src');
+end;
+
 Initialization
   RegisterTests([TTestCLI_Precompile]);
   RegisterPCUFormat;