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

--- Merging r40076 into '.':

Browse Source 
U    packages/pastojs/src/pas2jscompiler.pp
--- Recording mergeinfo for merge of r40076 into '.':
 U   .
--- Merging r40081 into '.':
U    packages/pastojs/tests/tcmodules.pas
U    packages/pastojs/src/fppas2js.pp
U    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r40081 into '.':
 G   .
--- Merging r40083 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r40083 into '.':
 G   .
--- Merging r40084 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40084 into '.':
 G   .
--- Merging r40085 into '.':
U    packages/pastojs/src/pas2jsfilecache.pp
G    packages/pastojs/src/pas2jscompiler.pp
--- Recording mergeinfo for merge of r40085 into '.':
 G   .
--- Merging r40101 into '.':
U    packages/pastojs/src/pas2jsfileutils.pp
U    packages/pastojs/src/pas2jsfileutilsnodejs.inc
--- Recording mergeinfo for merge of r40101 into '.':
 G   .
--- Merging r40105 into '.':
G    packages/pastojs/src/pas2jsfileutils.pp
G    packages/pastojs/src/pas2jsfilecache.pp
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40105 into '.':
 G   .
--- Merging r40106 into '.':
G    packages/pastojs/src/pas2jsfileutils.pp
--- Recording mergeinfo for merge of r40106 into '.':
 G   .
--- Merging r40107 into '.':
U    packages/pastojs/src/pas2jspparser.pp
--- Recording mergeinfo for merge of r40107 into '.':
 G   .
--- Merging r40116 into '.':
U    utils/pas2js/dist/rtl.js
--- Recording mergeinfo for merge of r40116 into '.':
 G   .
--- Merging r40126 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
--- Recording mergeinfo for merge of r40126 into '.':
 G   .
--- Merging r40127 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40127 into '.':
 G   .
--- Merging r40133 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40133 into '.':
 G   .
--- Merging r40135 into '.':
U    packages/fcl-js/src/jssrcmap.pas
--- Recording mergeinfo for merge of r40135 into '.':
 G   .
--- Merging r40138 into '.':
G    packages/pastojs/src/pas2jsfilecache.pp
--- Recording mergeinfo for merge of r40138 into '.':
 G   .
--- Merging r40139 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
--- Recording mergeinfo for merge of r40139 into '.':
 G   .
--- Merging r40140 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40140 into '.':
 G   .
--- Merging r40143 into '.':
G    utils/pas2js/dist/rtl.js
--- Recording mergeinfo for merge of r40143 into '.':
 G   .
--- Merging r40146 into '.':
G    utils/pas2js/dist/rtl.js
--- Recording mergeinfo for merge of r40146 into '.':
 G   .
--- Merging r40148 into '.':
G    utils/pas2js/dist/rtl.js
--- Recording mergeinfo for merge of r40148 into '.':
 G   .
--- Merging r40151 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40151 into '.':
 G   .
--- Merging r40152 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40152 into '.':
 G   .
--- Merging r40164 into '.':
U    utils/pas2js/nodepas2js.lpi
--- Recording mergeinfo for merge of r40164 into '.':
 G   .
--- Merging r40168 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40168 into '.':
 G   .
--- Merging r40175 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40175 into '.':
 G   .
--- Merging r40177 into '.':
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
U    packages/fcl-passrc/src/pastree.pp
--- Recording mergeinfo for merge of r40177 into '.':
 G   .
--- Merging r40192 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40192 into '.':
 G   .
--- Merging r40193 into '.':
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r40193 into '.':
 G   .
--- Merging r40194 into '.':
U    packages/pastojs/src/pas2jslogger.pp
G    packages/pastojs/src/pas2jsfileutils.pp
G    packages/pastojs/src/pas2jscompiler.pp
--- Recording mergeinfo for merge of r40194 into '.':
 G   .
--- Merging r40204 into '.':
U    packages/fcl-passrc/src/pasuseanalyzer.pas
U    packages/fcl-passrc/src/pasresolver.pp
--- Recording mergeinfo for merge of r40204 into '.':
 G   .
--- Merging r40209 into '.':
G    packages/pastojs/src/pas2jslogger.pp
--- Recording mergeinfo for merge of r40209 into '.':
 G   .
--- Merging r40210 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40210 into '.':
 G   .
--- Merging r40211 into '.':
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r40211 into '.':
 G   .
--- Merging r40241 into '.':
U    utils/pas2js/pas2js.lpi
--- Recording mergeinfo for merge of r40241 into '.':
 G   .
--- Merging r40243 into '.':
G    utils/pas2js/pas2js.lpi
--- Recording mergeinfo for merge of r40243 into '.':
 G   .
--- Merging r40245 into '.':
U    utils/pas2js/pas2js.cfg
--- Recording mergeinfo for merge of r40245 into '.':
 G   .
--- Merging r40258 into '.':
G    utils/pas2js/pas2js.lpi
--- Recording mergeinfo for merge of r40258 into '.':
 G   .
--- Merging r40259 into '.':
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40259 into '.':
 G   .
--- Merging r40263 into '.':
U    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r40263 into '.':
 G   .
--- Merging r40279 into '.':
U    packages/pastojs/tests/tcfiler.pas
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/pas2jspparser.pp
G    packages/pastojs/src/fppas2js.pp
U    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r40279 into '.':
 G   .
--- Merging r40290 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40290 into '.':
 G   .
--- Merging r40302 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
--- Recording mergeinfo for merge of r40302 into '.':
 G   .
--- Merging r40304 into '.':
U    packages/fcl-passrc/src/paswrite.pp
--- Recording mergeinfo for merge of r40304 into '.':
 G   .
--- Merging r40305 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
--- Recording mergeinfo for merge of r40305 into '.':
 G   .
--- Merging r40342 into '.':
G    packages/fcl-passrc/src/pparser.pp
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/tests/tcresolver.pas
--- Recording mergeinfo for merge of r40342 into '.':
 G   .
--- Merging r40343 into '.':
U    packages/pastojs/src/pas2jsfiler.pp
G    packages/pastojs/src/fppas2js.pp
G    packages/pastojs/tests/tcmodules.pas
--- Recording mergeinfo for merge of r40343 into '.':
 G   .
--- Merging r40351 into '.':
U    packages/fcl-js/src/jswriter.pp
G    packages/pastojs/src/pas2jscompiler.pp
U    packages/pastojs/src/pas2jsfileutilsunix.inc
G    packages/pastojs/src/pas2jslogger.pp
G    packages/pastojs/src/pas2jsfileutils.pp
G    packages/pastojs/src/pas2jsfilecache.pp
G    packages/pastojs/src/fppas2js.pp
U    packages/pastojs/src/pas2jsfileutilswin.inc
--- Recording mergeinfo for merge of r40351 into '.':
 G   .
--- Merging r40352 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/pastojs/src/pas2jsfileutilsnodejs.inc
G    packages/fcl-js/src/jswriter.pp
--- Recording mergeinfo for merge of r40352 into '.':
 G   .
--- Merging r40353 into '.':
U    utils/pas2js/pas2jslib.lpi
--- Recording mergeinfo for merge of r40353 into '.':
 G   .
--- Merging r40354 into '.':
U    packages/pastojs/fpmake.pp
--- Recording mergeinfo for merge of r40354 into '.':
 G   .
--- Merging r40355 into '.':
G    packages/pastojs/src/pas2jsfileutilswin.inc
--- Recording mergeinfo for merge of r40355 into '.':
 G   .
--- Merging r40356 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/pastojs/src/pas2jsfileutils.pp
U    utils/pas2js/docs/translation.html
--- Recording mergeinfo for merge of r40356 into '.':
 G   .
--- Merging r40372 into '.':
G    packages/pastojs/tests/tcmodules.pas
G    packages/pastojs/src/fppas2js.pp
G    utils/pas2js/docs/translation.html
--- Recording mergeinfo for merge of r40372 into '.':
 G   .
--- Merging r40423 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/pastojs/src/pas2jsfilecache.pp
--- Recording mergeinfo for merge of r40423 into '.':
 G   .
--- Merging r40424 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
--- Recording mergeinfo for merge of r40424 into '.':
 G   .
--- Merging r40426 into '.':
G    packages/fcl-passrc/src/pasresolver.pp
G    packages/fcl-passrc/src/pscanner.pp
G    packages/fcl-passrc/src/pparser.pp
--- Recording mergeinfo for merge of r40426 into '.':
 G   .
--- Merging r40427 into '.':
G    packages/pastojs/fpmake.pp
G    packages/pastojs/src/pas2jscompiler.pp
A    packages/pastojs/src/pas2jspcucompiler.pp
G    packages/pastojs/src/pas2jsfilecache.pp
--- Recording mergeinfo for merge of r40427 into '.':
 G   .
--- Merging r40428 into '.':
U    packages/pastojs/tests/tcunitsearch.pas
U    packages/pastojs/tests/testpas2js.lpi
--- Recording mergeinfo for merge of r40428 into '.':
 G   .
--- Merging r40429 into '.':
G    packages/fcl-passrc/src/pscanner.pp
--- Recording mergeinfo for merge of r40429 into '.':
 G   .
--- Merging r40430 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
U    packages/pastojs/src/pas2jspcucompiler.pp
G    packages/pastojs/src/pas2jsfilecache.pp
--- Recording mergeinfo for merge of r40430 into '.':
 G   .
--- Merging r40439 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/pastojs/src/pas2jspcucompiler.pp
G    packages/pastojs/src/pas2jsfilecache.pp
--- Recording mergeinfo for merge of r40439 into '.':
 G   .
--- Merging r40440 into '.':
G    packages/pastojs/src/pas2jscompiler.pp
G    packages/pastojs/src/pas2jsfilecache.pp
--- Recording mergeinfo for merge of r40440 into '.':
 G   .
--- Merging r40441 into '.':
G    packages/pastojs/src/pas2jspcucompiler.pp
--- Recording mergeinfo for merge of r40441 into '.':
 G   .

# revisions: 40076,40081,40083,40084,40085,40101,40105,40106,40107,40116,40126,40127,40133,40135,40138,40139,40140,40143,40146,40148,40151,40152,40164,40168,40175,40177,40192,40193,40194,40204,40209,40210,40211,40241,40243,40245,40258,40259,40263,40279,40290,40302,40304,40305,40342,40343,40351,40352,40353,40354,40355,40356,40372,40423,40424,40426,40427,40428,40429,40430,40439,40440,40441

git-svn-id: branches/fixes_3_2@40718 -
This commit is contained in:
marco 2018-12-31 16:37:10 +00:00
parent 23b9dde397
commit e16529a374
32 changed files with 3760 additions and 2144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6929,6 +6929,7 @@ packages/pastojs/src/pas2jsfileutilsunix.inc svneol=native#text/plain
packages/pastojs/src/pas2jsfileutilswin.inc svneol=native#text/plain
packages/pastojs/src/pas2jslibcompiler.pp svneol=native#text/plain
packages/pastojs/src/pas2jslogger.pp svneol=native#text/plain
packages/pastojs/src/pas2jspcucompiler.pp svneol=native#text/plain
packages/pastojs/src/pas2jspparser.pp svneol=native#text/plain
packages/pastojs/tests/tcconverter.pp svneol=native#text/plain
packages/pastojs/tests/tcfiler.pas svneol=native#text/plain

6
packages/fcl-js/src/jssrcmap.pas
View File

