pastojs: export from units

This commit is contained in:
mattias 2022-02-06 14:37:13 +01:00
parent a1f865ae45
commit 4f3093657e
6 changed files with 145 additions and 15 deletions

View File

@ -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 }

View File

@ -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:=Section.CustomData as TPasIdentifierScope;
Scope:=DeclEl.Parent.CustomData as TPasIdentifierScope;
ScopeIdent:=Scope.FindLocalIdentifier(DeclEl.Name);
if (ScopeIdent=nil) then
RaiseNotYetImplemented(20210106103001,El,GetObjPath(DeclEl));
if ScopeIdent.NextSameIdentifier<>nil then
RaiseMsg(20210106103320,nCantDetermineWhichOverloadedFunctionToCall,
sCantDetermineWhichOverloadedFunctionToCall,[],El);
if DeclEl is TPasProcedure then
RaiseMsg(20210106103320,nCantDetermineWhichOverloadedFunctionToCall,
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;

View File

@ -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

View File

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

View File

@ -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

View File

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