summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
authormichael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2>2020-08-23 09:46:29 +0000
committermichael <michael@3ad0048d-3df7-0310-abae-a5850022a9f2>2020-08-23 09:46:29 +0000
commit64879abc095afb176b009c7b9d09e703d740dbed (patch)
tree2bd13bf675a7eb6825e4aa0601f8dfb0113c90ef /utils
parent0e6d341b3ff0e4f0912d9394f71796d9e6a443de (diff)
downloadfpc-64879abc095afb176b009c7b9d09e703d740dbed.tar.gz
* Merging revisions r46442 from trunk:
------------------------------------------------------------------------ r46442 | michael | 2020-08-15 09:26:44 +0200 (Sat, 15 Aug 2020) | 1 line * unit alias possibility ------------------------------------------------------------------------ git-svn-id: https://svn.freepascal.org/svn/fpc/branches/fixes_3_2@46623 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'utils')
-rw-r--r--utils/pas2js/libstub.pp9
-rw-r--r--utils/pas2js/stubcreator.pp38
2 files changed, 42 insertions, 5 deletions
diff --git a/utils/pas2js/libstub.pp b/utils/pas2js/libstub.pp
index f8d3a9eb1f..5235f0bd5b 100644
--- a/utils/pas2js/libstub.pp
+++ b/utils/pas2js/libstub.pp
@@ -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.
diff --git a/utils/pas2js/stubcreator.pp b/utils/pas2js/stubcreator.pp
index f4a71ca437..39e0ce4aec 100644
--- a/utils/pas2js/stubcreator.pp
+++ b/utils/pas2js/stubcreator.pp
@@ -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