@ -474,7 +474,7 @@ end;
procedure TSourceMap.TStringToIndex.Add(const Value: String; Index: integer);
begin
{$ifdef pas2js}
FItems[Value]:=Index;
FItems['%'+Value]:=Index;
{$else}
// Note: nil=0 means not found in TFPHashList
FItems.Add(Value,{%H-}Pointer(PtrInt(Index+1)));
@ -485,8 +485,8 @@ function TSourceMap.TStringToIndex.FindValue(const Value: String
): integer;
begin
{$ifdef pas2js}
if FItems.hasOwnProperty(Value) then
Result:=integer(FItems[Value])
if FItems.hasOwnProperty('%'+Value) then
Result:=integer(FItems['%'+Value])
else
Result:=-1;
{$else}

23
packages/fcl-js/src/jswriter.pp
View File

@ -109,7 +109,7 @@ Type
private
FBufPos,
FCapacity: Cardinal;
FBuffer : TBuffer;
FBuffer: TBuffer;
function GetAsString: TJSWriterString;
{$ifdef fpc}
function GetBuffer: Pointer;
@ -119,6 +119,7 @@ Type
{$ifdef FPC_HAS_CPSTRING}
function GetUnicodeString: UnicodeString;
{$endif}
procedure SetAsString(const AValue: TJSWriterString);
procedure SetCapacity(AValue: Cardinal);
Protected
Function DoWrite(Const S : TJSWriterString) : integer; override;
@ -136,7 +137,7 @@ Type
{$endif}
Property BufferLength : Integer Read GetBufferLength;
Property Capacity : Cardinal Read GetCapacity Write SetCapacity;
Property AsString : TJSWriterString Read GetAsString;
Property AsString : TJSWriterString Read GetAsString Write SetAsString;
{$ifdef FPC_HAS_CPSTRING}
Property AsAnsiString : AnsiString Read GetAsString; deprecated 'use AsString instead, fpc 3.3.1';
Property AsUnicodeString : UnicodeString Read GetUnicodeString;
@ -320,6 +321,16 @@ begin
end;
{$endif}
procedure TBufferWriter.SetAsString(const AValue: TJSWriterString);
begin
{$ifdef pas2js}
SetLength(FBuffer,0);
FCapacity:=0;
{$endif}
FBufPos:=0;
DoWrite(AValue);
end;
procedure TBufferWriter.SetCapacity(AValue: Cardinal);
begin
if FCapacity=AValue then Exit;
@ -328,7 +339,7 @@ begin
FBufPos:=Capacity;
end;
Function TBufferWriter.DoWrite(Const S: TJSWriterString): integer;
function TBufferWriter.DoWrite(const S: TJSWriterString): integer;
{$ifdef pas2js}
begin
Result:=Length(S)*2;
@ -358,7 +369,7 @@ end;
{$endif}
{$ifdef FPC_HAS_CPSTRING}
Function TBufferWriter.DoWrite(Const S: UnicodeString): integer;
function TBufferWriter.DoWrite(const S: UnicodeString): integer;
Var
DesLen,MinLen : Integer;
@ -379,14 +390,14 @@ begin
end;
{$endif}
Constructor TBufferWriter.Create(Const ACapacity: Cardinal);
constructor TBufferWriter.Create(const ACapacity: Cardinal);
begin
inherited Create;
Capacity:=ACapacity;
end;
{$ifdef fpc}
Procedure TBufferWriter.SaveToFile(Const AFileName: String);
procedure TBufferWriter.SaveToFile(const AFileName: String);
Var
F : File;

106
packages/fcl-passrc/src/pasresolver.pp
View File

