paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 02:48:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r46442 from trunk:

Browse Source 
------------------------------------------------------------------------
    r46442 | michael | 2020-08-15 09:26:44 +0200 (Sat, 15 Aug 2020) | 1 line
    
    * unit alias possibility
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46623 -
This commit is contained in:
michael 2020-08-23 09:46:29 +00:00
parent b36e691404
commit 60dc1424f6
2 changed files with 42 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
utils/pas2js/libstub.pp
View File

@ -147,6 +147,12 @@ begin
Move(C[1],AErrorClass^,L);
end;
Procedure SetStubCreatorUnitAliasCallBack(P : PStubCreator; ACallBack : TUnitAliasCallBack; CallBackData : Pointer); stdcall;
begin
TStubCreator(P).OnUnitAlias:=ACallBack;
TStubCreator(P).OnUnitAliasData:=CallBackData;
end;
exports
// Stub creator
GetStubCreator,
@ -160,7 +166,8 @@ exports
GetStubCreatorLastError,
AddStubCreatorDefine,
AddStubCreatorForwardClass,
ExecuteStubCreator;
ExecuteStubCreator,
SetStubCreatorUnitAliasCallBack;
end.

38
utils/pas2js/stubcreator.pp
View File

@ -36,6 +36,8 @@ type
TWriteCallBack = Procedure (Data : Pointer; AFileData : PAnsiChar; AFileDataLen: Int32); stdcall;
TWriteEvent = Procedure(AFileData : String) of object;
TUnitAliasCallBack = Function (Data: Pointer; AUnitName: PAnsiChar;
var AUnitNameMaxLen: Int32): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
{ TStubCreator }
@ -45,6 +47,7 @@ type
FHeaderStream: TStream;
FIncludePaths: TStrings;
FInputFile: String;
FOnUnitAliasData: Pointer;
FOnWrite: TWriteEvent;
FOnWriteCallBack: TWriteCallBack;
FOutputFile: String;
@ -60,10 +63,12 @@ type
FCallBackData : Pointer;
FLastErrorClass : String;
FLastError : String;
FOnUnitAlias : TUnitAliasCallBack;
procedure SetDefines(AValue: TStrings);
procedure SetIncludePaths(AValue: TStrings);
procedure SetOnWrite(AValue: TWriteEvent);
procedure SetWriteCallback(AValue: TWriteCallBack);
function CheckUnitAlias(const AUnitName: String): String;
Protected
procedure DoExecute;virtual;
Procedure DoWriteEvent; virtual;
@ -81,9 +86,10 @@ type
// OutputStream can be used combined with write callbacks.
Property OutputStream : TStream Read FOutputStream Write FOutputStream;
Property HeaderStream : TStream Read FHeaderStream Write FHeaderStream;
Property OnUnitAlias: TUnitAliasCallBack read FOnUnitAlias Write FOnUnitAlias;
Property OnUnitAliasData : Pointer Read FOnUnitAliasData Write FOnUnitAliasData;
Property OnWriteCallBack : TWriteCallBack Read FOnWriteCallBack Write SetWriteCallback;
Property CallbackData : Pointer Read FCallBackData Write FCallBackData;
Published
Property Defines : TStrings Read FDefines Write SetDefines;
Property ConfigFileName : String Read FConfigFile Write FConfigFile;
@ -97,6 +103,8 @@ type
Implementation
uses Math;
ResourceString
SErrNoDestGiven = 'No destination file specified.';
SErrNoSourceParsed = 'Parsing produced no file.';
@ -131,6 +139,23 @@ begin
FWriteStream:=TStringStream.Create('');
end;
function TStubCreator.CheckUnitAlias(const AUnitName: String): String;
const
MAX_UNIT_NAME_LENGTH = 255;
var
UnitMaxLenthName: Integer;
begin
Result := AUnitName;
UnitMaxLenthName := Max(MAX_UNIT_NAME_LENGTH, Result.Length);
SetLength(Result, UnitMaxLenthName);
if FOnUnitAlias(OnUnitAliasData, @Result[1], UnitMaxLenthName) then
Result := LeftStr(PChar(Result), UnitMaxLenthName);
end;
procedure TStubCreator.DoWriteEvent;
Var
@ -279,7 +304,7 @@ end;
Function TStubCreator.GetModule : TPasModule;
function TStubCreator.GetModule: TPasModule;
Var
SE : TSimpleEngine;
@ -327,7 +352,8 @@ begin
end;
end;
function TStubCreator.MaybeGetFileStream(AStream: TStream; const AFileName: String; AfileMode : Word) : TStream;
function TStubCreator.MaybeGetFileStream(AStream: TStream;
const AFileName: String; aFileMode: Word): TStream;
begin
If Assigned(AStream) then
Result:=AStream
@ -359,7 +385,7 @@ begin
end;
procedure TStubCreator.WriteModule(M : TPAsModule);
procedure TStubCreator.WriteModule(M: TPasModule);
Var
F,H : TStream;
@ -386,6 +412,10 @@ begin
W:=TPasWriter.Create(F);
W.Options:=FOptions;
U:=FExtraUnits;
if Assigned(FOnUnitAlias) then
W.OnUnitAlias:=@CheckUnitAlias;
if Pos(LowerCase(DTypesUnit),LowerCase(U)) = 0 then
begin
if (U<>'') then