mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 15:50:36 +02:00
# revisions: 43689,43690,43691,43692,43809,43810,43811,43813,43853,43873,43890,43951,43952,43953,43960,44077,44078,44110,44121,44122,44134,44135,44137,44140,44146
git-svn-id: branches/fixes_3_2@46822 -
This commit is contained in:
marco
parent
5bff23adbb
commit
239c7268ab
@ -734,7 +734,7 @@ begin
|
||||
if LastGeneratedLine<Item.GeneratedLine then
|
||||
begin
|
||||
// new line
|
||||
//LastGeneratedColumn:=0;
|
||||
LastGeneratedColumn:=0; // column is reset every generated line
|
||||
for j:=LastGeneratedLine+1 to Item.GeneratedLine do
|
||||
begin
|
||||
AddChar(';');
|
||||
@ -869,6 +869,7 @@ begin
|
||||
begin
|
||||
// next line
|
||||
inc(GeneratedLine);
|
||||
LastColumn:=0;
|
||||
inc(p);
|
||||
end;
|
||||
else
|
||||
@ -1118,7 +1119,9 @@ begin
|
||||
SetLength(s,aStream.Size-aStream.Position);
|
||||
if s<>'' then
|
||||
aStream.Read(s[1],length(s));
|
||||
if LeftStr(s,3)=')]}' then
|
||||
if LeftStr(s,4)=')]}''' then
|
||||
Delete(s,1,4)
|
||||
else if LeftStr(s,3)=')]}' then
|
||||
Delete(s,1,3);
|
||||
P:=TJSONParser.Create(s,[joUTF8]);
|
||||
try
|
||||
|
||||
@ -205,6 +205,7 @@ const
|
||||
nCouldNotInferTypeArgXForMethodY = 3139;
|
||||
nInferredTypeXFromDiffArgsMismatchFromMethodY = 3140;
|
||||
nParamOfThisTypeCannotHaveDefVal = 3141;
|
||||
nClassTypesAreNotRelatedXY = 3142;
|
||||
|
||||
// using same IDs as FPC
|
||||
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
|
||||
@ -357,6 +358,7 @@ resourcestring
|
||||
sCouldNotInferTypeArgXForMethodY = 'Could not infer generic type argument "%s" for method "%s"';
|
||||
sInferredTypeXFromDiffArgsMismatchFromMethodY = 'Inferred type "%s" from different arguments mismatch for method "%s"';
|
||||
sParamOfThisTypeCannotHaveDefVal = 'Parameters of this type cannot have default values';
|
||||
sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related';
|
||||
|
||||
type
|
||||
{ TResolveData - base class for data stored in TPasElement.CustomData }
|
||||
|
||||
@ -5676,7 +5676,7 @@ end;
|
||||
|
||||
procedure TPasResolver.FinishUsesClause;
|
||||
var
|
||||
Section, CurSection: TPasSection;
|
||||
Section: TPasSection;
|
||||
i, j: Integer;
|
||||
PublicEl, UseModule: TPasElement;
|
||||
Scope: TPasSectionScope;
|
||||
@ -5723,25 +5723,6 @@ begin
|
||||
+UseUnit.Name+'->'+GetObjName(PublicEl)+'->'+PublicEl.CustomData.ClassName);
|
||||
UsesScope:=TPasSectionScope(PublicEl.CustomData);
|
||||
|
||||
// check if module was already used by a different name
|
||||
j:=i;
|
||||
CurSection:=Section;
|
||||
repeat
|
||||
dec(j);
|
||||
if j<0 then
|
||||
begin
|
||||
if CurSection.ClassType<>TImplementationSection then
|
||||
break;
|
||||
CurSection:=CurSection.GetModule.InterfaceSection;
|
||||
if CurSection=nil then break;
|
||||
j:=length(CurSection.UsesClause)-1;
|
||||
if j<0 then break;
|
||||
end;
|
||||
if CurSection.UsesClause[j].Module=UseModule then
|
||||
RaiseMsg(20170503004022,nDuplicateIdentifier,sDuplicateIdentifier,
|
||||
[UseModule.Name,GetElementSourcePosStr(CurSection.UsesClause[j])],UseUnit);
|
||||
until false;
|
||||
|
||||
// add full uses name
|
||||
AddIdentifier(Scope,UseUnit.Name,UseUnit,pikSimple);
|
||||
|
||||
@ -10805,6 +10786,24 @@ begin
|
||||
[GetElementTypeName(FoundEl)+' '+FoundEl.Name],NameExpr);
|
||||
end;
|
||||
|
||||
if FoundEl is TPasType then
|
||||
begin
|
||||
// typecast
|
||||
TypeEl:=ResolveAliasType(TPasType(FoundEl));
|
||||
C:=TypeEl.ClassType;
|
||||
if C=TPasUnresolvedSymbolRef then
|
||||
begin
|
||||
// typecast to built-in type
|
||||
if TypeEl.CustomData is TResElDataBaseType then
|
||||
CheckTypeCast(TypeEl,Params,true); // emit warnings
|
||||
end
|
||||
else
|
||||
begin
|
||||
// typecast to user type
|
||||
CheckTypeCast(TypeEl,Params,true); // emit warnings
|
||||
end;
|
||||
end;
|
||||
|
||||
// FoundEl compatible element -> create reference
|
||||
Ref:=CreateReference(FoundEl,NameExpr,rraRead);
|
||||
if FindCallData.StartScope.ClassType=ScopeClass_WithExpr then
|
||||
@ -15677,16 +15676,20 @@ type
|
||||
and (NewBaseType in [btByte,btShortInt,btWord,btSmallInt,btIntSingle,btUIntSingle,btLongint])
|
||||
and (BaseType1<>btLongWord) and (BaseType2<>btLongWord) then
|
||||
NewBaseType:=btLongint
|
||||
{$ifdef HasInt64}
|
||||
else if (BaseTypes[btInt64]<>nil)
|
||||
and (NewBaseType<=btInt64)
|
||||
and (BaseType1<>btQWord) and (BaseType2<>btQWord) then
|
||||
NewBaseType:=btInt64
|
||||
{$endif}
|
||||
else if (BaseTypes[btIntDouble]<>nil)
|
||||
and (NewBaseType<=btIntDouble) then
|
||||
NewBaseType:=btIntDouble
|
||||
{$ifdef HasInt64}
|
||||
else if (BaseTypes[btQWord]<>nil)
|
||||
and not (NewBaseType in btAllSignedInteger) then
|
||||
NewBaseType:=btQWord
|
||||
{$endif}
|
||||
else
|
||||
NewBaseType:=GetCombinedInt(Param1Resolved,Param2Resolved,ErrorPos);
|
||||
end
|
||||
@ -26116,8 +26119,18 @@ end;
|
||||
function TPasResolver.CheckTypeCastRes(const FromResolved,
|
||||
ToResolved: TPasResolverResult; ErrorEl: TPasElement; RaiseOnError: boolean
|
||||
): integer;
|
||||
|
||||
procedure WarnClassTypesAreNotRelated(GotType, ExpType: TPasClassType);
|
||||
var
|
||||
GotDesc, ExpDesc: String;
|
||||
begin
|
||||
GetIncompatibleTypeDesc(GotType,ExpType,GotDesc,ExpDesc);
|
||||
LogMsg(20200209140450,mtWarning,nClassTypesAreNotRelatedXY,
|
||||
sClassTypesAreNotRelatedXY,[GotDesc,ExpDesc],ErrorEl);
|
||||
end;
|
||||
|
||||
var
|
||||
ToTypeEl, ToClassType, FromClassType, FromTypeEl: TPasType;
|
||||
ToTypeEl, ToType, FromType, FromTypeEl: TPasType;
|
||||
ToTypeBaseType: TResolverBaseType;
|
||||
C: TClass;
|
||||
ToProcType, FromProcType: TPasProcedureType;
|
||||
@ -26125,6 +26138,7 @@ var
|
||||
i: Integer;
|
||||
ConToken: TToken;
|
||||
ConEl: TPasElement;
|
||||
ToClassType, FromClassType: TPasClassType;
|
||||
begin
|
||||
Result:=cIncompatible;
|
||||
ToTypeEl:=ToResolved.LoTypeEl;
|
||||
@ -26244,34 +26258,36 @@ begin
|
||||
end
|
||||
else if C=TPasClassType then
|
||||
begin
|
||||
ToClassType:=TPasClassType(ToTypeEl);
|
||||
// to class
|
||||
if FromResolved.BaseType=btContext then
|
||||
begin
|
||||
FromTypeEl:=FromResolved.LoTypeEl;
|
||||
if FromTypeEl.ClassType=TPasClassType then
|
||||
begin
|
||||
FromClassType:=TPasClassType(FromTypeEl);
|
||||
if FromResolved.IdentEl is TPasType then
|
||||
RaiseMsg(20170404162606,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
|
||||
if TPasClassType(FromTypeEl).ObjKind=TPasClassType(ToTypeEl).ObjKind then
|
||||
if FromClassType.ObjKind=ToClassType.ObjKind then
|
||||
begin
|
||||
// type cast upwards or downwards
|
||||
Result:=CheckSrcIsADstType(FromResolved,ToResolved);
|
||||
if Result=cIncompatible then
|
||||
Result:=CheckSrcIsADstType(ToResolved,FromResolved);
|
||||
end
|
||||
else if TPasClassType(ToTypeEl).ObjKind=okInterface then
|
||||
else if ToClassType.ObjKind=okInterface then
|
||||
begin
|
||||
if (TPasClassType(FromTypeEl).ObjKind=okClass)
|
||||
and (not TPasClassType(FromTypeEl).IsExternal) then
|
||||
if (FromClassType.ObjKind=okClass)
|
||||
and (not FromClassType.IsExternal) then
|
||||
begin
|
||||
// e.g. intftype(classinstvar)
|
||||
Result:=cCompatible;
|
||||
end;
|
||||
end
|
||||
else if TPasClassType(FromTypeEl).ObjKind=okInterface then
|
||||
else if FromClassType.ObjKind=okInterface then
|
||||
begin
|
||||
if (TPasClassType(ToTypeEl).ObjKind=okClass)
|
||||
and (not TPasClassType(ToTypeEl).IsExternal) then
|
||||
if (ToClassType.ObjKind=okClass)
|
||||
and (not ToClassType.IsExternal) then
|
||||
begin
|
||||
// e.g. classtype(intfvar)
|
||||
Result:=cCompatible;
|
||||
@ -26279,6 +26295,12 @@ begin
|
||||
end;
|
||||
if Result=cIncompatible then
|
||||
Result:=CheckTypeCastClassInstanceToClass(FromResolved,ToResolved,ErrorEl);
|
||||
if (Result=cIncompatible) and (FromClassType.ObjKind=ToClassType.ObjKind) then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
WarnClassTypesAreNotRelated(FromClassType,ToClassType);
|
||||
Result:=cTypeConversion;
|
||||
end;
|
||||
end
|
||||
else if FromTypeEl.ClassType=TPasGenericTemplateType then
|
||||
begin
|
||||
@ -26354,9 +26376,9 @@ begin
|
||||
if (FromResolved.IdentEl is TPasType) then
|
||||
RaiseMsg(20170404162604,nCannotTypecastAType,sCannotTypecastAType,[],ErrorEl);
|
||||
// type cast classof(classof-var) upwards or downwards
|
||||
ToClassType:=TPasClassOfType(ToTypeEl).DestType;
|
||||
FromClassType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
|
||||
Result:=CheckClassesAreRelated(ToClassType,FromClassType);
|
||||
ToType:=TPasClassOfType(ToTypeEl).DestType;
|
||||
FromType:=TPasClassOfType(FromResolved.LoTypeEl).DestType;
|
||||
Result:=CheckClassesAreRelated(ToType,FromType);
|
||||
end;
|
||||
end
|
||||
else if FromResolved.BaseType=btPointer then
|
||||
@ -26541,9 +26563,9 @@ begin
|
||||
and (ToTypeEl=ToResolved.IdentEl) then
|
||||
begin
|
||||
// for example class-of(Self) in a class function
|
||||
ToClassType:=TPasClassOfType(ToTypeEl).DestType;
|
||||
FromClassType:=TPasClassType(FromTypeEl);
|
||||
Result:=CheckClassesAreRelated(ToClassType,FromClassType);
|
||||
ToType:=TPasClassOfType(ToTypeEl).DestType;
|
||||
FromType:=TPasClassType(FromTypeEl);
|
||||
Result:=CheckClassesAreRelated(ToType,FromType);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -27930,7 +27952,8 @@ begin
|
||||
Templates:=GetProcTemplateTypes(Proc);
|
||||
if (Templates<>nil) and (Templates.Count>0) then
|
||||
exit(false);
|
||||
if ProcScope.SpecializedFromItem=nil then exit(true);
|
||||
if ProcScope.SpecializedFromItem=nil then
|
||||
exit(true);
|
||||
Params:=ProcScope.SpecializedFromItem.Params;
|
||||
for i:=0 to length(Params)-1 do
|
||||
if Params[i] is TPasGenericTemplateType then exit(false);
|
||||
|
||||
@ -198,7 +198,8 @@ type
|
||||
|
||||
TPasAnalyzerOption = (
|
||||
paoOnlyExports, // default: use all class members accessible from outside (protected, but not private)
|
||||
paoImplReferences // collect references of top lvl proc implementations, initializationa dn finalization sections
|
||||
paoImplReferences, // collect references of top lvl proc implementations, initializationa dn finalization sections
|
||||
paoSkipGenericProc // ignore generic procedure body
|
||||
);
|
||||
TPasAnalyzerOptions = set of TPasAnalyzerOption;
|
||||
|
||||
@ -1078,6 +1079,7 @@ function TPasAnalyzer.CanSkipGenericProc(DeclProc: TPasProcedure): boolean;
|
||||
|
||||
var
|
||||
Templates: TFPList;
|
||||
Parent: TPasElement;
|
||||
begin
|
||||
Result:=false;
|
||||
if ScopeModule=nil then
|
||||
@ -1091,10 +1093,30 @@ begin
|
||||
// analyze a module
|
||||
Templates:=Resolver.GetProcTemplateTypes(DeclProc);
|
||||
if (Templates<>nil) and (Templates.Count>0) then
|
||||
// generic template -> analyze
|
||||
begin
|
||||
// generic procedure
|
||||
if paoSkipGenericProc in Options then
|
||||
exit(true); // emit no hints for generic proc
|
||||
// -> analyze
|
||||
end
|
||||
else if not Resolver.IsFullySpecialized(DeclProc) then
|
||||
// half specialized -> skip
|
||||
exit(true);
|
||||
exit(true)
|
||||
else if paoSkipGenericProc in Options then
|
||||
begin
|
||||
Parent:=DeclProc.Parent;
|
||||
while Parent<>nil do
|
||||
begin
|
||||
if (Parent is TPasGenericType) then
|
||||
begin
|
||||
Templates:=TPasGenericType(Parent).GenericTemplateTypes;
|
||||
if (Templates<>nil) and (Templates.Count>0) then
|
||||
// procedure of a generic parent -> emit no hints
|
||||
exit(true);
|
||||
end;
|
||||
Parent:=Parent.Parent;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1923,10 +1945,10 @@ begin
|
||||
if Proc.Parent is TPasMembersType then
|
||||
UseClassOrRecType(TPasMembersType(Proc.Parent),paumElement);
|
||||
|
||||
UseScopeReferences(ProcScope.References);
|
||||
|
||||
UseProcedureType(Proc.ProcType);
|
||||
|
||||
UseScopeReferences(ProcScope.References);
|
||||
|
||||
ImplProc:=Proc;
|
||||
if ProcScope.ImplProc<>nil then
|
||||
ImplProc:=ProcScope.ImplProc;
|
||||
|
||||
@ -3792,16 +3792,6 @@ function TPasParser.AddUseUnit(ASection: TPasSection;
|
||||
ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
|
||||
end;
|
||||
|
||||
procedure CheckDuplicateInUsesList(UnitRef: TPasElement; UsesClause: TPasUsesClause);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
if UsesClause=nil then exit;
|
||||
for i:=0 to length(UsesClause)-1 do
|
||||
if UsesClause[i].Module=UnitRef then
|
||||
ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
|
||||
end;
|
||||
|
||||
var
|
||||
UnitRef: TPasElement;
|
||||
UsesUnit: TPasUsesUnit;
|
||||
@ -3820,22 +3810,18 @@ begin
|
||||
ParseExc(nParserDuplicateIdentifier,SParserDuplicateIdentifier,[AUnitName]);
|
||||
end;
|
||||
|
||||
// Note: The alias (AUnitName) must be unique within a module.
|
||||
// Using an unit module twice with different alias is allowed.
|
||||
CheckDuplicateInUsesList(ASection.UsesClause);
|
||||
if ASection.ClassType=TImplementationSection then
|
||||
CheckDuplicateInUsesList(CurModule.InterfaceSection.UsesClause);
|
||||
|
||||
UnitRef := Engine.FindModule(AUnitName,NameExpr,InFileExpr);
|
||||
if Assigned(UnitRef) then
|
||||
begin
|
||||
UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF};
|
||||
CheckDuplicateInUsesList(UnitRef,ASection.UsesClause);
|
||||
if ASection.ClassType=TImplementationSection then
|
||||
CheckDuplicateInUsesList(UnitRef,CurModule.InterfaceSection.UsesClause);
|
||||
end
|
||||
UnitRef.AddRef{$IFDEF CheckPasTreeRefCount}('TPasUsesUnit.Module'){$ENDIF}
|
||||
else
|
||||
begin
|
||||
CheckDuplicateInUsesList(ASection.UsesClause);
|
||||
if ASection.ClassType=TImplementationSection then
|
||||
CheckDuplicateInUsesList(CurModule.InterfaceSection.UsesClause);
|
||||
UnitRef := TPasUnresolvedUnitRef(CreateElement(TPasUnresolvedUnitRef,
|
||||
AUnitName, ASection, NamePos));
|
||||
end;
|
||||
|
||||
UsesUnit:=TPasUsesUnit(CreateElement(TPasUsesUnit,AUnitName,ASection,NamePos));
|
||||
Result:=ASection.AddUnitToUsesList(AUnitName,NameExpr,InFileExpr,UnitRef,UsesUnit);
|
||||
|
||||
@ -1161,9 +1161,6 @@ const
|
||||
'DispatchStrField' // vsDispatchStrField
|
||||
);
|
||||
|
||||
const
|
||||
AllLanguageModes = [msFPC,msObjFPC,msDelphi,msTP7,msMac,msISO,msExtPas];
|
||||
|
||||
const
|
||||
MessageTypeNames : Array[TMessageType] of string = (
|
||||
'Fatal','Error','Warning','Note','Hint','Info','Debug'
|
||||
@ -1172,6 +1169,7 @@ const
|
||||
const
|
||||
// all mode switches supported by FPC
|
||||
msAllModeSwitches = [low(TModeSwitch)..High(TModeSwitch)];
|
||||
AllLanguageModes = [msFPC..msGPC];
|
||||
|
||||
DelphiModeSwitches = [msDelphi,msClass,msObjpas,msResult,msStringPchar,
|
||||
msPointer2Procedure,msAutoDeref,msTPProcVar,msInitFinal,msDefaultAnsistring,
|
||||
|
||||
@ -370,7 +370,7 @@ type
|
||||
Procedure TestUnit_DottedUnit;
|
||||
Procedure TestUnit_DottedExpr;
|
||||
Procedure TestUnit_DuplicateDottedUsesFail;
|
||||
Procedure TestUnit_DuplicateUsesDiffNameFail;
|
||||
Procedure TestUnit_DuplicateUsesDiffName;
|
||||
Procedure TestUnit_Unit1DotUnit2Fail;
|
||||
Procedure TestUnit_InFilename;
|
||||
Procedure TestUnit_InFilenameAliasDelphiFail;
|
||||
@ -379,6 +379,7 @@ type
|
||||
Procedure TestUnit_UnitNotFoundErrorPos;
|
||||
Procedure TestUnit_AccessIndirectUsedUnitFail;
|
||||
Procedure TestUnit_Intf1Impl2Intf1;
|
||||
Procedure TestUnit_Intf1Impl2Intf1_Duplicate;
|
||||
|
||||
// procs
|
||||
Procedure TestProcParam;
|
||||
@ -591,7 +592,7 @@ type
|
||||
Procedure TestClass_OperatorAsOnNonTypeFail;
|
||||
Procedure TestClassAsFuncResult;
|
||||
Procedure TestClassTypeCast;
|
||||
Procedure TestClassTypeCastUnrelatedFail;
|
||||
Procedure TestClassTypeCastUnrelatedWarn;
|
||||
Procedure TestClass_TypeCastSelf;
|
||||
Procedure TestClass_TypeCaseMultipleParamsFail;
|
||||
Procedure TestClass_TypeCastAssign;
|
||||
@ -2386,8 +2387,13 @@ function TCustomTestResolver.OnPasResolverFindUnit(SrcResolver: TPasResolver;
|
||||
{$ENDIF}
|
||||
CurEngine:=FindModuleWithFilename(aFilename);
|
||||
if CurEngine=nil then exit(false);
|
||||
aModule:=InitUnit(CurEngine);
|
||||
if aModule=nil then exit(false);
|
||||
if CurEngine.Module=nil then
|
||||
begin
|
||||
aModule:=InitUnit(CurEngine);
|
||||
if aModule=nil then exit(false);
|
||||
end
|
||||
else
|
||||
aModule:=CurEngine.Module;
|
||||
OnPasResolverFindUnit:=aModule;
|
||||
Result:=true;
|
||||
end;
|
||||
@ -5924,7 +5930,7 @@ begin
|
||||
nParserDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_DuplicateUsesDiffNameFail;
|
||||
procedure TTestResolver.TestUnit_DuplicateUsesDiffName;
|
||||
begin
|
||||
MainFilename:='unitdots.main1.pas';
|
||||
AddModuleWithIntfImplSrc('unitdots.unit1.pp',
|
||||
@ -5942,8 +5948,7 @@ begin
|
||||
' if unit1.j1=0 then ;',
|
||||
' if unitdots.unit1.j1=0 then ;',
|
||||
'']);
|
||||
CheckParserException('Duplicate identifier "unit1" at token ";" in file unitdots.main1.pas at line 2 column 27',
|
||||
nParserDuplicateIdentifier);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_Unit1DotUnit2Fail;
|
||||
@ -6092,6 +6097,27 @@ begin
|
||||
ParseUnit;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestUnit_Intf1Impl2Intf1_Duplicate;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit1.pp',
|
||||
LinesToStr([
|
||||
'type number = longint;']),
|
||||
LinesToStr([
|
||||
'uses afile;',
|
||||
'procedure DoIt;',
|
||||
'begin',
|
||||
' i:=3;',
|
||||
'end;']));
|
||||
|
||||
StartUnit(true);
|
||||
Add([
|
||||
'interface',
|
||||
'uses unit1, foo in ''unit1.pp'';',
|
||||
'var i: number;',
|
||||
'implementation']);
|
||||
ParseUnit;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestProcParam;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -10324,26 +10350,28 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClassTypeCastUnrelatedFail;
|
||||
procedure TTestResolver.TestClassTypeCastUnrelatedWarn;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' {#TOBJ}TObject = class');
|
||||
Add(' end;');
|
||||
Add(' {#A}TClassA = class');
|
||||
Add(' id: longint;');
|
||||
Add(' end;');
|
||||
Add(' {#B}TClassB = class');
|
||||
Add(' Name: string;');
|
||||
Add(' end;');
|
||||
Add('var');
|
||||
Add(' {#o}{=TOBJ}o: TObject;');
|
||||
Add(' {#va}{=A}va: TClassA;');
|
||||
Add(' {#vb}{=B}vb: TClassB;');
|
||||
Add('begin');
|
||||
Add(' {@vb}vb:=TClassB({@va}va);');
|
||||
CheckResolverException('Illegal type conversion: "TClassA" to "class TClassB"',
|
||||
nIllegalTypeConversionTo);
|
||||
Add([
|
||||
'type',
|
||||
' {#TOBJ}TObject = class',
|
||||
' end;',
|
||||
' {#A}TClassA = class',
|
||||
' id: longint;',
|
||||
' end;',
|
||||
' {#B}TClassB = class',
|
||||
' Name: string;',
|
||||
' end;',
|
||||
'var',
|
||||
' {#o}{=TOBJ}o: TObject;',
|
||||
' {#va}{=A}va: TClassA;',
|
||||
' {#vb}{=B}vb: TClassB;',
|
||||
'begin',
|
||||
' {@vb}vb:=TClassB({@va}va);']);
|
||||
ParseProgram;
|
||||
CheckResolverHint(mtWarning,nClassTypesAreNotRelatedXY,'Class types "TClassA" and "TClassB" are not related');
|
||||
CheckResolverUnexpectedHints;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestClass_TypeCastSelf;
|
||||
|
||||
@ -499,6 +499,7 @@ const
|
||||
nBitWiseOperationIs32Bit = 4028;
|
||||
nDuplicateMessageIdXAtY = 4029;
|
||||
nDispatchRequiresX = 4030;
|
||||
nConstRefNotForXAsConst = 4031;
|
||||
// resourcestring patterns of messages
|
||||
resourcestring
|
||||
sPasElementNotSupported = 'Pascal element not supported: %s';
|
||||
@ -531,6 +532,7 @@ resourcestring
|
||||
sBitWiseOperationIs32Bit = 'Bitwise operation is 32-bit';
|
||||
sDuplicateMessageIdXAtY = 'Duplicate message id "%s" at %s';
|
||||
sDispatchRequiresX = 'Dispatch requires %s';
|
||||
sConstRefNotForXAsConst = 'ConstRef not yet implemented for %s. Treating as Const';
|
||||
|
||||
const
|
||||
ExtClassBracketAccessor = '[]'; // external name '[]' marks the array param getter/setter
|
||||
@ -1453,6 +1455,7 @@ type
|
||||
function ProcHasImplElements(Proc: TPasProcedure): boolean; override;
|
||||
function HasAnonymousFunctions(El: TPasImplElement): boolean;
|
||||
function GetTopLvlProcScope(El: TPasElement): TPas2JSProcedureScope;
|
||||
function ProcCanBePrecompiled(DeclProc: TPasProcedure): boolean; virtual;
|
||||
function IsTObjectFreeMethod(El: TPasExpr): boolean; virtual;
|
||||
function IsExternalBracketAccessor(El: TPasElement): boolean;
|
||||
function IsExternalClassConstructor(El: TPasElement): boolean;
|
||||
@ -2926,6 +2929,7 @@ var
|
||||
ElevatedLocals: TPas2jsElevatedLocals;
|
||||
begin
|
||||
Result:=0;
|
||||
//if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' ',HasOverloadIndex(El,true));
|
||||
if not HasOverloadIndex(El,true) then exit;
|
||||
|
||||
ThisChanged:=false;
|
||||
@ -2946,6 +2950,7 @@ begin
|
||||
|
||||
// check elevated locals
|
||||
ElevatedLocals:=GetElevatedLocals(Scope);
|
||||
// if SameText(El.Name,'ci') then writeln('TPas2JSResolver.GetOverloadIndex ',GetObjPath(El),' ',Scope.Element.ClassName,' ',ElevatedLocals<>nil);
|
||||
if ElevatedLocals<>nil then
|
||||
begin
|
||||
Identifier:=ElevatedLocals.Find(El.Name);
|
||||
@ -3057,6 +3062,7 @@ var
|
||||
begin
|
||||
// => count overloads in this section
|
||||
OverloadIndex:=GetOverloadIndex(El);
|
||||
//if SameText(El.Name,'ci') then writeln('TPas2JSResolver.RenameOverload ',GetObjPath(El),' ',OverloadIndex);
|
||||
if OverloadIndex=0 then
|
||||
exit(false); // there is no overload
|
||||
|
||||
@ -3182,16 +3188,51 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPas2JSResolver.RenameSubOverloads(Declarations: TFPList);
|
||||
|
||||
procedure RestoreScopeLvl(OldScopeCount: integer);
|
||||
begin
|
||||
while FOverloadScopes.Count>OldScopeCount do
|
||||
PopOverloadScope;
|
||||
end;
|
||||
|
||||
procedure LocalPushClassOrRecScopes(Scope: TPasClassOrRecordScope);
|
||||
var
|
||||
CurScope: TPasClassOrRecordScope;
|
||||
aParent: TPasElement;
|
||||
begin
|
||||
CurScope:=Scope;
|
||||
repeat
|
||||
PushOverloadScope(CurScope);
|
||||
if Scope is TPas2JSClassScope then
|
||||
CurScope:=TPas2JSClassScope(CurScope).AncestorScope
|
||||
else
|
||||
break;
|
||||
until CurScope=nil;
|
||||
aParent:=Scope.Element.Parent;
|
||||
if not (aParent is TPasMembersType) then
|
||||
exit;
|
||||
// nested class -> push parent class scope...
|
||||
CurScope:=aParent.CustomData as TPasClassOrRecordScope;
|
||||
LocalPushClassOrRecScopes(CurScope);
|
||||
end;
|
||||
|
||||
var
|
||||
i, OldScopeCount: Integer;
|
||||
El: TPasElement;
|
||||
Proc: TPasProcedure;
|
||||
ProcScope: TPasProcedureScope;
|
||||
Proc, ImplProc: TPasProcedure;
|
||||
ProcScope, ImplProcScope: TPas2JSProcedureScope;
|
||||
ClassScope, aScope: TPasClassScope;
|
||||
ClassEl: TPasClassType;
|
||||
C: TClass;
|
||||
ProcBody: TProcedureBody;
|
||||
IntfSection: TInterfaceSection;
|
||||
ImplSection: TImplementationSection;
|
||||
begin
|
||||
IntfSection:=RootElement.InterfaceSection;
|
||||
if IntfSection<>nil then
|
||||
ImplSection:=RootElement.ImplementationSection
|
||||
else
|
||||
ImplSection:=nil;
|
||||
for i:=0 to Declarations.Count-1 do
|
||||
begin
|
||||
El:=TPasElement(Declarations[i]);
|
||||
@ -3199,26 +3240,49 @@ begin
|
||||
if C.InheritsFrom(TPasProcedure) then
|
||||
begin
|
||||
Proc:=TPasProcedure(El);
|
||||
ProcScope:=Proc.CustomData as TPasProcedureScope;
|
||||
ProcScope:=Proc.CustomData as TPas2JSProcedureScope;
|
||||
|
||||
// handle each Proc only once, by handling only the DeclProc,
|
||||
// except for DeclProc in the unit interface
|
||||
if ProcScope.DeclarationProc<>nil then
|
||||
continue;
|
||||
if ProcScope.ImplProc<>nil then
|
||||
begin
|
||||
Proc:=ProcScope.ImplProc;
|
||||
ProcScope:=TPasProcedureScope(Proc.CustomData);
|
||||
// ImplProc with separate declaration
|
||||
if (Proc.Parent=ImplSection)
|
||||
and ProcScope.DeclarationProc.HasParent(IntfSection) then
|
||||
// ImplProc in unit implementation, DeclProc in unit interface
|
||||
// Note: The Unit Impl elements are renamed in a separate run, aka now
|
||||
else
|
||||
continue; // handled via DeclProc
|
||||
end;
|
||||
ImplProc:=ProcScope.ImplProc;
|
||||
if ImplProc<>nil then
|
||||
ImplProcScope:=TPas2JSProcedureScope(ImplProc.CustomData)
|
||||
else
|
||||
begin
|
||||
ImplProc:=Proc;
|
||||
ImplProcScope:=ProcScope;
|
||||
end;
|
||||
{$IFDEF VerbosePas2JS}
|
||||
//writeln('TPas2JSResolver.RenameSubOverloads Proc=',Proc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ImplProc=',GetObjName(ProcScope.ImplProc),' ClassScope=',GetObjName(ProcScope.ClassOrRecordScope));
|
||||
//writeln('TPas2JSResolver.RenameSubOverloads ImplProc=',ImplProc.Name,' DeclarationProc=',GetObjName(ProcScope.DeclarationProc),' ClassScope=',GetObjName(ImplProcScope.ClassOrRecordScope));
|
||||
{$ENDIF}
|
||||
ProcBody:=Proc.Body;
|
||||
ProcBody:=ImplProc.Body;
|
||||
if ProcBody<>nil then
|
||||
begin
|
||||
PushOverloadScope(ProcScope);
|
||||
OldScopeCount:=FOverloadScopes.Count;
|
||||
if (ImplProcScope.ClassRecScope<>nil)
|
||||
and not (Proc.Parent is TPasMembersType) then
|
||||
begin
|
||||
// push class scopes
|
||||
LocalPushClassOrRecScopes(ImplProcScope.ClassRecScope);
|
||||
end;
|
||||
|
||||
PushOverloadScope(ImplProcScope);
|
||||
// first rename all overloads on this level
|
||||
RenameOverloads(ProcBody,ProcBody.Declarations);
|
||||
// then process nested procedures
|
||||
RenameSubOverloads(ProcBody.Declarations);
|
||||
PopOverloadScope;
|
||||
RestoreScopeLvl(OldScopeCount);
|
||||
end;
|
||||
end
|
||||
else if (C=TPasClassType) or (C=TPasRecordType) then
|
||||
@ -3250,8 +3314,7 @@ begin
|
||||
RenameSubOverloads(TPasMembersType(El).Members);
|
||||
|
||||
// restore scope
|
||||
while FOverloadScopes.Count>OldScopeCount do
|
||||
PopOverloadScope;
|
||||
RestoreScopeLvl(OldScopeCount);
|
||||
end;
|
||||
end;
|
||||
{$IFDEF VerbosePas2JS}
|
||||
@ -3938,13 +4001,15 @@ end;
|
||||
procedure TPas2JSResolver.FinishArgument(El: TPasArgument);
|
||||
var
|
||||
TypeEl, ElTypeEl: TPasType;
|
||||
C: TClass;
|
||||
begin
|
||||
inherited FinishArgument(El);
|
||||
if El.ArgType<>nil then
|
||||
begin
|
||||
TypeEl:=ResolveAliasType(El.ArgType);
|
||||
C:=TypeEl.ClassType;
|
||||
|
||||
if TypeEl.ClassType=TPasPointerType then
|
||||
if C=TPasPointerType then
|
||||
begin
|
||||
ElTypeEl:=ResolveAliasType(TPasPointerType(TypeEl).DestType);
|
||||
if ElTypeEl.ClassType=TPasRecordType then
|
||||
@ -3952,6 +4017,15 @@ begin
|
||||
else
|
||||
RaiseMsg(20180423110239,nNotSupportedX,sNotSupportedX,['pointer'],El);
|
||||
end;
|
||||
|
||||
if El.Access=argConstRef then
|
||||
begin
|
||||
if (C=TPasRecordType) or (C=TPasArrayType) then
|
||||
// argConstRef works same as argConst for records -> ok
|
||||
else
|
||||
LogMsg(20191215133912,mtWarning,nConstRefNotForXAsConst,sConstRefNotForXAsConst,
|
||||
[GetElementTypeName(TypeEl)],El);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -5926,6 +6000,37 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.ProcCanBePrecompiled(DeclProc: TPasProcedure): boolean;
|
||||
var
|
||||
El: TPasElement;
|
||||
TemplTypes: TFPList;
|
||||
ProcScope: TPas2JSProcedureScope;
|
||||
GenScope: TPasGenericScope;
|
||||
begin
|
||||
if GetProcTemplateTypes(DeclProc)<>nil then
|
||||
exit(false); // generic DeclProc
|
||||
ProcScope:=DeclProc.CustomData as TPas2JSProcedureScope;
|
||||
if ProcScope.SpecializedFromItem<>nil then
|
||||
exit(false); // specialized generic DeclProc
|
||||
El:=DeclProc;
|
||||
repeat
|
||||
El:=El.Parent;
|
||||
if El=nil then
|
||||
exit(true); // ok
|
||||
if El is TPasProcedure then
|
||||
exit(false); // DeclProc is a local DeclProc
|
||||
if El is TPasGenericType then
|
||||
begin
|
||||
TemplTypes:=TPasGenericType(El).GenericTemplateTypes;
|
||||
if (TemplTypes<>nil) and (TemplTypes.Count>0) then
|
||||
exit(false); // method of a generic class/record type
|
||||
GenScope:=El.CustomData as TPasGenericScope;
|
||||
if GenScope.SpecializedFromItem<>nil then
|
||||
exit(false); // method of a specialized class/record type
|
||||
end;
|
||||
until false;
|
||||
end;
|
||||
|
||||
function TPas2JSResolver.IsTObjectFreeMethod(El: TPasExpr): boolean;
|
||||
var
|
||||
Ref: TResolvedReference;
|
||||
@ -14975,7 +15080,7 @@ begin
|
||||
|
||||
if (coStoreImplJS in Options) and (aResolver<>nil) then
|
||||
begin
|
||||
if aResolver.GetTopLvlProc(El)=El then
|
||||
if aResolver.ProcCanBePrecompiled(El) then
|
||||
begin
|
||||
ImplProcScope.BodyJS:=CreatePrecompiledJS(Result);
|
||||
ImplProcScope.EmptyJS:=BodyPas.Body=nil;
|
||||
@ -17348,7 +17453,7 @@ begin
|
||||
// add flags
|
||||
case Arg.Access of
|
||||
argDefault: ;
|
||||
argConst: inc(Flags,pfConst);
|
||||
argConst,argConstRef: inc(Flags,pfConst);
|
||||
argVar: inc(Flags,pfVar);
|
||||
argOut: inc(Flags,pfOut);
|
||||
else
|
||||
@ -22314,7 +22419,7 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
if not (TargetArg.Access in [argDefault,argVar,argOut,argConst]) then
|
||||
if not (TargetArg.Access in [argDefault,argVar,argOut,argConst,argConstRef]) then
|
||||
DoError(20170213220927,nPasElementNotSupported,sPasElementNotSupported,
|
||||
[AccessNames[TargetArg.Access]],El);
|
||||
aResolver:=AContext.Resolver;
|
||||
|
||||
@ -44,6 +44,7 @@ type
|
||||
|
||||
TPas2JSMapper = class(TBufferWriter)
|
||||
private
|
||||
FPCUExt: string;
|
||||
FDestFileName: String;
|
||||
FSrcMap: TPas2JSSrcMap;
|
||||
procedure SetSrcMap(const AValue: TPas2JSSrcMap);
|
||||
@ -52,16 +53,19 @@ type
|
||||
FGeneratedStartLine: integer; // first line where CurElement was set or a line was written
|
||||
// last valid CurElement position
|
||||
FSrcFilename: String;
|
||||
FSrcIsBinary: boolean;
|
||||
FSrcLine: integer;
|
||||
FSrcColumn: integer;
|
||||
procedure SetCurElement(const AValue: TJSElement); override;
|
||||
procedure SetSrcFilename(Value: string); virtual;
|
||||
procedure Writing; override;
|
||||
public
|
||||
property SrcMap: TPas2JSSrcMap read FSrcMap write SetSrcMap;
|
||||
destructor Destroy; override;
|
||||
procedure WriteFile(Src, Filename: string);
|
||||
// Final destination filename. Usually unit, unless combining javascript in single file.
|
||||
Property DestFileName : String Read FDestFileName Write FDestFileName;
|
||||
property DestFileName : String read FDestFileName Write FDestFileName;
|
||||
property PCUExt: string read FPCUExt write FPCUExt;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -97,6 +101,7 @@ end;
|
||||
procedure TPas2JSMapper.SetCurElement(const AValue: TJSElement);
|
||||
var
|
||||
C: TClass;
|
||||
NewSrcFilename: String;
|
||||
begin
|
||||
{$IFDEF VerboseSrcMap}
|
||||
system.write('TPas2JSMapper.SetCurElement ',CurLine,',',CurColumn);
|
||||
@ -112,26 +117,38 @@ begin
|
||||
or (C=TJSEmptyStatement) then
|
||||
exit; // do not switch position on brackets
|
||||
|
||||
if (AValue<>nil) and (AValue.Source<>'') then
|
||||
if (AValue<>nil) then
|
||||
begin
|
||||
if (FSrcFilename<>AValue.Source)
|
||||
or (FSrcLine<>AValue.Line)
|
||||
or (FSrcColumn<>AValue.Column) then
|
||||
NewSrcFilename:=AValue.Source;
|
||||
if NewSrcFilename<>'' then
|
||||
begin
|
||||
FNeedMapping:=true;
|
||||
FSrcFilename:=AValue.Source;
|
||||
FSrcLine:=AValue.Line;
|
||||
FSrcColumn:=AValue.Column;
|
||||
if (FSrcFilename<>NewSrcFilename)
|
||||
or (FSrcLine<>AValue.Line)
|
||||
or (FSrcColumn<>AValue.Column) then
|
||||
begin
|
||||
FNeedMapping:=true;
|
||||
SetSrcFilename(NewSrcFilename);
|
||||
FSrcLine:=AValue.Line;
|
||||
FSrcColumn:=AValue.Column;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if FGeneratedStartLine<1 then
|
||||
FGeneratedStartLine:=CurLine;
|
||||
end;
|
||||
|
||||
procedure TPas2JSMapper.SetSrcFilename(Value: string);
|
||||
begin
|
||||
if FSrcFilename=Value then exit;
|
||||
FSrcFilename:=Value;
|
||||
FSrcIsBinary:=SameText(ExtractFileExt(Value),FPCUExt);
|
||||
end;
|
||||
|
||||
procedure TPas2JSMapper.Writing;
|
||||
var
|
||||
S: TJSString;
|
||||
p, l, Line: Integer;
|
||||
p, l, Line, CurSrcLine, CurSrcColumn: Integer;
|
||||
CurSrcFilename: String;
|
||||
begin
|
||||
inherited Writing;
|
||||
if SrcMap=nil then exit;
|
||||
@ -143,12 +160,29 @@ begin
|
||||
if FSrcFilename='' then
|
||||
exit; // built-in element -> do not add a mapping
|
||||
|
||||
if FSrcIsBinary then
|
||||
begin
|
||||
// precompiled js -> map to js
|
||||
CurSrcFilename:=DestFileName;
|
||||
CurSrcLine:=CurLine;
|
||||
CurSrcColumn:=CurColumn;
|
||||
FSrcLine:=CurLine;
|
||||
FSrcColumn:=1;
|
||||
end
|
||||
else
|
||||
begin
|
||||
CurSrcFilename:=FSrcFilename;
|
||||
CurSrcLine:=FSrcLine;
|
||||
CurSrcColumn:=FSrcColumn;
|
||||
end;
|
||||
//system.writeln('TPas2JSMapper.Writing ',FSrcFilename);
|
||||
|
||||
FNeedMapping:=false;
|
||||
//system.writeln('TPas2JSMapper.Writing Generated.Line=',CurLine,',Col=',CurColumn-1,
|
||||
// ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine,',Col=',FSrcColumn-1);
|
||||
|
||||
SrcMap.AddMapping(CurLine,Max(0,CurColumn-1),
|
||||
FSrcFilename,Max(0,FSrcLine),Max(0,FSrcColumn-1));
|
||||
CurSrcFilename,Max(0,CurSrcLine),Max(0,CurSrcColumn-1));
|
||||
|
||||
if (CurElement is TJSLiteral)
|
||||
and (TJSLiteral(CurElement).Value.CustomValue<>'') then
|
||||
@ -171,7 +205,7 @@ begin
|
||||
//system.writeln('TPas2JSMapper.Writing Generated.Line=',CurLine+Line,',Col=',0,
|
||||
// ' Orig:',ExtractFileName(FSrcFilename),',Line=',FSrcLine+Line,',Col=',0);
|
||||
SrcMap.AddMapping(CurLine+Line,0,
|
||||
FSrcFilename,FSrcLine+Line,0);
|
||||
CurSrcFilename,CurSrcLine+Line,0);
|
||||
end;
|
||||
else
|
||||
inc(p);
|
||||
@ -190,7 +224,7 @@ var
|
||||
l, p, LineStart: integer;
|
||||
begin
|
||||
if Src='' then exit;
|
||||
FSrcFilename:=Filename;
|
||||
SetSrcFilename(Filename);
|
||||
FSrcLine:=1;
|
||||
FSrcColumn:=1;
|
||||
l:=length(Src);
|
||||
|
||||
@ -53,7 +53,7 @@ const
|
||||
const
|
||||
nOptionIsEnabled = 101; sOptionIsEnabled = 'Option "%s" is %s';
|
||||
nSyntaxModeIs = 102; sSyntaxModeIs = 'Syntax mode is %s';
|
||||
// was: nMacroDefined = 103
|
||||
nModeswitchXisY = 103; sModeswitchXisY = 'Modeswitch %s is %s';
|
||||
// 104 in unit Pas2JSFS
|
||||
// 105 in unit Pas2JSFS
|
||||
nNameValue = 106; sNameValue = '%s: %s';
|
||||
@ -125,6 +125,7 @@ type
|
||||
// features
|
||||
coAllowCAssignments,
|
||||
coAllowMacros,
|
||||
coWriteableConst,
|
||||
// output
|
||||
coLowerCase,
|
||||
coUseStrict,
|
||||
@ -153,7 +154,7 @@ type
|
||||
TResourceMode = (rmNone,rmHTML,rmJS);
|
||||
|
||||
const
|
||||
DefaultP2jsCompilerOptions = [coShowErrors,coSourceMapXSSIHeader,coUseStrict];
|
||||
DefaultP2jsCompilerOptions = [coShowErrors,coWriteableConst,coUseStrict,coSourceMapXSSIHeader];
|
||||
DefaultP2JSResourceStringFile = rsfProgram;
|
||||
DefaultP2jsRTLVersionCheck = rvcNone;
|
||||
DefaultResourceMode = rmHTML;
|
||||
@ -185,6 +186,7 @@ const
|
||||
'Assertions',
|
||||
'Allow C assignments',
|
||||
'Allow macros',
|
||||
'Allows typed constants to be writeable',
|
||||
'Lowercase identifiers',
|
||||
'Use strict',
|
||||
'Write pas2jsdebug.log',
|
||||
@ -489,7 +491,7 @@ type
|
||||
FMainJSFileIsResolved: Boolean;
|
||||
FMainJSFileResolved: String;
|
||||
FMainSrcFile: String;
|
||||
FMode: TP2jsMode;
|
||||
FModeSwitches: TModeSwitches;
|
||||
FNamespaces: TStringList;
|
||||
FNamespacesFromCmdLine: integer;
|
||||
FOptions: TP2jsCompilerOptions;
|
||||
@ -541,6 +543,7 @@ type
|
||||
procedure SetCompilerExe(AValue: string);
|
||||
procedure SetFS(AValue: TPas2jsFS);
|
||||
procedure SetMode(AValue: TP2jsMode);
|
||||
procedure SetModeSwitches(const AValue: TModeSwitches);
|
||||
procedure SetOptions(AValue: TP2jsCompilerOptions);
|
||||
procedure SetShowDebug(AValue: boolean);
|
||||
procedure SetShowFullPaths(AValue: boolean);
|
||||
@ -600,6 +603,7 @@ type
|
||||
procedure HandleOptionPCUFormat(aValue: String); virtual;
|
||||
function HandleOptionPaths(C: Char; aValue: String; FromCmdLine: Boolean): Boolean; virtual;
|
||||
function HandleOptionJ(C: Char; aValue: String; Quick,FromCmdLine: Boolean): Boolean; virtual;
|
||||
function HandleOptionM(aValue: String; Quick: Boolean): Boolean; virtual;
|
||||
procedure HandleOptionConfigFile(aPos: Integer; const aFileName: string); virtual;
|
||||
procedure HandleOptionInfo(aValue: string);
|
||||
// DoWriteJSFile: return false to use the default write function.
|
||||
@ -660,8 +664,9 @@ type
|
||||
function IsDefined(const aName: String): boolean;
|
||||
procedure SetOption(Flag: TP2jsCompilerOption; Enable: boolean);
|
||||
|
||||
function GetUnitInfo(const UseUnitName, InFileName, ModuleDir: String;
|
||||
function GetUnitInfo(UseUnitName, InFileName, ModuleDir: String;
|
||||
PCUSupport: TPCUSupport): TFindUnitInfo;
|
||||
procedure CheckUnitAlias(var UseUnitName: string); virtual;
|
||||
function FindFileWithUnitFilename(UnitFilename: string): TPas2jsCompilerFile;
|
||||
procedure LoadModuleFile(UnitFilename, UseUnitName: string;
|
||||
out aFile: TPas2jsCompilerFile; isPCU: Boolean);
|
||||
@ -680,7 +685,7 @@ type
|
||||
property InterfaceType: TPasClassInterfaceType read FInterfaceType write FInterfaceType;
|
||||
property Log: TPas2jsLogger read FLog;
|
||||
property MainFile: TPas2jsCompilerFile read FMainFile;
|
||||
property Mode: TP2jsMode read FMode write SetMode;
|
||||
property ModeSwitches: TModeSwitches read FModeSwitches write SetModeSwitches;
|
||||
property Options: TP2jsCompilerOptions read FOptions write SetOptions;
|
||||
property ConverterGlobals: TPasToJSConverterGlobals read FConverterGlobals write SetConverterGlobals;
|
||||
property ParamMacros: TPas2jsMacroEngine read FParamMacros;
|
||||
@ -999,7 +1004,7 @@ end;
|
||||
|
||||
function TPas2jsCompilerFile.GetInitialModeSwitches: TModeSwitches;
|
||||
begin
|
||||
Result:=p2jsMode_SwitchSets[Compiler.Mode];
|
||||
Result:=Compiler.ModeSwitches;
|
||||
end;
|
||||
|
||||
function TPas2jsCompilerFile.GetInitialBoolSwitches: TBoolSwitches;
|
||||
@ -1007,8 +1012,12 @@ var
|
||||
bs: TBoolSwitches;
|
||||
begin
|
||||
bs:=[bsLongStrings,bsWriteableConst];
|
||||
if coAllowMacros in Compiler.Options then
|
||||
Include(bs,bsMacro);
|
||||
if coShowHints in Compiler.Options then
|
||||
Include(bs,bsHints);
|
||||
if coShowNotes in Compiler.Options then
|
||||
Include(bs,bsNotes);
|
||||
if coShowWarnings in Compiler.Options then
|
||||
Include(bs,bsWarnings);
|
||||
if coOverflowChecks in Compiler.Options then
|
||||
Include(bs,bsOverflowChecks);
|
||||
if coRangeChecks in Compiler.Options then
|
||||
@ -1017,12 +1026,10 @@ begin
|
||||
Include(bs,bsObjectChecks);
|
||||
if coAssertions in Compiler.Options then
|
||||
Include(bs,bsAssertions);
|
||||
if coShowHints in Compiler.Options then
|
||||
Include(bs,bsHints);
|
||||
if coShowNotes in Compiler.Options then
|
||||
Include(bs,bsNotes);
|
||||
if coShowWarnings in Compiler.Options then
|
||||
Include(bs,bsWarnings);
|
||||
if coAllowMacros in Compiler.Options then
|
||||
Include(bs,bsMacro);
|
||||
if not (coWriteableConst in Compiler.Options) then
|
||||
Exclude(bs,bsWriteableConst);
|
||||
Result:=bs;
|
||||
end;
|
||||
|
||||
@ -1084,8 +1091,6 @@ begin
|
||||
Scanner.CurrentValueSwitch[vsInterfaces]:=InterfaceTypeNames[Compiler.InterfaceType];
|
||||
if coAllowCAssignments in Compiler.Options then
|
||||
Scanner.Options:=Scanner.Options+[po_cassignments];
|
||||
if Compiler.Mode=p2jmDelphi then
|
||||
Scanner.Options:=Scanner.Options+[po_delphi];
|
||||
// Note: some Scanner.Options are set by TPasResolver
|
||||
for i:=0 to Compiler.Defines.Count-1 do
|
||||
begin
|
||||
@ -1948,7 +1953,7 @@ begin
|
||||
|
||||
// check modeswitches
|
||||
ms:=StrToModeSwitch(aName);
|
||||
if (ms<>msNone) and (ms in p2jsMode_SwitchSets[Compiler.Mode]) then
|
||||
if (ms<>msNone) and (ms in Compiler.ModeSwitches) then
|
||||
begin
|
||||
Value:=CondDirectiveBool[true];
|
||||
exit(true);
|
||||
@ -3067,14 +3072,19 @@ end;
|
||||
|
||||
procedure TPas2jsCompiler.SetMode(AValue: TP2jsMode);
|
||||
begin
|
||||
if FMode=AValue then Exit;
|
||||
FMode:=AValue;
|
||||
case FMode of
|
||||
SetModeSwitches(p2jsMode_SwitchSets[AValue]);
|
||||
case AValue of
|
||||
p2jmObjFPC: Options:=Options-[coAllowCAssignments];
|
||||
p2jmDelphi: Options:=Options-[coAllowCAssignments];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2jsCompiler.SetModeSwitches(const AValue: TModeSwitches);
|
||||
begin
|
||||
if FModeSwitches=AValue then Exit;
|
||||
FModeSwitches:=AValue;
|
||||
end;
|
||||
|
||||
procedure TPas2jsCompiler.SetOptions(AValue: TP2jsCompilerOptions);
|
||||
begin
|
||||
if FOptions=AValue then Exit;
|
||||
@ -3236,6 +3246,7 @@ begin
|
||||
LastMsgNumber:=-1;
|
||||
r(mtInfo,nOptionIsEnabled,sOptionIsEnabled);
|
||||
r(mtInfo,nSyntaxModeIs,sSyntaxModeIs);
|
||||
r(mtInfo,nModeswitchXisY,sModeswitchXisY);
|
||||
LastMsgNumber:=-1; // was nMacroDefined 103
|
||||
r(mtInfo,nUsingPath,sUsingPath);
|
||||
r(mtNote,nFolderNotFound,sFolderNotFound);
|
||||
@ -3578,6 +3589,49 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPas2jsCompiler.HandleOptionM(aValue: String; Quick: Boolean): Boolean;
|
||||
var
|
||||
Negated: Boolean;
|
||||
ms: TModeSwitch;
|
||||
begin
|
||||
Result:=True;
|
||||
if aValue='' then
|
||||
ParamFatal('invalid syntax mode (-M<x>) "'+aValue+'"');
|
||||
if Quick then exit;
|
||||
|
||||
case lowerCase(aValue) of
|
||||
'delphi': SetMode(p2jmDelphi);
|
||||
'objfpc': SetMode(p2jmObjFPC);
|
||||
else
|
||||
if aValue[length(aValue)]='-' then
|
||||
begin
|
||||
aValue:=LeftStr(aValue,length(aValue)-1);
|
||||
Negated:=true;
|
||||
end else
|
||||
Negated:=false;
|
||||
for ms in TModeSwitch do
|
||||
if (ms in msAllPas2jsModeSwitches)
|
||||
and SameText(SModeSwitchNames[ms],aValue) then
|
||||
begin
|
||||
if (ms in ModeSwitches)<>Negated then
|
||||
begin
|
||||
// already set
|
||||
exit;
|
||||
end else if ms in msAllPas2jsModeSwitchesReadOnly then
|
||||
ParamFatal('modeswitch is read only -M"'+aValue+'"')
|
||||
else begin
|
||||
// switch
|
||||
if Negated then
|
||||
ModeSwitches:=ModeSwitches-[ms]
|
||||
else
|
||||
ModeSwitches:=ModeSwitches+[ms];
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
ParamFatal('invalid syntax mode (-M) "'+aValue+'"');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2jsCompiler.HandleOptionConfigFile(aPos: Integer; const aFileName: string);
|
||||
|
||||
Var
|
||||
@ -3612,6 +3666,7 @@ Var
|
||||
pl: TPasToJsPlatform;
|
||||
s: string;
|
||||
pbi: TPas2JSBuiltInName;
|
||||
ms: TModeSwitch;
|
||||
begin
|
||||
// write information and halt
|
||||
InfoMsg:='';
|
||||
@ -3667,6 +3722,12 @@ begin
|
||||
// write list of supported JS processors
|
||||
for pr in TPasToJsProcessor do
|
||||
Log.LogPlain(PasToJsProcessorNames[pr]);
|
||||
'm':
|
||||
begin
|
||||
// write list of supported modeswitches
|
||||
for ms in (msAllPas2jsModeSwitches-AllLanguageModes) do
|
||||
Log.LogPlain(SModeSwitchNames[ms]);
|
||||
end;
|
||||
'o':
|
||||
begin
|
||||
// write list of optimizations
|
||||
@ -3808,14 +3869,8 @@ begin
|
||||
UnknownParam;
|
||||
end;
|
||||
'M': // syntax mode
|
||||
begin
|
||||
case lowerCase(aValue) of
|
||||
'delphi': Mode:=p2jmDelphi;
|
||||
'objfpc': Mode:=p2jmObjFPC;
|
||||
else
|
||||
ParamFatal('invalid syntax mode (-M) "'+aValue+'"');
|
||||
end;
|
||||
end;
|
||||
if not HandleOptionM(aValue,Quick) then
|
||||
UnknownParam;
|
||||
'N':
|
||||
begin
|
||||
if aValue='' then
|
||||
@ -3989,14 +4044,15 @@ var
|
||||
Enabled, Disabled: string;
|
||||
i: Integer;
|
||||
begin
|
||||
ReadSingleLetterOptions(Param,p,'2acdm',Enabled,Disabled);
|
||||
ReadSingleLetterOptions(Param,p,'2acdmj',Enabled,Disabled);
|
||||
for i:=1 to length(Enabled) do begin
|
||||
case Enabled[i] of
|
||||
'2': Mode:=p2jmObjFPC;
|
||||
'2': SetMode(p2jmObjFPC);
|
||||
'a': Options:=Options+[coAssertions];
|
||||
'c': Options:=Options+[coAllowCAssignments];
|
||||
'd': Mode:=p2jmDelphi;
|
||||
'd': SetMode(p2jmDelphi);
|
||||
'm': Options:=Options+[coAllowMacros];
|
||||
'j': Options:=Options+[coWriteableConst];
|
||||
end;
|
||||
end;
|
||||
for i:=1 to length(Disabled) do begin
|
||||
@ -4006,6 +4062,7 @@ begin
|
||||
'c': Options:=Options-[coAllowCAssignments];
|
||||
'd': ;
|
||||
'm': Options:=Options-[coAllowMacros];
|
||||
'j': Options:=Options-[coWriteableConst];
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -4367,7 +4424,7 @@ begin
|
||||
FMainSrcFile:='';
|
||||
FOptions:=DefaultP2jsCompilerOptions;
|
||||
FRTLVersionCheck:=DefaultP2jsRTLVersionCheck;
|
||||
FMode:=p2jmObjFPC;
|
||||
FModeSwitches:=p2jsMode_SwitchSets[p2jmObjFPC];
|
||||
FConverterGlobals.Reset;
|
||||
FConverterGlobals.RTLVersion:=(VersionMajor*100+VersionMinor)*100+VersionRelease;
|
||||
FConverterGlobals.TargetPlatform:=PlatformBrowser;
|
||||
@ -4593,6 +4650,7 @@ begin
|
||||
w(' -iV : Write short compiler version');
|
||||
w(' -iW : Write full compiler version');
|
||||
w(' -ic : Write list of supported JS processors usable by -P<x>');
|
||||
w(' -im : Write list of supported modeswitches usable by -M<x>');
|
||||
w(' -io : Write list of supported optimizations usable by -Oo<x>');
|
||||
w(' -it : Write list of supported targets usable by -T<x>');
|
||||
w(' -iJ : Write list of supported JavaScript identifiers -JoRTL-<x>');
|
||||
@ -4648,8 +4706,12 @@ begin
|
||||
w(' -Ju<x>: Add <x> to foreign unit paths. Foreign units are not compiled.');
|
||||
WritePrecompiledFormats;
|
||||
w(' -l : Write logo');
|
||||
w(' -MDelphi: Delphi 7 compatibility mode');
|
||||
w(' -MObjFPC: FPC''s Object Pascal compatibility mode (default)');
|
||||
w(' -M<x> : Set language mode or enable/disable a modeswitch');
|
||||
w(' -MDelphi: Delphi 7 compatibility mode');
|
||||
w(' -MObjFPC: FPC''s Object Pascal compatibility mode (default)');
|
||||
w(' -M<x> : enable or disable modeswitch, see option -im');
|
||||
w(' Each mode (as listed above) enables its default set of modeswitches.');
|
||||
w(' Other modeswitches are disabled and need to be enabled one by another.');
|
||||
w(' -NS<x> : obsolete: add <x> to namespaces. Same as -FN<x>');
|
||||
w(' -n : Do not read the default config files');
|
||||
w(' -o<x> : Change main JavaScript file to <x>, "." means stdout');
|
||||
@ -4665,11 +4727,12 @@ begin
|
||||
w(' -Pecmascript5: default');
|
||||
w(' -Pecmascript6');
|
||||
w(' -S<x> : Syntax options. <x> is a combination of the following letters:');
|
||||
w(' 2 : Same as -Mobjfpc (default)');
|
||||
w(' a : Turn on assertions');
|
||||
w(' c : Support operators like C (*=,+=,/= and -=)');
|
||||
w(' d : Same as -Mdelphi');
|
||||
w(' j : Allows typed constants to be writeable (default)');
|
||||
w(' m : Enables macro replacements');
|
||||
w(' 2 : Same as -Mobjfpc (default)');
|
||||
w(' -SI<x> : Set interface style to <x>');
|
||||
w(' -SIcom : COM, reference counted interface (default)');
|
||||
w(' -SIcorba: CORBA interface');
|
||||
@ -4739,14 +4802,25 @@ procedure TPas2jsCompiler.WriteOptions;
|
||||
var
|
||||
co: TP2jsCompilerOption;
|
||||
fco: TP2jsFSOption;
|
||||
ms: TModeSwitch;
|
||||
begin
|
||||
// message encoding
|
||||
WriteEncoding;
|
||||
// target platform
|
||||
Log.LogMsgIgnoreFilter(nTargetPlatformIs,[PasToJsPlatformNames[TargetPlatform]]);
|
||||
Log.LogMsgIgnoreFilter(nTargetProcessorIs,[PasToJsProcessorNames[TargetProcessor]]);
|
||||
// default syntax mode
|
||||
Log.LogMsgIgnoreFilter(nSyntaxModeIs,[p2jscModeNames[Mode]]);
|
||||
// syntax mode
|
||||
for ms in msAllPas2jsModeSwitches do
|
||||
case ms of
|
||||
msObjfpc:
|
||||
if ms in ModeSwitches then
|
||||
Log.LogMsgIgnoreFilter(nSyntaxModeIs,[p2jscModeNames[p2jmObjFPC]]);
|
||||
msDelphi:
|
||||
if ms in ModeSwitches then
|
||||
Log.LogMsgIgnoreFilter(nSyntaxModeIs,[p2jscModeNames[p2jmDelphi]]);
|
||||
else
|
||||
Log.LogMsgIgnoreFilter(nModeswitchXisY,[SModeSwitchNames[ms],BoolToStr(ms in ModeSwitches,'on','off')]);
|
||||
end;
|
||||
Log.LogMsgIgnoreFilter(nClassInterfaceStyleIs,[InterfaceTypeNames[InterfaceType]]);
|
||||
// boolean options
|
||||
for co in TP2jsCompilerOption do
|
||||
@ -4808,6 +4882,33 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPas2jsCompiler.WriteInfo;
|
||||
var
|
||||
Flags: string;
|
||||
|
||||
procedure AppendFlag(const s: string);
|
||||
begin
|
||||
if s='' then exit;
|
||||
if Flags='' then
|
||||
Flags:=Space(Log.Indent)
|
||||
else
|
||||
Flags:=Flags+',';
|
||||
if length(Flags)+length(s)>Log.LineLen then
|
||||
begin
|
||||
Log.LogPlain(Flags);
|
||||
Flags:=Space(Log.Indent);
|
||||
end;
|
||||
Flags:=Flags+s;
|
||||
end;
|
||||
|
||||
procedure FlushFlags;
|
||||
begin
|
||||
if Flags='' then exit;
|
||||
Log.LogPlain(Flags);
|
||||
Flags:='';
|
||||
end;
|
||||
|
||||
var
|
||||
ms: TModeSwitch;
|
||||
begin
|
||||
WriteVersionLine;
|
||||
Log.LogLn;
|
||||
@ -4821,10 +4922,30 @@ begin
|
||||
Log.LogPlain('Supported CPU instruction sets:');
|
||||
Log.LogPlain(' ECMAScript5, ECMAScript6');
|
||||
Log.LogLn;
|
||||
|
||||
Log.LogPlain('Recognized compiler and RTL features:');
|
||||
Log.LogPlain(' RTTI,CLASSES,EXCEPTIONS,EXITCODE,RANDOM,DYNARRAYS,COMMANDARGS,');
|
||||
Log.LogPlain(' UNICODESTRINGS');
|
||||
Flags:='';
|
||||
AppendFlag('INITFINAL');
|
||||
AppendFlag('RTTI');
|
||||
AppendFlag('CLASSES');
|
||||
AppendFlag('EXCEPTIONS');
|
||||
AppendFlag('EXITCODE');
|
||||
AppendFlag('WIDESTRINGS');
|
||||
AppendFlag('RANDOM');
|
||||
AppendFlag('DYNARRAYS');
|
||||
AppendFlag('COMMANDARGS');
|
||||
AppendFlag('RESOURCES');
|
||||
AppendFlag('UNICODESTRINGS');
|
||||
FlushFlags;
|
||||
Log.LogLn;
|
||||
|
||||
Log.LogPlain('Recognized modeswitches:');
|
||||
Flags:='';
|
||||
for ms in (msAllPas2jsModeSwitches-AllLanguageModes) do
|
||||
AppendFlag(SModeSwitchNames[ms]);
|
||||
FlushFlags;
|
||||
Log.LogLn;
|
||||
|
||||
Log.LogPlain('Supported Optimizations:');
|
||||
Log.LogPlain(' EnumNumbers');
|
||||
Log.LogPlain(' RemoveNotUsedPrivates');
|
||||
@ -5056,7 +5177,7 @@ begin
|
||||
Result:=FMainJSFileResolved;
|
||||
end;
|
||||
|
||||
function TPas2jsCompiler.GetUnitInfo(const UseUnitName, InFileName,
|
||||
function TPas2jsCompiler.GetUnitInfo(UseUnitName, InFileName,
|
||||
ModuleDir: String; PCUSupport: TPCUSupport): TFindUnitInfo;
|
||||
|
||||
var
|
||||
@ -5116,6 +5237,8 @@ begin
|
||||
|
||||
if InFilename='' then
|
||||
begin
|
||||
CheckUnitAlias(UseUnitName);
|
||||
|
||||
if Pos('.',UseUnitname)<1 then
|
||||
begin
|
||||
// generic unit name -> search with namespaces
|
||||
@ -5175,6 +5298,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPas2jsCompiler.CheckUnitAlias(var UseUnitName: string);
|
||||
begin
|
||||
if UseUnitName='' then ;
|
||||
end;
|
||||
|
||||
function TPas2jsCompiler.LoadUsedUnit(Info: TLoadUnitInfo;
|
||||
Context: TPas2jsCompilerFile): TPas2jsCompilerFile;
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -25,7 +25,7 @@ unit pas2jslibcompiler;
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Classes,
|
||||
SysUtils, Classes, Math,
|
||||
FPPJsSrcMap, Pas2jsFileCache, Pas2JSCompiler, Pas2jsPCUCompiler,
|
||||
Pas2JSCompilerCfg, Pas2JSCompilerPP;
|
||||
|
||||
@ -47,6 +47,8 @@ Type
|
||||
AFileData : PAnsiChar; Var AFileDataLen: Int32); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
TReadDirCallBack = Function (Data : Pointer;
|
||||
P : PDirectoryCache; ADirPath: PAnsiChar): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
TUnitAliasCallBack = Function (Data: Pointer;
|
||||
AUnitName: PAnsiChar; AUnitNameMaxLen: Integer): boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
|
||||
{ TLibraryPas2JSCompiler }
|
||||
|
||||
@ -60,6 +62,8 @@ Type
|
||||
FOnReadDirData: Pointer;
|
||||
FOnReadPasData: Pointer;
|
||||
FOnReadPasFile: TReadPasCallBack;
|
||||
FOnUnitAlias: TUnitAliasCallBack;
|
||||
FOnUnitAliasData: Pointer;
|
||||
FOnWriteJSCallBack: TWriteJSCallBack;
|
||||
FOnWriteJSData: Pointer;
|
||||
FReadBufferLen: Cardinal;
|
||||
@ -71,6 +75,7 @@ Type
|
||||
Function ReadDirectory(Dir: TPas2jsCachedDirectory): boolean; virtual;
|
||||
Public
|
||||
Constructor Create; override;
|
||||
procedure CheckUnitAlias(var UseUnitName: string); override;
|
||||
Procedure DoLibraryLog(Sender : TObject; Const Msg : String);
|
||||
Function LibraryRun(ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) :Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
Property LastError : String Read FLastError Write FLastError;
|
||||
@ -84,6 +89,8 @@ Type
|
||||
Property ReadBufferLen : Cardinal Read FReadBufferLen Write FReadBufferLen;
|
||||
Property OnReadDir: TReadDirCallBack read FOnReadDir write FOnReadDir;
|
||||
Property OnReadDirData: Pointer read FOnReadDirData write FOnReadDirData;
|
||||
Property OnUnitAlias: TUnitAliasCallBack read FOnUnitAlias write FOnUnitAlias;
|
||||
Property OnUnitAliasData: Pointer read FOnUnitAliasData write FOnUnitAliasData;
|
||||
end;
|
||||
|
||||
Type
|
||||
@ -95,6 +102,7 @@ Procedure SetPas2JSReadPasCallBack(P : PPas2JSCompiler; ACallBack : TReadPasCall
|
||||
Procedure SetPas2JSReadDirCallBack(P : PPas2JSCompiler; ACallBack : TReadDirCallBack; CallBackData : Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
Procedure AddPas2JSDirectoryEntry(P: PDirectoryCache; AFilename: PAnsiChar;
|
||||
AAge: TPas2jsFileAgeTime; AAttr: TPas2jsFileAttr; ASize: TPas2jsFileSize); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
Procedure SetPas2JSUnitAliasCallBack(P : PPas2JSCompiler; ACallBack : TUnitAliasCallBack; CallBackData : Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
Function RunPas2JSCompiler(P : PPas2JSCompiler; ACompilerExe, AWorkingDir : PAnsiChar; CommandLine : PPAnsiChar; DoReset : Boolean) : Boolean; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
Procedure FreePas2JSCompiler(P : PPas2JSCompiler); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
Function GetPas2JSCompiler : PPas2JSCompiler; {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
@ -129,8 +137,8 @@ begin
|
||||
end;
|
||||
|
||||
procedure TLibraryPas2JSCompiler.GetLastError(AError: PAnsiChar;
|
||||
Var AErrorLength: Longint; AErrorClass: PAnsiChar;
|
||||
Var AErrorClassLength: Longint);
|
||||
var AErrorLength: Longint; AErrorClass: PAnsiChar;
|
||||
var AErrorClassLength: Longint);
|
||||
|
||||
Var
|
||||
L : Integer;
|
||||
@ -192,6 +200,23 @@ begin
|
||||
PostProcessorSupport:=TPas2JSFSPostProcessorSupport.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TLibraryPas2JSCompiler.CheckUnitAlias(var UseUnitName: string);
|
||||
var
|
||||
UnitNameLen, UnitNameMaxLen: Integer;
|
||||
s: String;
|
||||
begin
|
||||
inherited CheckUnitAlias(UseUnitName);
|
||||
UnitNameLen:=length(UseUnitName);
|
||||
if (UnitNameLen>0) and Assigned(OnUnitAlias) then
|
||||
begin
|
||||
UnitNameMaxLen:=Max(UnitNameLen,255);
|
||||
s:=UseUnitName;
|
||||
SetLength(s,UnitNameMaxLen);
|
||||
if OnUnitAlias(OnUnitAliasData,Pointer(s),UnitNameMaxLen) then
|
||||
UseUnitName:=LeftStr(s,UnitNameLen);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLibraryPas2JSCompiler.DoLibraryLog(Sender: TObject; const Msg: String);
|
||||
begin
|
||||
if Assigned(FOnLibLogCallBack) then
|
||||
@ -286,10 +311,16 @@ begin
|
||||
TPas2jsCachedDirectory(P).Add(AFilename,AAge,AAttr,ASize);
|
||||
end;
|
||||
|
||||
procedure SetPas2JSUnitAliasCallBack(P: PPas2JSCompiler;
|
||||
ACallBack: TUnitAliasCallBack; CallBackData: Pointer); {$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
begin
|
||||
TLibraryPas2JSCompiler(P).OnUnitAlias:=ACallBack;
|
||||
TLibraryPas2JSCompiler(P).OnUnitAliasData:=CallBackData;
|
||||
end;
|
||||
|
||||
function RunPas2JSCompiler(P: PPas2JSCompiler; ACompilerExe,
|
||||
AWorkingDir: PAnsiChar; CommandLine: PPAnsiChar; DoReset: Boolean): Boolean;
|
||||
{$IFDEF UseCDecl}cdecl{$ELSE}stdcall{$ENDIF};
|
||||
|
||||
begin
|
||||
Result:=TLibraryPas2JSCompiler(P).LibraryRun(ACompilerExe,AWorkingDir,CommandLine,DoReset)
|
||||
end;
|
||||
|
||||
@ -119,12 +119,14 @@ type
|
||||
private
|
||||
FDebugLog: TPas2JSStream;
|
||||
FEncoding: string;
|
||||
FIndent: integer;
|
||||
FLastMsgCol: integer;
|
||||
FLastMsgFile: string;
|
||||
FLastMsgLine: integer;
|
||||
FLastMsgNumber: integer;
|
||||
FLastMsgTxt: string;
|
||||
FLastMsgType: TMessageType;
|
||||
FLineLen: integer;
|
||||
FMsgNumberDisabled: TIntegerDynArray;// sorted ascending
|
||||
FMsg: TFPList; // list of TPas2jsMessage
|
||||
FOnFormatPath: TPScannerFormatPathEvent;
|
||||
@ -212,6 +214,8 @@ type
|
||||
property LastMsgTxt: string read FLastMsgTxt write FLastMsgTxt;
|
||||
property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
|
||||
property DebugLog: TPas2jsStream read FDebugLog write FDebugLog;
|
||||
property LineLen: integer read FLineLen write FLineLen; // used by LogPlainText
|
||||
property Indent: integer read FIndent write FIndent; // used by LogPlainText
|
||||
end;
|
||||
|
||||
function CompareP2JMessage(Item1, Item2: {$IFDEF Pas2JS}JSValue{$ELSE}Pointer{$ENDIF}): Integer;
|
||||
@ -723,6 +727,8 @@ constructor TPas2jsLogger.Create;
|
||||
begin
|
||||
FMsg:=TFPList.Create;
|
||||
FShowMsgTypes:=DefaultLogMsgTypes;
|
||||
FLineLen:=78;
|
||||
FIndent:=2;
|
||||
end;
|
||||
|
||||
destructor TPas2jsLogger.Destroy;
|
||||
|
||||
@ -34,7 +34,7 @@ uses
|
||||
PasTree, PScanner, PasResolveEval,
|
||||
FPPas2Js,
|
||||
Pas2jsCompiler, Pas2JSFS, Pas2JSFSCompiler, Pas2JsFiler,
|
||||
Pas2jsLogger, Pas2jsFileUtils;
|
||||
Pas2jsLogger, Pas2jsFileUtils, FPPJsSrcMap;
|
||||
|
||||
Type
|
||||
|
||||
@ -79,6 +79,7 @@ Type
|
||||
Private
|
||||
FPrecompileFormat: TPas2JSPrecompileFormat;
|
||||
Protected
|
||||
function CreateJSMapper: TPas2JSMapper; override;
|
||||
procedure WritePrecompiledFormats; override;
|
||||
function CreateCompilerFile(const PasFileName, PCUFilename: String): TPas2jsCompilerFile; override;
|
||||
procedure HandleOptionPCUFormat(Value: string); override;
|
||||
@ -397,6 +398,13 @@ end;
|
||||
|
||||
{ TPas2jsPCUCompiler }
|
||||
|
||||
function TPas2jsPCUCompiler.CreateJSMapper: TPas2JSMapper;
|
||||
begin
|
||||
Result:=inherited CreateJSMapper;
|
||||
if PrecompileFormat<>nil then
|
||||
Result.PCUExt:='.'+PrecompileFormat.Ext;
|
||||
end;
|
||||
|
||||
procedure TPas2jsPCUCompiler.WritePrecompiledFormats;
|
||||
Var
|
||||
I: Integer;
|
||||
|
||||
@ -5,7 +5,13 @@ unit pas2jsresources;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, pas2jsfs, jsTree;
|
||||
Classes, SysUtils,
|
||||
{$IFDEF pas2js}
|
||||
web,
|
||||
{$ELSE}
|
||||
base64,
|
||||
{$ENDIF}
|
||||
pas2jsfs, jsTree;
|
||||
|
||||
Type
|
||||
TResourceScopeMode = (rmProgram,rmUnit);
|
||||
@ -62,10 +68,8 @@ Type
|
||||
function GetResourceCount: Integer; override;
|
||||
function GetAsString: String; override;
|
||||
end;
|
||||
implementation
|
||||
|
||||
{$IFNDEF PAS2JS}
|
||||
uses base64;
|
||||
implementation
|
||||
|
||||
{ TNoResources }
|
||||
|
||||
@ -92,8 +96,6 @@ begin
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
{$ENDIF}
|
||||
|
||||
{ TPas2jsResourceHandler }
|
||||
|
||||
|
||||
@ -148,7 +150,11 @@ Var
|
||||
|
||||
begin
|
||||
F:=LoadFile(aFileName);
|
||||
{$IFDEF pas2js}
|
||||
Result:=window.atob(F.Source);
|
||||
{$ELSE}
|
||||
Result:=EncodeStringBase64(F.Source);
|
||||
{$ENDIF}
|
||||
// Do not release, FS will release all files
|
||||
end;
|
||||
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry,
|
||||
TCModules, FPPas2Js;
|
||||
TCModules, FPPas2Js, PScanner, PasResolveEval;
|
||||
|
||||
type
|
||||
|
||||
@ -34,9 +34,12 @@ type
|
||||
//Procedure TestGen_Class_ReferGenClass_DelphiFail;
|
||||
Procedure TestGen_Class_ClassConstructor;
|
||||
// ToDo: rename local const T
|
||||
Procedure TestGen_Class_TypeCastSpecializesWarn;
|
||||
|
||||
// generic external class
|
||||
procedure TestGen_ExtClass_Array;
|
||||
// ToDo: TestGen_ExtClass_GenJSValueAssign TExt<JSValue> := TExt<Word>
|
||||
// ToDo: TestGen_ExtClass_TypeCastJSValue TExt<Word>(aTExt<JSValue>) and vice versa
|
||||
|
||||
// statements
|
||||
Procedure TestGen_InlineSpec_Constructor;
|
||||
@ -628,6 +631,53 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Class_TypeCastSpecializesWarn;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode delphi}',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird<T> = class F: T; end;',
|
||||
' TBirdWord = TBird<Word>;',
|
||||
' TBirdChar = TBird<Char>;',
|
||||
'var',
|
||||
' w: TBirdWord;',
|
||||
' c: TBirdChar;',
|
||||
'begin',
|
||||
' w:=TBirdWord(c);',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestGen_Class_TypeCastSpecializesWarn',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass($mod, "TBird$G1", $mod.TObject, function () {',
|
||||
' this.$init = function () {',
|
||||
' $mod.TObject.$init.call(this);',
|
||||
' this.F = 0;',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass($mod, "TBird$G2", $mod.TObject, function () {',
|
||||
' this.$init = function () {',
|
||||
' $mod.TObject.$init.call(this);',
|
||||
' this.F = "";',
|
||||
' };',
|
||||
'});',
|
||||
'this.w = null;',
|
||||
'this.c = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.w = $mod.c;',
|
||||
'']));
|
||||
CheckHint(mtWarning,nClassTypesAreNotRelatedXY,'Class types "TBird$G2<Char>" and "TBird$G1<Word>" are not related');
|
||||
CheckResolverUnexpectedHints();
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_ExtClass_Array;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
@ -339,6 +339,7 @@ type
|
||||
Procedure TestProc_LocalVarAbsolute;
|
||||
Procedure TestProc_LocalVarInit;
|
||||
Procedure TestProc_ReservedWords;
|
||||
Procedure TestProc_ConstRefWord;
|
||||
|
||||
// anonymous functions
|
||||
Procedure TestAnonymousProc_Assign_ObjFPC;
|
||||
@ -434,6 +435,7 @@ type
|
||||
Procedure TestArray_SetLengthProperty;
|
||||
Procedure TestArray_SetLengthMultiDim;
|
||||
Procedure TestArray_OpenArrayOfString;
|
||||
Procedure TestArray_ConstRef;
|
||||
Procedure TestArray_Concat;
|
||||
Procedure TestArray_Copy;
|
||||
Procedure TestArray_InsertDelete;
|
||||
@ -456,6 +458,7 @@ type
|
||||
Procedure TestRecord_WithDo;
|
||||
Procedure TestRecord_Assign;
|
||||
Procedure TestRecord_AsParams;
|
||||
Procedure TestRecord_ConstRef;
|
||||
Procedure TestRecordElement_AsParams;
|
||||
Procedure TestRecordElementFromFuncResult_AsParams;
|
||||
Procedure TestRecordElementFromWith_AsParams;
|
||||
@ -526,7 +529,8 @@ type
|
||||
Procedure TestClass_ExternalOverrideFail;
|
||||
Procedure TestClass_ExternalVar;
|
||||
Procedure TestClass_Const;
|
||||
Procedure TestClass_LocalConstDuplicate;
|
||||
Procedure TestClass_LocalConstDuplicate_Prg;
|
||||
Procedure TestClass_LocalConstDuplicate_Unit;
|
||||
// ToDo: Procedure TestAdvRecord_LocalConstDuplicate;
|
||||
Procedure TestClass_LocalVarSelfFail;
|
||||
Procedure TestClass_ArgSelfFail;
|
||||
@ -4528,7 +4532,7 @@ begin
|
||||
' Nan:=&bOolean;',
|
||||
'end;',
|
||||
'begin',
|
||||
' Date(1);']);
|
||||
' Date(1);']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestProc_ReservedWords',
|
||||
LinesToStr([ // statements
|
||||
@ -4545,6 +4549,50 @@ begin
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestProc_ConstRefWord;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure Run(constref w: word);',
|
||||
'var l: word;',
|
||||
'begin',
|
||||
' l:=w;',
|
||||
' Run(w);',
|
||||
' Run(l);',
|
||||
'end;',
|
||||
'procedure Fly(a: word; var b: word; out c: word; const d: word; constref e: word);',
|
||||
'begin',
|
||||
' Run(a);',
|
||||
' Run(b);',
|
||||
' Run(c);',
|
||||
' Run(d);',
|
||||
' Run(e);',
|
||||
'end;',
|
||||
'begin',
|
||||
' Run(1);']);
|
||||
ConvertProgram;
|
||||
CheckHint(mtWarning,nConstRefNotForXAsConst,'ConstRef not yet implemented for Word. Treating as Const');
|
||||
CheckSource('TestProc_ConstRefWord',
|
||||
LinesToStr([ // statements
|
||||
'this.Run = function (w) {',
|
||||
' var l = 0;',
|
||||
' l = w;',
|
||||
' $mod.Run(w);',
|
||||
' $mod.Run(l);',
|
||||
'};',
|
||||
'this.Fly = function (a, b, c, d, e) {',
|
||||
' $mod.Run(a);',
|
||||
' $mod.Run(b.get());',
|
||||
' $mod.Run(c.get());',
|
||||
' $mod.Run(d);',
|
||||
' $mod.Run(e);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.Run(1);'
|
||||
]));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestAnonymousProc_Assign_ObjFPC;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -7981,38 +8029,40 @@ end;
|
||||
procedure TTestModule.TestTryExcept;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add('type');
|
||||
Add(' TObject = class end;');
|
||||
Add(' Exception = class Msg: string; end;');
|
||||
Add(' EInvalidCast = class(Exception) end;');
|
||||
Add('var vI: longint;');
|
||||
Add('begin');
|
||||
Add(' try');
|
||||
Add(' vi:=1;');
|
||||
Add(' except');
|
||||
Add(' vi:=2');
|
||||
Add(' end;');
|
||||
Add(' try');
|
||||
Add(' vi:=3;');
|
||||
Add(' except');
|
||||
Add(' raise;');
|
||||
Add(' end;');
|
||||
Add(' try');
|
||||
Add(' VI:=4;');
|
||||
Add(' except');
|
||||
Add(' on einvalidcast do');
|
||||
Add(' raise;');
|
||||
Add(' on E: exception do');
|
||||
Add(' if e.msg='''' then');
|
||||
Add(' raise e;');
|
||||
Add(' else');
|
||||
Add(' vi:=5');
|
||||
Add(' end;');
|
||||
Add(' try');
|
||||
Add(' VI:=6;');
|
||||
Add(' except');
|
||||
Add(' on einvalidcast do ;');
|
||||
Add(' end;');
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' Exception = class Msg: string; end;',
|
||||
' EInvalidCast = class(Exception) end;',
|
||||
'var vI: longint;',
|
||||
'begin',
|
||||
' try',
|
||||
' vi:=1;',
|
||||
' except',
|
||||
' vi:=2',
|
||||
' end;',
|
||||
' try',
|
||||
' vi:=3;',
|
||||
' except',
|
||||
' raise;',
|
||||
' end;',
|
||||
' try',
|
||||
' VI:=4;',
|
||||
' except',
|
||||
' on einvalidcast do',
|
||||
' raise;',
|
||||
' on E: exception do',
|
||||
' if e.msg='''' then',
|
||||
' raise e;',
|
||||
' else',
|
||||
' vi:=5',
|
||||
' end;',
|
||||
' try',
|
||||
' VI:=6;',
|
||||
' except',
|
||||
' on einvalidcast do ;',
|
||||
' end;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestTryExcept',
|
||||
LinesToStr([ // statements
|
||||
@ -9320,6 +9370,46 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArray_ConstRef;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type TArr = array of word;',
|
||||
'procedure Run(constref a: TArr);',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure Fly(a: TArr; var b: TArr; out c: TArr; const d: TArr; constref e: TArr);',
|
||||
'var l: TArr;',
|
||||
'begin',
|
||||
' Run(l);',
|
||||
' Run(a);',
|
||||
' Run(b);',
|
||||
' Run(c);',
|
||||
' Run(d);',
|
||||
' Run(e);',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckResolverUnexpectedHints();
|
||||
CheckSource('TestArray_ConstRef',
|
||||
LinesToStr([ // statements
|
||||
'this.Run = function (a) {',
|
||||
'};',
|
||||
'this.Fly = function (a, b, c, d, e) {',
|
||||
' var l = [];',
|
||||
' $mod.Run(l);',
|
||||
' $mod.Run(a);',
|
||||
' $mod.Run(b.get());',
|
||||
' $mod.Run(c.get());',
|
||||
' $mod.Run(d);',
|
||||
' $mod.Run(e);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestArray_Concat;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -10388,6 +10478,56 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRecord_ConstRef;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type TRec = record i: word; end;',
|
||||
'procedure Run(constref a: TRec);',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure Fly(a: TRec; var b: TRec; out c: TRec; const d: TRec; constref e: TRec);',
|
||||
'var l: TRec;',
|
||||
'begin',
|
||||
' Run(l);',
|
||||
' Run(a);',
|
||||
' Run(b);',
|
||||
' Run(c);',
|
||||
' Run(d);',
|
||||
' Run(e);',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckResolverUnexpectedHints();
|
||||
CheckSource('TestRecord_ConstRef',
|
||||
LinesToStr([ // statements
|
||||
'rtl.recNewT($mod, "TRec", function () {',
|
||||
' this.i = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.i === b.i;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.i = s.i;',
|
||||
' return this;',
|
||||
' };',
|
||||
'});',
|
||||
'this.Run = function (a) {',
|
||||
'};',
|
||||
'this.Fly = function (a, b, c, d, e) {',
|
||||
' var l = $mod.TRec.$new();',
|
||||
' $mod.Run(l);',
|
||||
' $mod.Run(a);',
|
||||
' $mod.Run(b);',
|
||||
' $mod.Run(c);',
|
||||
' $mod.Run(d);',
|
||||
' $mod.Run(e);',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestRecordElement_AsParams;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -14109,7 +14249,7 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_LocalConstDuplicate;
|
||||
procedure TTestModule.TestClass_LocalConstDuplicate_Prg;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
@ -14140,7 +14280,7 @@ begin
|
||||
'begin',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestClass_LocalConstDuplicate',
|
||||
CheckSource('TestClass_LocalConstDuplicate_Prg',
|
||||
LinesToStr([
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.cI = 3;',
|
||||
@ -14168,6 +14308,66 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_LocalConstDuplicate_Unit;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add([
|
||||
'interface',
|
||||
'type',
|
||||
' TObject = class',
|
||||
' const cI: longint = 3;',
|
||||
' procedure Fly;',
|
||||
' procedure Run;',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' procedure Go;',
|
||||
' end;',
|
||||
'implementation',
|
||||
'procedure tobject.fly;',
|
||||
'const cI: word = 4;',
|
||||
'begin',
|
||||
' if cI=Self.cI then ;',
|
||||
'end;',
|
||||
'procedure tobject.run;',
|
||||
'const cI: word = 5;',
|
||||
'begin',
|
||||
' if cI=Self.cI then ;',
|
||||
'end;',
|
||||
'procedure tbird.go;',
|
||||
'const cI: word = 6;',
|
||||
'begin',
|
||||
' if cI=Self.cI then ;',
|
||||
'end;',
|
||||
'']);
|
||||
ConvertUnit;
|
||||
CheckSource('TestClass_LocalConstDuplicate_Unit',
|
||||
LinesToStr([
|
||||
'rtl.createClass($mod, "TObject", null, function () {',
|
||||
' this.cI = 3;',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' var cI$1 = 4;',
|
||||
' this.Fly = function () {',
|
||||
' if (cI$1 === this.cI) ;',
|
||||
' };',
|
||||
' var cI$2 = 5;',
|
||||
' this.Run = function () {',
|
||||
' if (cI$2 === this.cI) ;',
|
||||
' };',
|
||||
'});',
|
||||
'rtl.createClass($mod, "TBird", $mod.TObject, function () {',
|
||||
' var cI$3 = 6;',
|
||||
' this.Go = function () {',
|
||||
' if (cI$3 === this.cI) ;',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
'',
|
||||
'');
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestClass_LocalVarSelfFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
@ -145,10 +145,15 @@ type
|
||||
procedure TestUS_Program_FE_o;
|
||||
procedure TestUS_IncludeSameDir;
|
||||
|
||||
// uses 'in' modifier
|
||||
procedure TestUS_UsesInFile;
|
||||
procedure TestUS_UsesInFile_Duplicate;
|
||||
procedure TestUS_UsesInFile_IndirectDuplicate;
|
||||
procedure TestUS_UsesInFile_WorkNotEqProgDir;
|
||||
procedure TestUS_UsesInFileTwice;
|
||||
|
||||
procedure TestUS_UseUnitTwiceFail;
|
||||
procedure TestUS_UseUnitTwiceViaNameSpace;
|
||||
end;
|
||||
|
||||
function LinesToStr(const Lines: array of string): string;
|
||||
@ -738,6 +743,7 @@ end;
|
||||
|
||||
procedure TTestCLI_UnitSearch.TestUS_UsesInFile_Duplicate;
|
||||
begin
|
||||
// check if using two different units with same name
|
||||
AddUnit('system.pp',[''],['']);
|
||||
AddUnit('unit1.pas',
|
||||
['var a: longint;'],
|
||||
@ -757,6 +763,7 @@ end;
|
||||
|
||||
procedure TTestCLI_UnitSearch.TestUS_UsesInFile_IndirectDuplicate;
|
||||
begin
|
||||
// check if using two different units with same name
|
||||
AddUnit('system.pp',[''],['']);
|
||||
AddUnit('unit1.pas',
|
||||
['var a: longint;'],
|
||||
@ -791,6 +798,51 @@ begin
|
||||
Compile(['sub/test1.pas','-Jc']);
|
||||
end;
|
||||
|
||||
procedure TTestCLI_UnitSearch.TestUS_UsesInFileTwice;
|
||||
begin
|
||||
AddUnit('system.pp',[''],['']);
|
||||
AddUnit('unit1.pas',
|
||||
['var a: longint;'],
|
||||
['']);
|
||||
AddFile('test1.pas',[
|
||||
'uses foo in ''unit1.pas'', bar in ''unit1.pas'';',
|
||||
'begin',
|
||||
' bar.a:=foo.a;',
|
||||
' a:=a;',
|
||||
'end.']);
|
||||
Compile(['test1.pas','-Jc']);
|
||||
end;
|
||||
|
||||
procedure TTestCLI_UnitSearch.TestUS_UseUnitTwiceFail;
|
||||
begin
|
||||
AddUnit('system.pp',[''],['']);
|
||||
AddUnit('sub.unit1.pas',
|
||||
['var a: longint;'],
|
||||
['']);
|
||||
AddFile('test1.pas',[
|
||||
'uses sub.Unit1, sub.unit1;',
|
||||
'begin',
|
||||
' a:=a;',
|
||||
'end.']);
|
||||
Compile(['test1.pas','-FNsub','-Jc'],ExitCodeSyntaxError);
|
||||
AssertEquals('ErrorMsg','Duplicate identifier "sub.unit1"',ErrorMsg);
|
||||
end;
|
||||
|
||||
procedure TTestCLI_UnitSearch.TestUS_UseUnitTwiceViaNameSpace;
|
||||
begin
|
||||
AddUnit('system.pp',[''],['']);
|
||||
AddUnit('sub.unit1.pas',
|
||||
['var a: longint;'],
|
||||
['']);
|
||||
AddFile('test1.pas',[
|
||||
'uses unit1, sub.unit1;',
|
||||
'begin',
|
||||
' unit1.a:=sub.unit1.a;',
|
||||
' a:=a;',
|
||||
'end.']);
|
||||
Compile(['test1.pas','-FNsub','-Jc']);
|
||||
end;
|
||||
|
||||
Initialization
|
||||
RegisterTests([TTestCLI_UnitSearch]);
|
||||
end.
|
||||
|
||||
@ -133,6 +133,7 @@ Put + after a boolean switch option to enable it, - to disable it
|
||||
-iV : Write short compiler version
|
||||
-iW : Write full compiler version
|
||||
-ic : Write list of supported JS processors usable by -P<x>
|
||||
-im : Write list of supported modeswitches usable by -M<x>
|
||||
-io : Write list of supported optimizations usable by -Oo<x>
|
||||
-it : Write list of supported targets usable by -T<x>
|
||||
-iJ : Write list of supported JavaScript identifiers -JoRTL-<x>
|
||||
@ -179,8 +180,11 @@ Put + after a boolean switch option to enable it, - to disable it
|
||||
postprocessors in succession.
|
||||
-Ju<x> : Add <x> to foreign unit paths. Foreign units are not compiled.
|
||||
-l : Write logo
|
||||
-MDelphi: Delphi 7 compatibility mode
|
||||
-MObjFPC: FPC's Object Pascal compatibility mode (default)
|
||||
-M<x> : Set language mode or enable/disable a modeswitch
|
||||
-MDelphi: Delphi 7 compatibility mode
|
||||
-MObjFPC: FPC's Object Pascal compatibility mode (default)
|
||||
Each mode (as listed above) enables its default set of modeswitches.
|
||||
Other modeswitches are disabled and need to be enabled one by another.
|
||||
-NS<x> : obsolete: add <x> to namespaces. Same as -FN<x>
|
||||
-n : Do not read the default config files
|
||||
-o<x> : Change main JavaScript file to <x>, "." means stdout
|
||||
@ -196,11 +200,12 @@ Put + after a boolean switch option to enable it, - to disable it
|
||||
-Pecmascript5 : default
|
||||
-Pecmascript6
|
||||
-S<x> : Syntax options. <x> is a combination of the following letters:
|
||||
2 : Same as -Mobjfpc (default)
|
||||
a : Turn on assertions
|
||||
c : Support operators like C (*=,+=,/= and -=)
|
||||
d : Same as -Mdelphi
|
||||
m : Enables macro replacements
|
||||
2 : Same as -Mobjfpc (default)
|
||||
j : Allows typed constants to be writeable (default)
|
||||
-SI<x> : Set interface style to <x>
|
||||
-SIcom : COM, reference counted interface (default)
|
||||
-SIcorba : CORBA interface
|
||||
|
||||
@ -22,6 +22,7 @@ begin
|
||||
P.Description := 'Convert pascal sources to javascript.';
|
||||
P.Email := 'michael@freepascal.org';
|
||||
P.NeedLibC:= false;
|
||||
P.ShortName:='p2js';
|
||||
|
||||
P.Directory:=ADirectory;
|
||||
P.Version:='3.2.1';
|
||||
|
||||
@ -15,6 +15,7 @@ exports
|
||||
SetPas2JSWriteJSCallBack,
|
||||
SetPas2JSReadDirCallBack,
|
||||
AddPas2JSDirectoryEntry,
|
||||
SetPas2JSUnitAliasCallBack,
|
||||
SetPas2JSCompilerLogCallBack,
|
||||
GetPas2JSCompilerLastError;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user