@ -285,7 +285,10 @@ interface
uses
{$ifdef pas2js}
js, NodeJSFS,
js,
{$IFDEF NODEJS}
NodeJSFS,
{$ENDIF}
{$endif}
Classes, SysUtils, Math, Types, contnrs,
PasTree, PScanner, PParser, PasResolveEval;
@ -1801,7 +1804,9 @@ type
PosEl: TPasElement; RaiseIfConst: boolean = true): boolean;
function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
// utility functions
function ElHasModeSwitch(El: TPasElement; ms: TModeSwitch): boolean;
function GetElModeSwitches(El: TPasElement): TModeSwitches;
function ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch): boolean;
function GetElBoolSwitches(El: TPasElement): TBoolSwitches;
function GetProcTypeDescription(ProcType: TPasProcedureType;
Flags: TPRProcTypeDescFlags = [prptdUseName,prptdResolveSimpleAlias]): string;
@ -4373,6 +4378,9 @@ begin
// hidden method has implementation, but no statements -> useless
// -> do not give a hint for hiding this useless method
// Note: if this happens in the same unit, the body was not yet parsed
else if (Proc is TPasConstructor)
and (Data^.Proc.ClassType=Proc.ClassType) then
// do not give a hint for hiding a constructor
else
LogMsg(20171118214523,mtHint,
nFunctionHidesIdentifier_NonVirtualMethod,sFunctionHidesIdentifier,
@ -8109,7 +8117,7 @@ begin
begin
LTypeEl:=LeftResolved.LoTypeEl;
if (LTypeEl.ClassType=TPasPointerType)
and (msAutoDeref in GetElModeSwitches(El))
and ElHasModeSwitch(El,msAutoDeref)
and (rrfReadable in LeftResolved.Flags)
then
begin
@ -8564,7 +8572,7 @@ procedure TPasResolver.ResolveArrayParamsArgs(Params: TParamsExpr;
if not IsStringIndex then
begin
// pointer
if not (bsPointerMath in GetElBoolSwitches(Params)) then
if not ElHasBoolSwitch(Params,bsPointerMath) then
exit(false);
end;
Result:=true;
@ -9621,7 +9629,7 @@ begin
else if RightResolved.BaseType=btPointer then
begin
if (Bin.OpCode in [eopAdd,eopSubtract])
and (bsPointerMath in GetElBoolSwitches(Bin)) then
and ElHasBoolSwitch(Bin,bsPointerMath) then
begin
// integer+CanonicalPointer
SetResolverValueExpr(ResolvedEl,btPointer,
@ -9635,7 +9643,7 @@ begin
if RightTypeEl.ClassType=TPasPointerType then
begin
if (Bin.OpCode in [eopAdd,eopSubtract])
and (bsPointerMath in GetElBoolSwitches(Bin)) then
and ElHasBoolSwitch(Bin,bsPointerMath) then
begin
// integer+TypedPointer
RightTypeEl:=TPasPointerType(RightTypeEl).DestType;
@ -9834,7 +9842,7 @@ begin
if (RightResolved.BaseType in btAllInteger) then
case Bin.OpCode of
eopAdd,eopSubtract:
if bsPointerMath in GetElBoolSwitches(Bin) then
if ElHasBoolSwitch(Bin,bsPointerMath) then
begin
// pointer+integer -> pointer
SetResolverValueExpr(ResolvedEl,btPointer,
@ -10115,7 +10123,7 @@ begin
begin
if IsDynArray(LeftTypeEl)
and (Bin.OpCode=eopAdd)
and (msArrayOperators in GetElModeSwitches(Bin))
and ElHasModeSwitch(Bin,msArrayOperators)
and ((RightResolved.BaseType in [btArrayOrSet,btArrayLit])
or IsDynArray(RightResolved.LoTypeEl)) then
begin
@ -10128,7 +10136,7 @@ begin
else if LeftTypeEl.ClassType=TPasPointerType then
begin
if (RightResolved.BaseType in btAllInteger)
and (bsPointerMath in GetElBoolSwitches(Bin)) then
and ElHasBoolSwitch(Bin,bsPointerMath) then
begin
// TypedPointer+Integer
SetLeftValueExpr([rrfReadable]);
@ -10223,7 +10231,7 @@ begin
if (rrfReadable in LeftResolved.Flags)
and (rrfReadable in RightResolved.Flags)
and (Bin.OpCode=eopAdd)
and (msArrayOperators in GetElModeSwitches(Bin)) then
and ElHasModeSwitch(Bin,msArrayOperators) then
begin
if RightResolved.BaseType=btArrayLit then
begin
@ -12578,14 +12586,14 @@ begin
Result:=cExact
else if ParamResolved.BaseType=btPointer then
begin
if bsPointerMath in GetElBoolSwitches(Expr) then
if ElHasBoolSwitch(Expr,bsPointerMath) then
Result:=cExact;
end
else if ParamResolved.BaseType=btContext then
begin
TypeEl:=ParamResolved.LoTypeEl;
if (TypeEl.ClassType=TPasPointerType)
and (bsPointerMath in GetElBoolSwitches(Expr)) then
and ElHasBoolSwitch(Expr,bsPointerMath) then
Result:=cExact;
end;
if Result=cIncompatible then
@ -17672,6 +17680,12 @@ begin
exit(true);
end;
function TPasResolver.ElHasModeSwitch(El: TPasElement; ms: TModeSwitch
): boolean;
begin
Result:=ms in GetElModeSwitches(El);
end;
function TPasResolver.GetElModeSwitches(El: TPasElement): TModeSwitches;
var
C: TClass;
@ -17691,6 +17705,12 @@ begin
Result:=CurrentParser.CurrentModeswitches;
end;
function TPasResolver.ElHasBoolSwitch(El: TPasElement; bs: TBoolSwitch
): boolean;
begin
Result:=bs in GetElBoolSwitches(El);
end;
function TPasResolver.GetElBoolSwitches(El: TPasElement): TBoolSwitches;
var
C: TClass;
@ -19463,6 +19483,50 @@ procedure TPasResolver.ComputeElement(El: TPasElement; out
end;
end;
procedure ComputeInherited(Expr: TInheritedExpr);
var
Ref: TResolvedReference;
Proc: TPasProcedure;
TypeEl: TPasProcedureType;
aClass: TPasClassType;
HasName: Boolean;
begin
// "inherited;"
Ref:=TResolvedReference(El.CustomData);
Proc:=NoNil(Ref.Declaration) as TPasProcedure;
TypeEl:=TPasProcedure(Proc).ProcType;
SetResolverIdentifier(ResolvedEl,btProc,Proc,
TypeEl,TypeEl,[rrfCanBeStatement]);
HasName:=(El.Parent.ClassType=TBinaryExpr)
and (TBinaryExpr(El.Parent).OpCode=eopNone); // true if 'inherited Proc;'
if HasName or (rcNoImplicitProc in Flags) then
exit;
// inherited; -> implicit call possible
if Proc is TPasFunction then
begin
// function => return result
ComputeElement(TPasFunction(Proc).FuncType.ResultEl,
ResolvedEl,Flags+[rcType],StartEl);
Exclude(ResolvedEl.Flags,rrfWritable);
end
else if (Proc.ClassType=TPasConstructor)
and (rrfNewInstance in Ref.Flags) then
begin
// new instance constructor -> return value of type class
aClass:=GetReference_NewInstanceClass(Ref);
SetResolverValueExpr(ResolvedEl,btContext,aClass,aClass,Expr,[rrfReadable]);
end
else if ParentNeedsExprResult(Expr) then
begin
// a procedure
exit;
end;
if rcSetReferenceFlags in Flags then
Include(Ref.Flags,rrfImplicitCallWithoutParams);
Include(ResolvedEl.Flags,rrfCanBeStatement);
end;
var
DeclEl: TPasElement;
ElClass: TClass;
@ -19622,13 +19686,7 @@ begin
begin
// writeln('TPasResolver.ComputeElement TInheritedExpr El.CustomData=',GetObjName(El.CustomData));
if El.CustomData is TResolvedReference then
begin
// "inherited;"
DeclEl:=NoNil(TResolvedReference(El.CustomData).Declaration) as TPasProcedure;
TypeEl:=TPasProcedure(DeclEl).ProcType;
SetResolverIdentifier(ResolvedEl,btProc,DeclEl,
TypeEl,TypeEl,[rrfCanBeStatement]);
end
ComputeInherited(TInheritedExpr(El))
else
// no ancestor proc
SetResolverIdentifier(ResolvedEl,btBuiltInProc,nil,nil,nil,[rrfCanBeStatement]);
@ -20239,7 +20297,7 @@ end;
function TPasResolver.IsArrayOperatorAdd(Expr: TPasExpr): boolean;
begin
Result:=(Expr<>nil) and (Expr.ClassType=TBinaryExpr) and (Expr.OpCode=eopAdd)
and (msArrayOperators in GetElModeSwitches(Expr));
and ElHasModeSwitch(Expr,msArrayOperators);
end;
function TPasResolver.IsTypeCast(Params: TParamsExpr): boolean;
@ -20562,8 +20620,14 @@ begin
if El.CustomData is TResElDataBaseType then
exit(true); // base type
if El.Parent=nil then exit;
if (El.Parent is TPasType) and not HasTypeInfo(TPasType(El.Parent)) then
exit;
if El.Parent is TPasType then
begin
if not HasTypeInfo(TPasType(El.Parent)) then
exit;
end
else
if ElHasModeSwitch(El,msOmitRTTI) then
exit;
Result:=true;
end;

10
packages/fcl-passrc/src/pastree.pp
View File

@ -236,6 +236,7 @@ type
destructor Destroy; override;
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
const Arg: Pointer); override;
class function IsRightSubIdent(El: TPasElement): boolean;
end;
{ TPrimitiveExpr }
@ -5062,6 +5063,15 @@ begin
ForEachChildCall(aMethodCall,Arg,right,false);
end;
class function TBinaryExpr.IsRightSubIdent(El: TPasElement): boolean;
var
Bin: TBinaryExpr;
begin
if (El=nil) or not (El.Parent is TBinaryExpr) then exit(false);
Bin:=TBinaryExpr(El.Parent);
Result:=(Bin.right=El) and (Bin.OpCode=eopSubIdent);
end;
{ TParamsExpr }
function TParamsExpr.GetDeclaration(full: Boolean): string;

2
packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -881,7 +881,7 @@ begin
Result.Element:=El;
FUsedElements.Add(Result);
{$IFDEF VerbosePasAnalyzer}
writeln('TPasAnalyzer.Add END ',GetElModName(El),' Success=',PAElementExists(El),' ',{$Ifdef pas2js}El.PasElementId{$else}ptruint(pointer(El)){$endif});
writeln('TPasAnalyzer.Add END ',GetElModName(El),' Success=',PAElementExists(El),' '{$Ifdef pas2js},El.PasElementId{$endif});
{$ENDIF}
end;

27
packages/fcl-passrc/src/paswrite.pp
View File

@ -94,7 +94,7 @@ type
procedure WriteUsesList(ASection: TPasSection); virtual;
procedure WriteClass(AClass: TPasClassType); virtual;
procedure WriteConst(AConst: TPasConst); virtual;
procedure WriteVariable(AVar: TPasVariable); virtual;
procedure WriteVariable(aVar: TPasVariable); virtual;
procedure WriteArgument(aArg: TPasArgument); virtual;
procedure WriteDummyExternalFunctions(aSection: TPasSection); virtual;
procedure WriteOverloadedProc(aProc : TPasOverloadedProc; ForceBody: Boolean = False; NamePrefix : String = ''); virtual;
@ -680,27 +680,27 @@ begin
AddLn(AConst.GetDeclaration(True)+';');
end;
procedure TPasWriter.WriteVariable(AVar: TPasVariable);
procedure TPasWriter.WriteVariable(aVar: TPasVariable);
var
LParentIsClassOrRecord: boolean;
begin
LParentIsClassOrRecord:= (AVar.Parent.ClassType = TPasClassType) or
(AVar.Parent.ClassType = TPasRecordType);
LParentIsClassOrRecord:= (aVar.Parent.ClassType = TPasClassType) or
(aVar.Parent.ClassType = TPasRecordType);
if not LParentIsClassOrRecord then
PrepareDeclSection('var')
// handle variables in classes/records
else if vmClass in AVar.VarModifiers then
else if vmClass in aVar.VarModifiers then
PrepareDeclSectionInStruct('class var')
else if CurDeclSection<>'' then
PrepareDeclSectionInStruct('var');
Add(AVar.Name + ': ');
if Not Assigned(AVar.VarType) then
Raise EWriteError.CreateFmt('No type for variable %s',[AVar.Name]);
WriteType(AVar.VarType,False);
if (AVar.AbsoluteLocation<>'') then
Add(' absolute %s',[AVar.AbsoluteLocation])
Add(aVar.Name + ': ');
if Not Assigned(aVar.VarType) then
Raise EWriteError.CreateFmt('No type for variable %s',[aVar.Name]);
WriteType(aVar.VarType,False);
if (aVar.AbsoluteExpr<>nil) then
Add(' absolute %s',[aVar.AbsoluteExpr.ClassName])
else if (aVar.LibraryName<>Nil) or Assigned (aVar.ExportName) then
begin
if LParentIsClassOrRecord then
@ -711,8 +711,8 @@ begin
else if NotOption(woNoExternalVar) then
begin
Add('; external ');
if (AVar.LibraryName<>Nil) then
Add('%s ',[AVar.LibraryName.GetDeclaration(true)]);
if (aVar.LibraryName<>Nil) then
Add('%s ',[aVar.LibraryName.GetDeclaration(true)]);
Add('name %s',[aVar.ExportName.GetDeclaration(true)]);
end;
end;
@ -913,6 +913,7 @@ begin
end;
AddLn(';');
IncDeclSectionLevel;
PE:=nil;
for i := 0 to AProc.Locals.Count - 1 do
begin
E:=TPasElement(AProc.Locals[i]);

32
packages/fcl-passrc/src/pparser.pp
View File

@ -31,7 +31,7 @@ unit PParser;
interface
uses
{$ifdef pas2js}
{$ifdef NODEJS}
NodeJSFS,
{$endif}
SysUtils, Classes, PasTree, PScanner;
@ -94,6 +94,7 @@ const
nParserResourcestringsMustBeGlobal = 2054;
nParserOnlyOneVariableCanBeAbsolute = 2055;
nParserXNotAllowedInY = 2056;
nFileSystemsNotSupported = 2057;
// resourcestring patterns of messages
resourcestring
@ -153,6 +154,7 @@ resourcestring
SParserResourcestringsMustBeGlobal = 'Resourcestrings can be only static or global';
SParserOnlyOneVariableCanBeAbsolute = 'Only one variable can be absolute';
SParserXNotAllowedInY = '%s is not allowed in %s';
SErrFileSystemNotSupported = 'No support for filesystems enabled';
type
TPasScopeType = (
@ -472,6 +474,10 @@ Type
{$endif}
poSkipDefaultDefs);
TParseSourceOptions = set of TParseSourceOption;
Var
DefaultFileResolverClass : TBaseFileResolverClass = Nil;
function ParseSource(AEngine: TPasTreeContainer;
const FPCCommandLine, OSTarget, CPUTarget: String): TPasModule;
{$ifdef HasStreams}
@ -597,8 +603,9 @@ end;
function ParseSource(AEngine: TPasTreeContainer;
const FPCCommandLine, OSTarget, CPUTarget: String;
Options : TParseSourceOptions): TPasModule;
var
FileResolver: TFileResolver;
FileResolver: TBaseFileResolver;
Parser: TPasParser;
Start, CurPos: integer; // in FPCCommandLine
Filename: String;
@ -648,7 +655,7 @@ var
end;
end else
if Filename <> '' then
raise Exception.Create(SErrMultipleSourceFiles)
raise ENotSupportedException.Create(SErrMultipleSourceFiles)
else
Filename := s;
end;
@ -656,14 +663,17 @@ var
var
s: String;
begin
if DefaultFileResolverClass=Nil then
raise ENotImplemented.Create(SErrFileSystemNotSupported);
Result := nil;
FileResolver := nil;
Scanner := nil;
Parser := nil;
try
FileResolver := TFileResolver.Create;
FileResolver := DefaultFileResolverClass.Create;
{$ifdef HasStreams}
FileResolver.UseStreams:=poUseStreams in Options;
if FileResolver is TFileResolver then
TFileResolver(FileResolver).UseStreams:=poUseStreams in Options;
{$endif}
Scanner := TPascalScanner.Create(FileResolver);
Scanner.LogEvents:=AEngine.ScannerLogEvents;
@ -733,7 +743,9 @@ begin
if Filename = '' then
raise Exception.Create(SErrNoSourceGiven);
{$IFDEF HASFS}
FileResolver.AddIncludePath(ExtractFilePath(FileName));
{$ENDIF}
Scanner.OpenFile(Filename);
Parser.ParseMain(Result);
finally
@ -3457,7 +3469,7 @@ begin
NamePos:=CurSourcePos;
List:=TFPList.Create;
try
ReadGenericArguments(List,Nil);
ReadGenericArguments(List,Declarations);
ExpectToken(tkEqual);
NextToken;
Case CurToken of
@ -3859,7 +3871,7 @@ begin
CheckToken(tkSquaredBraceClose);
end;
procedure TPasParser.ReadGenericArguments(List : TFPList;Parent : TPasElement);
procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
Var
N : String;
@ -6329,6 +6341,8 @@ begin
Result:=isVisibility(S,AVisibility);
if Result then
begin
if (AVisibility=visPublished) and (msOmitRTTI in Scanner.CurrentModeSwitches) then
AVisibility:=visPublic;
if B then
case AVisibility of
visPrivate : AVisibility:=visStrictPrivate;
@ -6987,4 +7001,8 @@ begin
Result.Kind:=pekListOfExp;
end;
initialization
{$IFDEF HASFS}
DefaultFileResolverClass:=TFileResolver;
{$ENDIF}
end.

125
packages/fcl-passrc/src/pscanner.pp
View File

@ -26,13 +26,22 @@ unit PScanner;
{$IF FPC_FULLVERSION<30101}
{$define EmulateArrayInsert}
{$endif}
{$define HasFS}
{$endif}
{$IFDEF NODEJS}
{$define HasFS}
{$ENDIF}
interface
uses
{$ifdef pas2js}
js, NodeJSFS, Types,
js,
{$IFDEF NODEJS}
NodeJSFS,
{$ENDIF}
Types,
{$endif}
SysUtils, Classes;
@ -284,7 +293,8 @@ type
msArrayOperators, { use Delphi compatible array operators instead of custom ones ("+") }
msExternalClass, { Allow external class definitions }
msPrefixedAttributes, { Allow attributes, disable proc modifier [] }
msIgnoreAttributes { workaround til resolver/converter supports attributes }
msIgnoreAttributes, { workaround til resolver/converter supports attributes }
msOmitRTTI { treat class section 'published' as 'public' and typeinfo does not work on symbols declared with this switch }
);
TModeSwitches = Set of TModeSwitch;
@ -478,7 +488,6 @@ type
Protected
procedure SetBaseDirectory(AValue: string); virtual;
procedure SetStrictFileCase(AValue: Boolean); virtual;
Function FindIncludeFileName(const AName: string): String;
Property IncludePaths: TStringList Read FIncludePaths;
public
constructor Create; virtual;
@ -489,7 +498,9 @@ type
Property StrictFileCase : Boolean Read FStrictFileCase Write SetStrictFileCase;
property BaseDirectory: string read FBaseDirectory write SetBaseDirectory;
end;
TBaseFileResolverClass = Class of TBaseFileResolver;
{$IFDEF HASFS}
{ TFileResolver }
TFileResolver = class(TBaseFileResolver)
@ -498,6 +509,7 @@ type
FUseStreams: Boolean;
{$endif}
Protected
Function FindIncludeFileName(const AName: string): String; virtual;
Function CreateFileReader(Const AFileName : String) : TLineReader; virtual;
Public
function FindSourceFile(const AName: string): TLineReader; override;
@ -506,6 +518,7 @@ type
Property UseStreams : Boolean Read FUseStreams Write FUseStreams;
{$endif}
end;
{$ENDIF}
{$ifdef fpc}
{ TStreamResolver }
@ -648,6 +661,8 @@ type
TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
TPScannerModeDirective = procedure(Sender: TObject; NewMode: TModeSwitch; Before: boolean; var Handled: boolean) of object;
TPasScannerTokenPos = {$ifdef UsePChar}PChar{$else}integer{$endif};
TPascalScanner = class
private
type
@ -700,7 +715,7 @@ type
FSkipGlobalSwitches: boolean;
FSkipWhiteSpace: Boolean;
FTokenOptions: TTokenOptions;
FTokenPos: {$ifdef UsePChar}PChar;{$else}integer; { position in FCurLine }{$endif}
FTokenPos: TPasScannerTokenPos; // position in FCurLine }
FIncludeStack: TFPList;
FFiles: TStrings;
FWarnMsgStates: TWarnMsgNumberStateArr;
@ -767,13 +782,15 @@ type
function DoFetchToken: TToken;
procedure ClearFiles;
Procedure ClearMacros;
Procedure SetCurTokenString(AValue: string);
Procedure SetCurToken(const AValue: TToken);
Procedure SetCurTokenString(const AValue: string);
procedure SetCurrentBoolSwitches(const AValue: TBoolSwitches); virtual;
procedure SetCurrentModeSwitches(AValue: TModeSwitches); virtual;
procedure SetCurrentValueSwitch(V: TValueSwitch; const AValue: string);
procedure SetWarnMsgState(Number: integer; State: TWarnMsgState); virtual;
function GetWarnMsgState(Number: integer): TWarnMsgState; virtual;
function LogEvent(E : TPScannerLogEvent) : Boolean; inline;
property TokenPos: TPasScannerTokenPos read FTokenPos write FTokenPos;
public
constructor Create(AFileResolver: TBaseFileResolver);
destructor Destroy; override;
@ -786,7 +803,7 @@ type
procedure UnSetTokenOption(aOption : TTokenoption);
function CheckToken(aToken : TToken; const ATokenString : String) : TToken;
function FetchToken: TToken;
function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken;
function ReadNonPascalTillEndToken(StopAtLineEnd: boolean): TToken; virtual;
function AddDefine(const aName: String; Quiet: boolean = false): boolean;
function RemoveDefine(const aName: String; Quiet: boolean = false): boolean;
function UnDefine(const aName: String; Quiet: boolean = false): boolean; // check defines and macros
@ -1015,7 +1032,8 @@ const
'ARRAYOPERATORS',
'EXTERNALCLASS',
'PREFIXEDATTRIBUTES',
'IGNOREATTRIBUTES'
'IGNOREATTRIBUTES',
'OMITRTTI'
);
LetterSwitchNames: array['A'..'Z'] of string=(
@ -1138,6 +1156,7 @@ function FilenameIsAbsolute(const TheFilename: string):boolean;
function FilenameIsWinAbsolute(const TheFilename: string): boolean;
function FilenameIsUnixAbsolute(const TheFilename: string): boolean;
function IsNamedToken(Const AToken : String; Out T : TToken) : Boolean;
Function ExtractFilenameOnly(Const AFileName : String) : String;
procedure CreateMsgArgs(var MsgArgs: TMessageArgs; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif});
function SafeFormat(const Fmt: string; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif}): string;
@ -1153,6 +1172,13 @@ Var
SortedTokens : array of TToken;
LowerCaseTokens : Array[ttoken] of String;
Function ExtractFilenameOnly(Const AFileName : String) : String;
begin
Result:=ChangeFileExt(ExtractFileName(aFileName),'');
end;
Procedure SortTokenInfo;
Var
@ -2372,7 +2398,45 @@ begin
FStrictFileCase:=AValue;
end;
function TBaseFileResolver.FindIncludeFileName(const AName: string): String;
constructor TBaseFileResolver.Create;
begin
inherited Create;
FIncludePaths := TStringList.Create;
end;
destructor TBaseFileResolver.Destroy;
begin
FIncludePaths.Free;
inherited Destroy;
end;
procedure TBaseFileResolver.AddIncludePath(const APath: string);
Var
FP : String;
begin
if (APath='') then
FIncludePaths.Add('./')
else
begin
{$IFDEF HASFS}
FP:=IncludeTrailingPathDelimiter(ExpandFileName(APath));
{$ELSE}
FP:=APath;
{$ENDIF}
FIncludePaths.Add(FP);
end;
end;
{$IFDEF HASFS}
{ ---------------------------------------------------------------------
TFileResolver
---------------------------------------------------------------------}
function TFileResolver.FindIncludeFileName(const AName: string): String;
function SearchLowUpCase(FN: string): string;
@ -2426,30 +2490,6 @@ begin
end;
end;
constructor TBaseFileResolver.Create;
begin
inherited Create;
FIncludePaths := TStringList.Create;
end;
destructor TBaseFileResolver.Destroy;
begin
FIncludePaths.Free;
inherited Destroy;
end;
procedure TBaseFileResolver.AddIncludePath(const APath: string);
begin
if (APath='') then
FIncludePaths.Add('./')
else
FIncludePaths.Add(IncludeTrailingPathDelimiter(ExpandFileName(APath)));
end;
{ ---------------------------------------------------------------------
TFileResolver
---------------------------------------------------------------------}
function TFileResolver.CreateFileReader(const AFileName: String): TLineReader;
begin
{$ifdef HasStreams}
@ -2488,6 +2528,7 @@ begin
Result:=Nil;
end;
end;
{$ENDIF}
{$ifdef fpc}
{ TStreamResolver }
@ -2642,7 +2683,7 @@ begin
// Dont' free the first element, because it is CurSourceFile
while FIncludeStack.Count > 1 do
begin
TFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif};
TBaseFileResolver(FIncludeStack[1]).{$ifdef pas2js}Destroy{$else}Free{$endif};
FIncludeStack.Delete(1);
end;
FIncludeStack.Clear;
@ -2662,9 +2703,14 @@ begin
FMacros.Clear;
end;
procedure TPascalScanner.SetCurTokenString(AValue: string);
procedure TPascalScanner.SetCurToken(const AValue: TToken);
begin
FCurtokenString:=AValue;
FCurToken:=AValue;
end;
procedure TPascalScanner.SetCurTokenString(const AValue: string);
begin
FCurTokenString:=AValue;
end;
procedure TPascalScanner.OpenFile(AFilename: string);
@ -2673,7 +2719,9 @@ begin
FCurSourceFile := FileResolver.FindSourceFile(AFilename);
FCurFilename := AFilename;
AddFile(FCurFilename);
{$IFDEF HASFS}
FileResolver.BaseDirectory := IncludeTrailingPathDelimiter(ExtractFilePath(FCurFilename));
{$ENDIF}
if LogEvent(sleFile) then
DoLog(mtInfo,nLogOpeningFile,SLogOpeningFile,[FormatPath(AFileName)],True);
end;
@ -2865,9 +2913,10 @@ begin
{$endif}
'''':
begin
// Note: Eventually there should be a mechanism to override parsing non-pascal
// By default skip Pascal string literals, as this is more intuitive in
// IDEs with Pascal highlighters
// Notes:
// 1. Eventually there should be a mechanism to override parsing non-pascal
// 2. By default skip Pascal string literals, as this is more intuitive
// in IDEs with Pascal highlighters
inc(FTokenPos);
repeat
{$ifndef UsePChar}

49
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -238,8 +238,7 @@ type
Procedure TestInt_ForIn;
// strings
Procedure TestChar_Ord;
Procedure TestChar_Chr;
Procedure TestChar_BuiltInProcs;
Procedure TestString_SetLength;
Procedure TestString_Element;
Procedure TestStringElement_MissingArgFail;
@ -316,6 +315,7 @@ type
Procedure TestIncDec;
Procedure TestIncStringFail;
Procedure TestTypeInfo;
Procedure TestTypeInfo_FailRTTIDisabled;
// statements
Procedure TestForLoop;
@ -3158,25 +3158,21 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestChar_Ord;
procedure TTestResolver.TestChar_BuiltInProcs;
begin
StartProgram(false);
Add('var');
Add(' c: char;');
Add(' i: longint;');
Add('begin');
Add(' i:=ord(c);');
ParseProgram;
end;
procedure TTestResolver.TestChar_Chr;
begin
StartProgram(false);
Add('var');
Add(' c: char;');
Add(' i: longint;');
Add('begin');
Add(' c:=chr(i);');
Add([
'var',
' c: char;',
' i: longint;',
'begin',
' i:=ord(c);',
' c:=chr(i);',
' c:=pred(c);',
' c:=succ(c);',
' c:=low(c);',
' c:=high(c);',
'']);
ParseProgram;
end;
@ -4712,6 +4708,21 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestTypeInfo_FailRTTIDisabled;
begin
StartProgram(false);
Add([
'{$modeswitch OmitRTTI}',
'type',
' TObject = class',
' end;',
'var o: TObject;',
'begin',
' if typeinfo(o)=nil then ;',
'']);
CheckResolverException(sSymbolCannotBePublished,nSymbolCannotBePublished);
end;
procedure TTestResolver.TestForLoop;
begin
StartProgram(false);

10
packages/pastojs/fpmake.pp
View File

@ -27,6 +27,7 @@ begin
P.Dependencies.Add('fcl-js');
P.Dependencies.Add('fcl-json');
P.Dependencies.Add('fcl-passrc');
P.Dependencies.Add('fcl-process');
Defaults.Options.Add('-Sc');
P.Author := 'Free Pascal development team';
@ -44,13 +45,16 @@ begin
T:=P.Targets.AddUnit('fppjssrcmap.pp');
T:=P.Targets.AddUnit('pas2jsfilecache.pp');
T:=P.Targets.AddUnit('pas2jsfileutils.pp');
T.Dependencies.AddInclude('pas2js_defines.inc');
T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
T.Dependencies.AddInclude('pas2js_defines.inc');
T.Dependencies.AddInclude('pas2jsfileutilsunix.inc',AllUnixOSes);
T.Dependencies.AddInclude('pas2jsfileutilswin.inc',AllWindowsOSes);
T:=P.Targets.AddUnit('pas2jslogger.pp');
T:=P.Targets.AddUnit('pas2jspparser.pp');
T:=P.Targets.AddUnit('pas2jscompiler.pp');
T:=P.Targets.AddUnit('pas2jspcucompiler.pp');
T.Dependencies.AddUnit('pas2jscompiler');
T:=P.Targets.AddUnit('pas2jslibcompiler.pp');
T.Dependencies.AddUnit('pas2jscompiler');
{$ifndef ALLPACKAGES}
Run;
end;

615
packages/pastojs/src/fppas2js.pp
View File

File diff suppressed because it is too large Load Diff

2351
packages/pastojs/src/pas2jscompiler.pp
View File

File diff suppressed because it is too large Load Diff

867
packages/pastojs/src/pas2jsfilecache.pp
View File

File diff suppressed because it is too large Load Diff

3
packages/pastojs/src/pas2jsfiler.pp
View File

@ -167,7 +167,8 @@ const
'ArrayOperators',
'ExternalClass',
'PrefixedAttributes',
'IgnoreAttributes'
'IgnoreAttributes',
'OmitRTTI'
);
PCUDefaultBoolSwitches: TBoolSwitches = [

228
packages/pastojs/src/pas2jsfileutils.pp
View File

@ -29,7 +29,7 @@ uses
BaseUnix,
{$ENDIF}
{$IFDEF Pas2JS}
NodeJSFS,
JS, NodeJS, NodeJSFS,
{$ENDIF}
SysUtils, Classes;
@ -58,6 +58,7 @@ function ResolveSymLinks(const Filename: string;
{%H-}ExceptionOnError: boolean): string; // if a link is broken returns ''
function MatchGlobbing(Mask, Name: string): boolean;
function FileIsWritable(const AFilename: string): boolean;
function FileIsExecutable(const AFilename: string): boolean;
function GetEnvironmentVariableCountPJ: Integer;
function GetEnvironmentStringPJ(Index: Integer): string;
@ -65,6 +66,8 @@ function GetEnvironmentVariablePJ(const EnvVar: string): String;
function GetNextDelimitedItem(const List: string; Delimiter: char;
var Position: integer): string;
procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
ReadBackslash: boolean = false);
type TChangeStamp = SizeInt;
const InvalidChangeStamp = low(TChangeStamp);
@ -164,6 +167,10 @@ begin
if (Len >= 2) and (Result[2] in AllowDirectorySeparators) then
MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a'
{$ENDIF}
{$IFDEF Pas2js}
if (Len >= 2) and (Result[2]=Result[1]) and (PathDelim='\') then
MinLen := 2; // keep UNC '\\', chomp 'a\' to 'a'
{$ENDIF}
end
else begin
MinLen := 0;
@ -173,6 +180,13 @@ begin
then
MinLen := 3;
{$ENDIF}
{$IFdef Pas2js}
if (PathDelim='\')
and (Len >= 3) and (Result[1] in ['a'..'z', 'A'..'Z'])
and (Result[2] = ':') and (Result[3] in AllowDirectorySeparators)
then
MinLen := 3;
{$ENDIF}
end;
while (Len > MinLen) and (Result[Len] in AllowDirectorySeparators) do dec(Len);
@ -217,16 +231,6 @@ function TryCreateRelativePath(const Filename, BaseDirectory: String;
- Filename = foo/bar BaseDirectory = bar/foo Result = False (no shared base directory)
- Filename = /foo BaseDirectory = bar Result = False (mixed absolute and relative)
}
{$IFDEF Pas2js}
begin
Result:=false;
RelPath:=Filename;
if (BaseDirectory='') or (Filename='') then exit;
{AllowWriteln}
writeln('TryCreateRelativePath ToDo: ',Filename,' Base=',BaseDirectory,' UsePointDirectory=',UsePointDirectory);
{AllowWriteln-}
end;
{$ELSE}
function IsNameChar(c: char): boolean; inline;
begin
Result:=(c<>#0) and not (c in AllowDirectorySeparators);
@ -234,65 +238,71 @@ end;
var
UpDirCount: Integer;
ResultPos: Integer;
i: Integer;
FileNameRestLen, SharedDirs: Integer;
FileP, BaseP, FileEndP, BaseEndP: PChar;
s: string;
SharedDirs: Integer;
FileP, BaseP, FileEndP, BaseEndP, FileL, BaseL: integer;
begin
Result:=false;
RelPath:=Filename;
if (BaseDirectory='') or (Filename='') then exit;
{$IFDEF Windows}
// check for different windows file drives
if (CompareText(ExtractFileDrive(Filename),
ExtractFileDrive(BaseDirectory))<>0)
then
exit;
{$ENDIF}
FileP:=PChar(Filename);
BaseP:=PChar(BaseDirectory);
//writeln('TryCreateRelativePath START File="',FileP,'" Base="',BaseP,'"');
FileP:=1;
FileL:=length(Filename);
BaseP:=1;
BaseL:=length(BaseDirectory);
// skip matching directories
SharedDirs:=0;
if FileP^ in AllowDirectorySeparators then
if Filename[FileP] in AllowDirectorySeparators then
begin
if not (BaseP^ in AllowDirectorySeparators) then exit;
if not (BaseDirectory[BaseP] in AllowDirectorySeparators) then exit;
repeat
while FileP^ in AllowDirectorySeparators do inc(FileP);
while BaseP^ in AllowDirectorySeparators do inc(BaseP);
if (FileP^=#0) or (BaseP^=#0) then break;
//writeln('TryCreateRelativePath check match .. File="',FileP,'" Base="',BaseP,'"');
while (FileP<=FileL) and (Filename[FileP] in AllowDirectorySeparators) do
inc(FileP);
while (BaseP<=BaseL) and (BaseDirectory[BaseP] in AllowDirectorySeparators) do
inc(BaseP);
if (FileP>FileL) or (BaseP>BaseL) then break;
//writeln('TryCreateRelativePath check match .. File="',copy(Filename,FileP),'" Base="',copy(BaseDirectory,BaseP),'"');
FileEndP:=FileP;
BaseEndP:=BaseP;
while IsNameChar(FileEndP^) do inc(FileEndP);
while IsNameChar(BaseEndP^) do inc(BaseEndP);
if CompareFilenames(copy(Filename,FileP-PChar(Filename)+1,FileEndP-FileP),
copy(BaseDirectory,BaseP-PChar(BaseDirectory)+1,BaseEndP-BaseP))<>0
while (FileEndP<=FileL) and IsNameChar(Filename[FileEndP]) do inc(FileEndP);
while (BaseEndP<=BaseL) and IsNameChar(BaseDirectory[BaseEndP]) do inc(BaseEndP);
if CompareFilenames(copy(Filename,FileP,FileEndP-FileP),
copy(BaseDirectory,BaseP,BaseEndP-BaseP))<>0
then
break;
FileP:=FileEndP;
BaseP:=BaseEndP;
inc(SharedDirs);
until false;
end else if (BaseP^ in AllowDirectorySeparators) then
end else if (BaseDirectory[BaseP] in AllowDirectorySeparators) then
exit;
//writeln('TryCreateRelativePath skipped matches File="',FileP,'" Base="',BaseP,'"');
//writeln('TryCreateRelativePath skipped matches SharedDirs=',SharedDirs,' File="',copy(Filename,FileP),'" Base="',copy(BaseDirectory,BaseP),'"');
if SharedDirs=0 then exit;
// calculate needed '../'
UpDirCount:=0;
BaseEndP:=BaseP;
while IsNameChar(BaseEndP^) do begin
while (BaseEndP<=BaseL) and IsNameChar(BaseDirectory[BaseEndP]) do begin
inc(UpDirCount);
while IsNameChar(BaseEndP^) do inc(BaseEndP);
while BaseEndP^ in AllowDirectorySeparators do inc(BaseEndP);
while (BaseEndP<=BaseL) and IsNameChar(BaseDirectory[BaseEndP]) do
inc(BaseEndP);
while (BaseEndP<=BaseL) and (BaseDirectory[BaseEndP] in AllowDirectorySeparators) do
inc(BaseEndP);
end;
//writeln('TryCreateRelativePath UpDirCount=',UpDirCount,' File="',FileP,'" Base="',BaseP,'"');
//writeln('TryCreateRelativePath UpDirCount=',UpDirCount,' File="',copy(Filename,FileP),'" Base="',copy(BaseDirectory,BaseP),'"');
// create relative filename
if (FileP^=#0) and (UpDirCount=0) then
if (FileP>FileL) and (UpDirCount=0) then
begin
// Filename is the BaseDirectory
if UsePointDirectory then
@ -302,34 +312,23 @@ begin
exit(true);
end;
FileNameRestLen:=length(Filename)-(FileP-PChar(Filename));
SetLength(RelPath,3*UpDirCount+FileNameRestLen);
ResultPos:=1;
for i:=1 to UpDirCount do begin
RelPath[ResultPos]:='.';
RelPath[ResultPos+1]:='.';
RelPath[ResultPos+2]:=PathDelim;
inc(ResultPos,3);
end;
if FileNameRestLen>0 then
Move(FileP^,RelPath[ResultPos],FileNameRestLen);
s:='';
for i:=1 to UpDirCount do
s+='..'+PathDelim;
if (FileP>FileL) and (UpDirCount>0) then
s:=LeftStr(s,length(s)-1)
else
s+=copy(Filename,FileP);
RelPath:=s;
Result:=true;
end;
{$ENDIF}
function ResolveDots(const AFilename: string): string;
//trim double path delims and expand special dirs like .. and .
//on Windows change also '/' to '\' except for filenames starting with '\\?\'
{$IFDEF Pas2js}
var
Len: Integer;
begin
Len:=length(AFilename);
if Len=0 then exit('');
Result:=AFilename;
{AllowWriteln}
writeln('ResolveDots ToDo ',AFilename);
{AllowWriteln-}
Result:=NJS_Path.resolve(AFilename);
end;
{$ELSE}
@ -592,12 +591,20 @@ begin
end;
function CompareFilenames(const File1, File2: string): integer;
{$IFDEF Pas2js}
var
a, b: string;
{$ENDIF}
begin
{$IFDEF Pas2js}
{AllowWriteln}
writeln('CompareFilenames ToDo ',File1,' ',File2);
{AllowWriteln-}
raise Exception.Create('CompareFilenames ToDo');
a:=FilenameToKey(File1);
b:=FilenameToKey(File2);
if a<b then
exit(-1)
else if a>b then
exit(1)
else
exit(0);
Result:=0;
{$ELSE}
Result:=AnsiCompareFileName(File1,File2);
@ -608,8 +615,19 @@ end;
function FilenameToKey(const Filename: string): string;
begin
{$IFDEF Pas2js}
Result:=Filename;
// ToDo lowercase on windows, normalize on darwin
case NJS_OS.platform of
'darwin':
{$IF ECMAScript>5}
Result:=TJSString(Filename).normalize('NFD');
{$ELSE}
begin
Result:=Filename;
raise Exception.Create('pas2jsfileutils FilenameToKey requires ECMAScript6 "normalize" under darwin');
end;
{$ENDIF}
'win32': Result:=lowercase(Filename);
else Result:=Filename;
end;
{$ELSE}
{$IFDEF Windows}
Result:=AnsiLowerCase(Filename);
@ -629,6 +647,7 @@ function MatchGlobbing(Mask, Name: string): boolean;
{$IFDEF Pas2js}
begin
if Mask='' then exit(Name='');
if Mask='*' then exit(true);
{AllowWriteln}
writeln('MatchGlobbing ToDo ',Mask,' Name=',Name);
{AllowWriteln-}
@ -713,6 +732,93 @@ begin
if Position<=length(List) then inc(Position); // skip Delimiter
end;
procedure SplitCmdLineParams(const Params: string; ParamList: TStrings;
ReadBackslash: boolean = false);
// split spaces, quotes are parsed as single parameter
// if ReadBackslash=true then \" is replaced to " and not treated as quote
// #0 is always end
type
TMode = (mNormal,mApostrophe,mQuote);
var
p: Integer;
Mode: TMode;
Param: String;
begin
p:=1;
while p<=length(Params) do
begin
// skip whitespace
while (p<=length(Params)) and (Params[p] in [' ',#9,#10,#13]) do inc(p);
if (p>length(Params)) or (Params[p]=#0) then
break;
// read param
Param:='';
Mode:=mNormal;
while p<=length(Params) do
begin
case Params[p] of
#0:
break;
'\':
begin
inc(p);
if ReadBackslash then
begin
// treat next character as normal character
if (p>length(Params)) or (Params[p]=#0) then
break;
if ord(Params[p])<128 then
begin
Param+=Params[p];
inc(p);
end else begin
// next character is already a normal character
end;
end else begin
// treat backslash as normal character
Param+='\';
end;
end;
'''':
begin
inc(p);
case Mode of
mNormal:
Mode:=mApostrophe;
mApostrophe:
Mode:=mNormal;
mQuote:
Param+='''';
end;
end;
'"':
begin
inc(p);
case Mode of
mNormal:
Mode:=mQuote;
mApostrophe:
Param+='"';
mQuote:
Mode:=mNormal;
end;
end;
' ',#9,#10,#13:
begin
if Mode=mNormal then break;
Param+=Params[p];
inc(p);
end;
else
Param+=Params[p];
inc(p);
end;
end;
//writeln('SplitCmdLineParams Param=#'+Param+'#');
ParamList.Add(Param);
end;
end;
procedure IncreaseChangeStamp(var Stamp: TChangeStamp);
begin
if Stamp<High(TChangeStamp) then

84
packages/pastojs/src/pas2jsfileutilsnodejs.inc
View File

@ -17,11 +17,7 @@
function FilenameIsAbsolute(const aFilename: string): boolean;
begin
{AllowWriteln}
writeln('FilenameIsAbsolute ToDo ',aFilename);
{AllowWriteln-}
Result:=FilenameIsUnixAbsolute(aFilename);
raise Exception.Create('FilenameIsAbsolute ToDo');
Result:=NJS_Path.isAbsolute(aFilename);
end;
function ExpandFileNamePJ(const FileName: string; BaseDir: string): string;
@ -29,8 +25,7 @@ var
IsAbs: Boolean;
HomeDir, Fn: String;
begin
Fn := FileName;
ForcePathDelims(Fn);
Fn := GetForcedPathDelims(Filename);
IsAbs := FileNameIsUnixAbsolute(Fn);
if (not IsAbs) then
begin
@ -63,11 +58,7 @@ end;
function GetCurrentDirPJ: String;
begin
{AllowWriteln}
writeln('GetCurrentDirPJ ToDo');
{AllowWriteln-}
Result:='';
raise Exception.Create('GetCurrentDirPJ ToDo');
Result:=GetCurrentDir;
end;
function GetPhysicalFilename(const Filename: string; ExceptionOnError: boolean
@ -103,21 +94,72 @@ end;
function ResolveSymLinks(const Filename: string; ExceptionOnError: boolean
): string;
var
LinkFilename: string;
AText: string;
Depth: Integer;
begin
{AllowWriteln}
writeln('ResolveSymLinks ToDo ',Filename,' ',ExceptionOnError);
{AllowWriteln-}
Result:=Filename;
raise Exception.Create('ResolveSymLinks ToDo');
Depth:=0;
while Depth<12 do
begin
inc(Depth);
try
LinkFilename:=NJS_FS.readlinkSync(Result);
except
if not ExceptionOnError then
exit;
if isString(JSExceptValue) then
AText:=String(JSExceptValue)
else if isObject(JSExceptValue) and isString(TJSObject(JSExceptValue)['message']) then
begin
if TJSObject(JSExceptValue)['code']='EINVAL' then
begin
// not a symbolic link
exit;
end;
AText:=String(TJSObject(JSExceptValue)['message']);
end else
AText:='uknown error ('+jsTypeOf(JSExceptValue)+')';
if Pos(Filename,AText)<1 then
AText+=' "'+Filename+'"';
raise EFOpenError.Create(AText);
end;
if LinkFilename='' then
begin
// not a symbolic link, just a regular file
exit;
end;
if not FilenameIsAbsolute(LinkFilename) then
Result:=ExtractFilePath(Result)+LinkFilename
else
Result:=LinkFilename;
end;
// probably an endless loop
if ExceptionOnError then
raise EFOpenError.Create('too many links, maybe an endless loop.')
else
Result:='';
end;
function FileIsWritable(const AFilename: string): boolean;
begin
{AllowWriteln}
writeln('FileIsWritable ToDo ',AFilename);
{AllowWriteln-}
Result := false;
raise Exception.Create('FileIsWritable ToDo');
try
NJS_FS.accessSync(AFilename,W_OK);
except
exit(false);
end;
Result:=true;
end;
function FileIsExecutable(const AFilename: string): boolean;
begin
try
NJS_FS.accessSync(AFilename,X_OK);
except
exit(false);
end;
Result:=true;
end;
function GetEnvironmentVariableCountPJ: Integer;

9
packages/pastojs/src/pas2jsfileutilsunix.inc
View File

@ -148,6 +148,15 @@ begin
Result := BaseUnix.FpAccess(AFilename, BaseUnix.W_OK) = 0;
end;
function FileIsExecutable(const AFilename: string): boolean;
var
Info : Stat;
begin
// first check AFilename is not a directory and then check if executable
Result:= (FpStat(AFilename,info{%H-})<>-1) and FPS_ISREG(info.st_mode) and
(BaseUnix.FpAccess(AFilename,BaseUnix.X_OK)=0);
end;
function GetEnvironmentVariableCountPJ: Integer;
begin
Result:=GetEnvironmentVariableCount;

5
packages/pastojs/src/pas2jsfileutilswin.inc
View File

@ -421,6 +421,11 @@ begin
Result:=((FileGetAttrUTF8(AFilename) and faReadOnly) = 0);
end;
function FileIsExecutable(const AFilename: string): boolean;
begin
Result:=FileExists(AFilename);
end;
function GetEnvironmentVariableCountPJ: Integer;
var
hp,p : PWideChar;

21
packages/pastojs/src/pas2jslogger.pp
View File

@ -42,6 +42,7 @@ const
ExitCodeSyntaxError = 6;
ExitCodeConverterError = 7;
ExitCodePCUError = 8;
ExitCodeToolError = 9;
const
DefaultLogMsgTypes = [mtFatal..mtDebug]; // by default show everything
@ -148,9 +149,7 @@ type
UseFilter: boolean = true);
procedure LogMsgIgnoreFilter(MsgNumber: integer;
Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF});
{$IFDEF FPC}
procedure LogExceptionBackTrace;
{$ENDIF}
procedure LogExceptionBackTrace(E: Exception);
function MsgTypeToStr(MsgType: TMessageType): string;
function GetMsgText(MsgNumber: integer;
Args: array of {$IFDEF Pas2JS}jsvalue{$ELSE}const{$ENDIF}): string;
@ -421,7 +420,7 @@ begin
jstNull: Result:='null';
jstBoolean: Result:=BoolToStr(Element.AsBoolean,'true','false');
jstNumber: str(Element.AsNumber,Result);
jstString: Result:=QuoteStr(Element.AsString{%H-},'''');
jstString: Result:=QuoteStr(String(Element.AsString),'''');
jstObject: Result:='{:OBJECT:}';
jstReference: Result:='{:REFERENCE:}';
JSTCompletion: Result:='{:COMPLETION:}';
@ -921,8 +920,17 @@ begin
LogMsg(MsgNumber,Args,'',0,0,false);
end;
{$IFDEF FPC}
procedure TPas2jsLogger.LogExceptionBackTrace;
procedure TPas2jsLogger.LogExceptionBackTrace(E: Exception);
{$IFDEF Pas2js}
begin
{$IFDEF NodeJS}
if (E<>nil) and (E.NodeJSError<>nil) then
{AllowWriteln}
writeln(E.NodeJSError.Stack);
{AllowWriteln-}
{$ENDIF}
end;
{$ELSE}
var
lErrorAddr: CodePointer;
FrameCount: LongInt;
@ -935,6 +943,7 @@ begin
Log(mtDebug,BackTraceStrFunc(lErrorAddr));
for FrameNumber := 0 to FrameCount-1 do
Log(mtDebug,BackTraceStrFunc(Frames[FrameNumber]));
if E=nil then ;
end;
{$ENDIF}

431
packages/pastojs/src/pas2jspcucompiler.pp Normal file
View File

@ -0,0 +1,431 @@
unit pas2jspcucompiler;
{$mode objfpc}{$H+}
{$I pas2js_defines.inc}
{$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
{$DEFINE ReallyVerbose}
{$ENDIF}
interface
uses
Classes, SysUtils, pastree, pas2jscompiler, Pas2JsFiler;
Type
{ TFilerPCUSupport }
TFilerPCUSupport = Class(TPCUSupport)
Private
// This is the format that will be written.
FPCUFormat : TPas2JSPrecompileFormat;
// This is the format that will be read.
FFoundFormat : TPas2JSPrecompileFormat;
FPrecompileInitialFlags: TPCUInitialFlags;
FPCUReader: TPCUCustomReader;
FPCUReaderStream: TStream;
function OnPCUConverterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
function OnPCUConverterIsTypeInfoUsed(Sender: TObject; El: TPasElement): boolean;
function OnWriterIsElementUsed(Sender: TObject; El: TPasElement): boolean;
procedure OnFilerGetSrc(Sender: TObject; aFilename: string; out p: PChar; out Count: integer);
Public
constructor create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
Destructor destroy; override;
Function Compiler : TPas2JSCompiler;
Function HandleException(E: exception) : Boolean; override;
function FindPCU(const UseUnitName: string): string;override;
function FindPCU(const UseUnitName: string; out aFormat: TPas2JSPrecompileFormat): string;
Function HasReader : Boolean; override;
Function ReadContinue: Boolean; override;
Function ReadCanContinue : Boolean; override;
Procedure SetInitialCompileFlags; override;
Procedure WritePCU; override;
procedure CreatePCUReader; override;
Procedure ReadUnit; override;
property PrecompileInitialFlags: TPCUInitialFlags read FPrecompileInitialFlags;
end;
{ TPas2jsPCUCompiler }
{ TPas2jsPCUCompilerFile }
TPas2jsPCUCompilerFile = Class(TPas2jsCompilerFile)
Function CreatePCUSupport: TPCUSupport; override;
end;
TPas2jsPCUCompiler = Class(TPas2JSCompiler)
FPrecompileFormat : TPas2JSPrecompileFormat;
Protected
procedure WritePrecompiledFormats; override;
function CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile; override;
Procedure HandleOptionPCUFormat(Value : string) ; override;
end;
implementation
uses fppas2js, pscanner, pas2jslogger, pas2jsfilecache, pasresolveeval, jstree, pas2jsfileutils;
{ ---------------------------------------------------------------------
TFilerPCUSupport
---------------------------------------------------------------------}
{ TFilerPCUSupport }
constructor TFilerPCUSupport.create(aCompilerFile: TPas2JSCompilerFile; aFormat: TPas2JSPrecompileFormat);
begin
Inherited Create(aCompilerFile);
FPCUFormat:=AFormat;
FPrecompileInitialFlags:=TPCUInitialFlags.Create;
end;
destructor TFilerPCUSupport.destroy;
begin
FreeAndNil(FPrecompileInitialFlags);
FreeAndNil(FPCUReader);
FreeAndNil(FPCUReaderStream);
inherited destroy;
end;
function TFilerPCUSupport.Compiler: TPas2JSCompiler;
begin
Result:=MyFile.Compiler;
end;
Function TFilerPCUSupport.HandleException(E: Exception) : Boolean;
begin
Result:=False;
if E is EPas2JsReadError then
begin
Result:=True;
if EPas2JsReadError(E).Owner is TPCUCustomReader then
begin
MyFile.Log.Log(mtError,E.Message,0,MyFile.PCUFilename);
end else begin
MyFile.Log.Log(mtError,E.Message);
end;
Compiler.Terminate(ExitCodePCUError);
end
else if (E is EPas2JsWriteError) then
begin
MyFile.Log.Log(mtFatal,E.ClassName+':'+E.Message);
Compiler.Terminate(ExitCodeErrorInternal);
Result:=True;
end
end;
function TFilerPCUSupport.FindPCU(const UseUnitName: string): string;
begin
Result:=FindPCU(UseUnitName,FFoundFormat);
end;
function TFilerPCUSupport.HasReader: Boolean;
begin
Result:=Assigned(FPCUReader);
end;
function TFilerPCUSupport.ReadContinue: Boolean;
begin
Result:=FPCUReader.ReadContinue;
end;
function TFilerPCUSupport.ReadCanContinue: Boolean;
begin
Result:=FPCUReader.ReadCanContinue;
end;
procedure TFilerPCUSupport.SetInitialCompileFlags;
begin
PrecompileInitialFlags.ParserOptions:=MyFile.Parser.Options;
PrecompileInitialFlags.ModeSwitches:=MyFile.Scanner.CurrentModeSwitches;
PrecompileInitialFlags.BoolSwitches:=MyFile.Scanner.CurrentBoolSwitches;
PrecompileInitialFlags.ConverterOptions:=MyFile.GetInitialConverterOptions;
PrecompileInitialFlags.TargetPlatform:=Compiler.TargetPlatform;
PrecompileInitialFlags.TargetProcessor:=Compiler.TargetProcessor;
end;
procedure TFilerPCUSupport.CreatePCUReader;
var
aFile: TPas2jsCachedFile;
s: String;
begin
if MyFile.PCUFilename='' then
RaiseInternalError(20180312144742,MyFile.PCUFilename);
if FPCUReader<>nil then
RaiseInternalError(20180312142938,GetObjName(FPCUReader));
if FFoundFormat=nil then
RaiseInternalError(20180312142954,'');
FPCUReader:=FFoundFormat.ReaderClass.Create;
FPCUReader.SourceFilename:=ExtractFileName(MyFile.PCUFilename);
if MyFile.ShowDebug then
MyFile.Log.LogMsg(nParsingFile,[QuoteStr(MyFile.PCUFilename)]);
aFile:=Compiler.FileCache.LoadFile(MyFile.PCUFilename,true);
if aFile=nil then
RaiseInternalError(20180312145941,MyFile.PCUFilename);
FPCUReaderStream:=TMemoryStream.Create;
s:=aFile.Source;
//writeln('TPas2jsCompilerFile.CreatePCUReader ',PCUFilename,'-----START-----');
//writeln(s);
//writeln('TPas2jsCompilerFile.CreatePCUReader ',PCUFilename,'-----END-------');
if s<>'' then
begin
FPCUReaderStream.Write(s[1],length(s));
FPCUReaderStream.Position:=0;
end;
end;
procedure TFilerPCUSupport.ReadUnit;
begin
FPCUReader.ReadPCU(MyFile.PascalResolver,FPCUReaderStream);
SetPasModule(MyFile.PascalResolver.RootElement);
SetReaderState(prsCanContinue);
end;
function TFilerPCUSupport.FindPCU(const UseUnitName: string; out aFormat: TPas2JSPrecompileFormat): string;
function SearchInDir(DirPath: string): boolean;
var
i: Integer;
CurFormat: TPas2JSPrecompileFormat;
Filename: String;
begin
if DirPath='' then exit(false);
DirPath:=IncludeTrailingPathDelimiter(DirPath);
for i:=0 to PrecompileFormats.Count-1 do
begin
CurFormat:=PrecompileFormats[i];
if not CurFormat.Enabled then continue;
Filename:=DirPath+UseUnitName+'.'+CurFormat.Ext;
if Compiler.FileCache.SearchLowUpCase(Filename) then
begin
FindPCU:=Filename;
aFormat:=CurFormat;
exit(true);
end;
end;
Result:=false;
end;
var
Cache: TPas2jsFilesCache;
i: Integer;
begin
Result:='';
aFormat:=nil;
Cache:=Compiler.FileCache;
// search in output directory
if Cache.UnitOutputPath<>'' then
if SearchInDir(Cache.UnitOutputPath) then exit;
// then in BaseDirectory
if SearchInDir(MyFile.FileResolver.BaseDirectory) then exit;
// finally search in unit paths
for i:=0 to Cache.UnitPaths.Count-1 do
if SearchInDir(Cache.UnitPaths[i]) then exit;
end;
function TFilerPCUSupport.OnWriterIsElementUsed(Sender: TObject;
El: TPasElement): boolean;
begin
Result:=MyFile.UseAnalyzer.IsUsed(El);
end;
procedure TFilerPCUSupport.WritePCU;
Const
AllowCompressed =
{$IFDEF DisablePCUCompressed}false{$ELSE}true{$ENDIF};
var
Writer: TPCUWriter;
ms: TMemoryStream;
DestDir: String;
JS: TJSElement;
FN : String;
begin
if FPCUFormat=Nil then
exit; // Don't write
if MyFile.PasModule.ClassType<>TPasModule then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU not a unit: ',MyFile.PasFilename,' skip');
{$ENDIF}
exit;
end;
if (MyFile.PCUFilename<>'') or (FPCUReader<>nil) then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU already precompiled "',MyFile.PCUFilename,'" Reader=',GetObjName(FPCUReader));
{$ENDIF}
exit;
end;
// Determine output filename
FN:=ExtractFilenameOnly(MyFile.PasFilename)+'.'+FPCUFormat.Ext;
if Compiler.FileCache.UnitOutputPath<>'' then
FN:=Compiler.FileCache.UnitOutputPath+FN
else
FN:=ExtractFilePath(MyFile.PasFilename)+FN;
// Set as our filename
SetPCUFilename(FN);
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU precompiling ',MyFile.PCUFilename);
{$ENDIF}
JS:=nil;
ms:=TMemoryStream.Create;
Writer:=FPCUFormat.WriterClass.Create;
try
Writer.GUID:=Compiler.PrecompileGUID;
Writer.OnGetSrc:=@OnFilerGetSrc;
Writer.OnIsElementUsed:=@OnWriterIsElementUsed;
// create JavaScript for procs, initialization, finalization
MyFile.CreateConverter;
MyFile.Converter.Options:=MyFile.Converter.Options+[coStoreImplJS];
MyFile.Converter.OnIsElementUsed:=@OnPCUConverterIsElementUsed;
MyFile.Converter.OnIsTypeInfoUsed:=@OnPCUConverterIsTypeInfoUsed;
JS:=MyFile.Converter.ConvertPasElement(MyFile.PasModule,MyFile.PascalResolver);
MyFile.Converter.Options:=MyFile.Converter.Options-[coStoreImplJS];
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU create pcu ... ',MyFile.PCUFilename);
{$ENDIF}
Writer.WritePCU(MyFile.PascalResolver,MyFile.Converter,PrecompileInitialFlags,ms,AllowCompressed);
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU precompiled ',MyFile.PCUFilename);
{$ENDIF}
MyFile.Log.LogMsg(nWritingFile,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))],'',0,0,
not (coShowLineNumbers in Compiler.Options));
// check output directory
DestDir:=ChompPathDelim(ExtractFilePath(MyFile.PCUFilename));
if (DestDir<>'') and not Compiler.FileCache.DirectoryExists(DestDir) then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU output dir not found "',DestDir,'"');
{$ENDIF}
MyFile.Log.LogMsg(nOutputDirectoryNotFound,[QuoteStr(Compiler.FileCache.FormatPath(DestDir))]);
Compiler.Terminate(ExitCodeFileNotFound);
end;
if Compiler.FileCache.DirectoryExists(MyFile.PCUFilename) then
begin
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU file is folder "',DestDir,'"');
{$ENDIF}
MyFile.Log.LogMsg(nFileIsFolder,[QuoteStr(Compiler.FileCache.FormatPath(MyFile.PCUFilename))]);
Compiler.Terminate(ExitCodeWriteError);
end;
ms.Position:=0;
Compiler.FileCache.SaveToFile(ms,MyFile.PCUFilename);
{$IFDEF REALLYVERBOSE}
writeln('TPas2jsCompilerFile.WritePCU written ',MyFile.PCUFilename);
{$ENDIF}
finally
JS.Free;
Writer.Free;
ms.Free;
end;
end;
procedure TFilerPCUSupport.OnFilerGetSrc(Sender: TObject; aFilename: string;
out p: PChar; out Count: integer);
var
SrcFile: TPas2jsCachedFile;
begin
if Sender=nil then
RaiseInternalError(20180311135558,aFilename);
SrcFile:=MyFile.Compiler.FileCache.LoadFile(aFilename);
if SrcFile=nil then
RaiseInternalError(20180311135329,aFilename);
p:=PChar(SrcFile.Source);
Count:=length(SrcFile.Source);
end;
function TFilerPCUSupport.OnPCUConverterIsElementUsed(Sender: TObject;
El: TPasElement): boolean;
begin
if (coKeepNotUsedPrivates in MyFile.Compiler.Options) then
Result:=true
else
Result:=MyFile.UseAnalyzer.IsUsed(El);
end;
function TFilerPCUSupport.OnPCUConverterIsTypeInfoUsed(Sender: TObject;
El: TPasElement): boolean;
begin
if Sender=nil then ;
if El=nil then ;
// PCU does not need precompiled typeinfo
Result:=false;
end;
{ TPas2jsPCUCompiler }
procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
Var
I : Integer;
begin
if PrecompileFormats.Count>0 then
begin
writeHelpLine(' -JU<x> : Create precompiled units in format x.');
for i:=0 to PrecompileFormats.Count-1 do
with PrecompileFormats[i] do
writeHelpLine(' -JU'+Ext+' : '+Description);
writeHelpLine(' -JU- : Disable prior -JU<x> option. Do not create precompiled units.');
end;
end;
function TPas2jsPCUCompiler.CreateCompilerFile(const UnitFileName: String): TPas2jsCompilerFile;
begin
Result:=TPas2JSPCUCompilerFile.Create(Self,UnitFileName);
end;
procedure TPas2jsPCUCompiler.HandleOptionPCUFormat(Value: string);
Var
Found : Boolean;
I : integer;
PF: TPas2JSPrecompileFormat;
begin
Found:=false;
for i:=0 to PrecompileFormats.Count-1 do
begin
PF:=PrecompileFormats[i];
if not SameText(Value,PF.Ext) then continue;
FPrecompileFormat:=PrecompileFormats[i];
Found:=true;
end;
if not Found then
ParamFatal('invalid precompile output format (-JU) "'+Value+'"');
end;
{ TPas2jsPCUCompilerFile }
function TPas2jsPCUCompilerFile.CreatePCUSupport: TPCUSupport;
Var
PF: TPas2JSPrecompileFormat;
begin
// Note that if no format was preset, no files will be written
PF:=(Compiler as TPas2jsPCUCompiler).FPrecompileFormat;
if PF<>Nil then
Result:=TFilerPCUSupport.Create(Self,PF)
else
Result:=Nil;
end;
end.

92
packages/pastojs/src/pas2jspparser.pp
View File

@ -34,23 +34,6 @@ const // Messages
type
{ TPas2jsPasScanner }
TPas2jsPasScanner = class(TPascalScanner)
private
FCompilerVersion: string;
FResolver: TPas2JSResolver;
FTargetPlatform: TPasToJsPlatform;
FTargetProcessor: TPasToJsProcessor;
protected
function HandleInclude(const Param: String): TToken; override;
public
property CompilerVersion: string read FCompilerVersion write FCompilerVersion;
property Resolver: TPas2JSResolver read FResolver write FResolver;
property TargetPlatform: TPasToJsPlatform read FTargetPlatform write FTargetPlatform;
property TargetProcessor: TPasToJsProcessor read FTargetProcessor write FTargetProcessor;
end;
{ TPas2jsPasParser }
TPas2jsPasParser = class(TPasParser)
@ -123,81 +106,6 @@ begin
r(mtError,nFinalizationNotSupported,sFinalizationNotSupported);
end;
{ TPas2jsPasScanner }
function TPas2jsPasScanner.HandleInclude(const Param: String): TToken;
procedure SetStr(const s: string);
begin
Result:=tkString;
SetCurTokenString(''''+s+'''');
end;
var
Year, Month, Day, Hour, Minute, Second, MilliSecond: word;
i: Integer;
Scope: TPasScope;
begin
if (Param<>'') and (Param[1]='%') then
begin
case lowercase(Param) of
'%date%':
begin
DecodeDate(Now,Year,Month,Day);
SetStr('['+IntToStr(Year)+'/'+IntToStr(Month)+'/'+IntToStr(Day)+']');
exit;
end;
'%time%':
begin
DecodeTime(Now,Hour,Minute,Second,MilliSecond);
SetStr(Format('%2d:%2d:%2d',[Hour,Minute,Second]));
exit;
end;
'%pas2jstarget%','%fpctarget%',
'%pas2jstargetos%','%fpctargetos%':
begin
SetStr(PasToJsPlatformNames[TargetPlatform]);
exit;
end;
'%pas2jstargetcpu%','%fpctargetcpu%':
begin
SetStr(PasToJsProcessorNames[TargetProcessor]);
exit;
end;
'%pas2jsversion%','%fpcversion%':
begin
SetStr(CompilerVersion);
exit;
end;
'%line%':
begin
SetStr(IntToStr(CurRow));
exit;
end;
'%currentroutine%':
begin
if Resolver<>nil then
for i:=Resolver.ScopeCount-1 downto 0 do
begin
Scope:=Resolver.Scopes[i];
if (Scope.Element is TPasProcedure)
and (Scope.Element.Name<>'') then
begin
SetStr(Scope.Element.Name);
exit;
end;
end;
SetStr('<anonymous>');
exit;
end;
else
DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,SWarnIllegalCompilerDirectiveX,
['$i '+Param]);
end;
end;
Result:=inherited HandleInclude(Param);
end;
{ TPas2jsPasParser }
constructor TPas2jsPasParser.Create(AScanner: TPascalScanner;

2
packages/pastojs/tests/tcfiler.pas
View File

@ -25,7 +25,7 @@ interface
uses
Classes, SysUtils, fpcunit, testregistry,
PasTree, PScanner, PasResolver, PasResolveEval, PParser, PasUseAnalyzer,
FPPas2Js, Pas2JsFiler, Pas2jsPParser,
FPPas2Js, Pas2JsFiler,
tcmodules, jstree;
type

730
packages/pastojs/tests/tcmodules.pas
View File

File diff suppressed because it is too large Load Diff

7
packages/pastojs/tests/tcunitsearch.pas
View File

@ -221,11 +221,10 @@ begin
{$ENDIF}
inherited SetUp;
FDefaultFileAge:=DateTimeToFileDate(Now);
WorkDir:=ExtractFilePath(ParamStr(0));
{$IFDEF Windows}
WorkDir:='P:\test';
CompilerExe:='P:\bin\pas2js.exe';
{$ELSE}
WorkDir:='/home/user';
CompilerExe:='/usr/bin/pas2js';
{$ENDIF}
FCompiler:=TTestCompiler.Create;
@ -684,7 +683,7 @@ begin
' a:=b;',
'end.']);
Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
AssertEquals('ErrorMsg','Duplicate file found: "/home/user/sub/unit1.pas" and "/home/user/unit1.pas"',ErrorMsg);
AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'sub/unit1.pas" and "'+WorkDir+'unit1.pas"',ErrorMsg);
end;
procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
@ -704,7 +703,7 @@ begin
'begin',
'end.']);
Compile(['test1.pas','-Jc'],ExitCodeSyntaxError);
AssertEquals('ErrorMsg','Duplicate file found: "/home/user/unit1.pas" and "/home/user/sub/unit1.pas"',ErrorMsg);
AssertEquals('ErrorMsg','Duplicate file found: "'+WorkDir+'unit1.pas" and "'+WorkDir+'sub/unit1.pas"',ErrorMsg);
end;
Initialization

12
packages/pastojs/tests/testpas2js.lpi
View File

@ -19,9 +19,16 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<CommandLineParams Value="--suite=TTestCLI_UnitSearch"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
<Mode0 Name="default">
<local>
<CommandLineParams Value="--suite=TTestCLI_UnitSearch"/>
</local>
</Mode0>
</Modes>
</RunParams>
<RequiredPackages Count="2">
@ -103,9 +110,6 @@
</CodeGeneration>
<Other>
<CustomOptions Value="-dVerbosePas2JS"/>
<OtherDefines Count="1">
<Define0 Value="VerbosePas2JS"/>
</OtherDefines>
</Other>
</CompilerOptions>
<Debugging>

27
utils/pas2js/dist/rtl.js vendored
View File

@ -279,8 +279,8 @@ var rtl = {
o.AfterConstruction();
} catch($e){
// do not call BeforeDestruction
if (this.Destroy) this.Destroy();
this.$final();
if (o.Destroy) o.Destroy();
o.$final();
throw $e;
}
return o;
@ -314,8 +314,8 @@ var rtl = {
if (o.AfterConstruction) o.AfterConstruction();
} catch($e){
// do not call BeforeDestruction
if (this.Destroy) this.Destroy();
if (this.$final) this.$final();
if (o.Destroy) o.Destroy();
if (o.$final) this.$final();
throw $e;
}
return o;
@ -853,7 +853,12 @@ var rtl = {
},
refSet: function(s){
s.$shared = true;
Object.defineProperty(s, '$shared', {
enumerable: false,
configurable: true,
writable: true,
value: true
});
return s;
},
@ -872,7 +877,6 @@ var rtl = {
diffSet: function(s,t){
var r = {};
for (var key in s) if (!t[key]) r[key]=true;
delete r.$shared;
return r;
},
@ -880,14 +884,12 @@ var rtl = {
var r = {};
for (var key in s) r[key]=true;
for (var key in t) r[key]=true;
delete r.$shared;
return r;
},
intersectSet: function(s,t){
var r = {};
for (var key in s) if (t[key]) r[key]=true;
delete r.$shared;
return r;
},
@ -895,13 +897,12 @@ var rtl = {
var r = {};
for (var key in s) if (!t[key]) r[key]=true;
for (var key in t) if (!s[key]) r[key]=true;
delete r.$shared;
return r;
},
eqSet: function(s,t){
for (var key in s) if (!t[key] && (key!='$shared')) return false;
for (var key in t) if (!s[key] && (key!='$shared')) return false;
for (var key in s) if (!t[key]) return false;
for (var key in t) if (!s[key]) return false;
return true;
},
@ -910,12 +911,12 @@ var rtl = {
},
leSet: function(s,t){
for (var key in s) if (!t[key] && (key!='$shared')) return false;
for (var key in s) if (!t[key]) return false;
return true;
},
geSet: function(s,t){
for (var key in t) if (!s[key] && (key!='$shared')) return false;
for (var key in t) if (!s[key]) return false;
return true;
},

6
utils/pas2js/docs/translation.html
View File

@ -164,6 +164,10 @@ Put + after a boolean switch option to enable it, - to disable it
-Jo&lt;x&gt; : Enable or disable extra option. The x is case insensitive:
-JoSearchLikeFPC : search source files like FPC, default: search case insensitive.
-JoUseStrict : add "use strict" to modules, default.
-Jpcmd&lt;command&gt; : Run postprocessor. For each generated js execute
command passing the js as stdin and read the new js from stdout.
This option can be added multiple times to call several
postprocessors in succession.
-Ju&lt;x&gt; : Add &lt;x&gt; to foreign unit paths. Foreign units are not compiled.
-l : Write logo
-MDelphi: Delphi 7 compatibility mode
@ -2919,6 +2923,8 @@ End.
Width and precision is supported. str(i:10) will add spaces to the left to fill up to 10 characters.</b>
str(aDouble:1:5) returns a string in decimal format with 5 digits for the fraction.</li>
<li>Intrinsic procedure WriteStr(out s: string; params...)</li>
<li><i>Debugger;</i> converts to <i>debugger;</i>. If a debugger is running
it will break on this line just like a break point.</li>
</ul>
</div>

12
utils/pas2js/nodepas2js.lpi
View File

@ -60,17 +60,7 @@
</Linking>
<Other>
<CustomOptions Value="-Jeutf-8
-Jc
-dVerboseFileCache
-dVerbosePasResolver
-dVerbosePas2JS
-dVerbosePasResEval"/>
<OtherDefines Count="4">
<Define0 Value="VerboseFileCache"/>
<Define1 Value="VerbosePasResolver"/>
<Define2 Value="VerbosePas2JS"/>
<Define3 Value="VerbosePasResEval"/>
</OtherDefines>
-Jc"/>
<CompilerPath Value="$(pas2js)"/>
</Other>
</CompilerOptions>

3
utils/pas2js/pas2js.cfg
View File

@ -17,5 +17,8 @@
-Ji$CfgDir/dist/rtl.js
#ENDIF
-Fu$CfgDir/dist
-Fu$CfgDir/../../../packages/*
# end.

7
utils/pas2js/pas2js.lpi
View File

@ -21,15 +21,9 @@
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<CommandLineParams Value="-Tbrowser -Jirtl.js -Jc /home/michael/projects/pas2js/demo/rtl/democollection.pas"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default">
<local>
<CommandLineParams Value="-Tbrowser -Jirtl.js -Jc /home/michael/projects/pas2js/demo/rtl/democollection.pas"/>
</local>
</Mode0>
</Modes>
</RunParams>
@ -47,6 +41,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../packages/fcl-js/src;../../packages/fcl-json/src;../../packages/fcl-passrc/src;../../packages/pastojs/src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>

1
utils/pas2js/pas2jslib.lpi
View File

@ -39,6 +39,7 @@
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../packages/fcl-js/src;../../packages/fcl-json/src;../../packages/fcl-passrc/src;../../packages/pastojs/src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>