Updated PS..
This commit is contained in:
Raymond
parent
3e953ae6be
commit
4db2ccf52a
|
|
@ -9,6 +9,7 @@
|
|||
{$UNDEF PS_FPCSTRINGWORKAROUND}
|
||||
{$DEFINE PS_RESBEFOREPARAMETERS}
|
||||
{$DEFINE x64_string_result_as_varparameter}
|
||||
{$DEFINE PS_RESULTFIRST}
|
||||
{FreePascal 2.3.1 and above has much Delphi compatibility bugs fixed}
|
||||
{$else}
|
||||
{$DEFINE FPC_OLD_FIX}
|
||||
|
|
|
|||
|
|
@ -407,9 +407,48 @@
|
|||
{$DEFINE 32BIT}
|
||||
{$DEFINE CPU32}
|
||||
{$ENDIF}
|
||||
|
||||
{$ENDIF MSWINDOWS}
|
||||
|
||||
{ defines for Delphi 2011 }
|
||||
{$IFDEF VER220}
|
||||
{$DEFINE VER140UP}
|
||||
{$DEFINE DELPHI}
|
||||
|
||||
{$DEFINE DELPHI15}
|
||||
{$DEFINE DELPHI1UP}
|
||||
{$DEFINE DELPHI2UP}
|
||||
{$DEFINE DELPHI3UP}
|
||||
{$DEFINE DELPHI4UP}
|
||||
{$DEFINE DELPHI5UP}
|
||||
{$DEFINE DELPHI6UP}
|
||||
{$DEFINE DELPHI7UP}
|
||||
{$DEFINE DELPHI9UP}
|
||||
{$DEFINE DELPHI10UP}
|
||||
{$DEFINE DELPHI11UP}
|
||||
{$DEFINE DELPHI12UP}
|
||||
{$DEFINE DELPHI14UP}
|
||||
{$DEFINE DELPHI15UP}
|
||||
|
||||
{$DEFINE DELPHI2011}
|
||||
{$DEFINE DELPHI2005UP}
|
||||
{$DEFINE DELPHI2006UP}
|
||||
{$DEFINE DELPHI2007UP}
|
||||
{$DEFINE DELPHI2009UP}
|
||||
{$DEFINE DELPHI2010UP}
|
||||
{$DEFINE DELPHI2011UP}
|
||||
{$DEFINE BDS}
|
||||
{$DEFINE BDS8}
|
||||
{$DEFINE BDS3UP}
|
||||
{$DEFINE BDS4UP}
|
||||
{$DEFINE BDS5UP}
|
||||
{$DEFINE BDS6UP}
|
||||
{$DEFINE BDS7UP}
|
||||
{$DEFINE BDS8UP}
|
||||
{$DEFINE 32BIT}
|
||||
{$DEFINE CPU32}
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{ defines for "Delphi for .NET" }
|
||||
{$IFDEF CLR}
|
||||
{$DEFINE DOTNET}
|
||||
|
|
@ -490,4 +529,14 @@
|
|||
{$DEFINE DARWIN64}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
{$DEFINE ENDIAN_LITTLE} // To have endianness symbol defined in Delphi too
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF DELPHI}
|
||||
{$DEFINE DELPHI_or_MSWINDOWS}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF MSWINDOWS}
|
||||
{$DEFINE DELPHI_or_MSWINDOWS}
|
||||
{$ENDIF}
|
||||
|
|
@ -2654,9 +2654,10 @@ begin
|
|||
end;
|
||||
|
||||
procedure FinalizeA(var s: tbtString); overload; begin s := ''; end;
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
procedure FinalizeW(var s: tbtwidestring); overload; begin s := ''; end;
|
||||
procedure FinalizeU(var s: tbtunicodestring); overload; begin s := ''; end;
|
||||
|
||||
{$ENDIF}
|
||||
procedure FinalizeVariant(var p: TIfRVariant);
|
||||
begin
|
||||
if (p.FType.BaseType = btString) or (p.FType.basetype = btSet) then
|
||||
|
|
@ -5187,15 +5188,19 @@ begin
|
|||
begin
|
||||
Params[c].ExpectedType := GetTypeNo(BlockInfo, Params[c].Val);
|
||||
if PType <> nil then
|
||||
if (Params[c].ExpectedType = nil) or not (Params[c].ExpectedType.BaseType in [btString, btWideString, btUnicodeString, btChar, btWideChar]) then begin
|
||||
if (Params[c].ExpectedType = nil) or not (Params[c].ExpectedType.BaseType in [btString,
|
||||
{$IFNDEF PS_NOWIDESTRING}btWideString, btUnicodeString, btWideChar,{$ENDIF}
|
||||
btChar]) then begin
|
||||
MakeError('', ecTypeMismatch, '');
|
||||
Result := False;
|
||||
exit;
|
||||
end;
|
||||
if Params[c].ExpectedType.BaseType = btChar then
|
||||
Params[c].ExpectedType := FindBaseType(btString) else
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if Params[c].ExpectedType.BaseType = btWideChar then
|
||||
Params[c].ExpectedType := FindBaseType(btUnicodeString);
|
||||
{$ENDIF}
|
||||
end else if (PType.BaseType = btArray) and (GetTypeNo(BlockInfo, Params[c].Val).BaseType = btArray) then
|
||||
begin
|
||||
if TPSArrayType(GetTypeNo(BlockInfo, Params[c].Val)).ArrayTypeNo <> TPSArrayType(PType).ArrayTypeNo then
|
||||
|
|
@ -5366,7 +5371,7 @@ function TPSPascalCompiler.ReadString: PIfRVariant;
|
|||
temp3 := temp3 + {$IFNDEF PS_NOWIDESTRING}{$IFDEF DELPHI6UP}System.{$IFDEF DELPHI2009UP}UTF8ToWidestring{$ELSE}UTF8Decode{$ENDIF}{$ENDIF}{$ENDIF}(PString(FParser.GetToken));
|
||||
{$IFNDEF PS_NOWIDESTRING}wchar:=true;{$ENDIF}
|
||||
end else
|
||||
temp3 := temp3 + tbtUnicodestring(PString(FParser.GetToken));
|
||||
temp3 := temp3 + {$IFNDEF PS_NOWIDESTRING}tbtUnicodestring{$ENDIF}(PString(FParser.GetToken));
|
||||
|
||||
FParser.Next;
|
||||
if FParser.CurrTokenId = CSTI_String then
|
||||
|
|
@ -5562,7 +5567,7 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||
Temp.ResultType := TPSExternalProcedure(FProcs[ProcNo]).RegProc.Decl.Result;
|
||||
if (Temp.ResultType <> nil) and (Temp.ResultType = FAnyString) then begin // workaround to make the result type match
|
||||
for i := 0 to Par.Count -1 do begin
|
||||
if Par[i].ExpectedType.BaseType in [btString, btWideString] then
|
||||
if Par[i].ExpectedType.BaseType in [btString{$IFNDEF PS_NOWIDESTRING}, btWideString{$ENDIF}] then
|
||||
Temp.ResultType := Par[i].ExpectedType;
|
||||
end;
|
||||
end;
|
||||
|
|
@ -11172,7 +11177,8 @@ var
|
|||
TPSProcedure(FProcs[I]).Free;
|
||||
FProcs.Free;
|
||||
FProcs := nil;
|
||||
for I := 0 to FTypes.Count - 1 do
|
||||
//reverse free types: a custom type's attribute value type may point to a base type
|
||||
for I := FTypes.Count - 1 downto 0 do
|
||||
begin
|
||||
PT := FTypes[I];
|
||||
pt.Free;
|
||||
|
|
@ -13919,9 +13925,9 @@ begin
|
|||
begin
|
||||
case FValue.FType.BaseType of
|
||||
btChar: FValue.tchar := (Val+#0)[1];
|
||||
btWideChar: FValue.twidechar := WideChar((Val+#0)[1]);
|
||||
btString: tbtString(FValue.tstring) := val;
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
btWideChar: FValue.twidechar := WideChar((Val+#0)[1]);
|
||||
btWideString: tbtwidestring(FValue.twidestring) := tbtwidestring(val);
|
||||
btUnicodeString: tbtunicodestring(FValue.tunistring) := tbtunicodestring(val);
|
||||
{$ENDIF}
|
||||
|
|
@ -14840,7 +14846,7 @@ begin
|
|||
GetPropInfos(fclass.ClassInfo, p);
|
||||
for i := Count -1 downto 0 do
|
||||
begin
|
||||
if p^[i]^.PropType^.Kind in [tkLString, tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkClass, tkMethod{$IFNDEF PS_NOWIDESTRING}, tkWString{$ENDIF}] then
|
||||
if p^[i]^.PropType^.Kind in [tkLString, tkInteger, tkChar, tkEnumeration, tkFloat, tkString, tkSet, tkClass, tkMethod{$IFNDEF PS_NOWIDESTRING}, tkWString{$ENDIF}{$IFDEF DELPHI2009UP}, tkUString{$ENDIF}] then
|
||||
begin
|
||||
if (p^[i]^.GetProc <> nil) then
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ type
|
|||
|
||||
TIFPS3CEPluginItem = class(TPSPluginItem);
|
||||
|
||||
|
||||
|
||||
TPSPlugins = class(TCollection)
|
||||
private
|
||||
FCompExec: TPSScript;
|
||||
|
|
@ -310,7 +310,7 @@ type
|
|||
public
|
||||
|
||||
property FileName: tbtstring read FFileName write SetFileName;
|
||||
|
||||
|
||||
property FileNameHash: Longint read FFileNameHash;
|
||||
|
||||
property Line: Longint read FLine write FLine;
|
||||
|
|
@ -1006,6 +1006,7 @@ begin
|
|||
inherited Notification(AComponent, Operation);
|
||||
if (Operation = opRemove) and (aComponent is TPSPlugin) then
|
||||
begin
|
||||
if Plugins <> nil then
|
||||
for i := Plugins.Count -1 downto 0 do
|
||||
begin
|
||||
if (Plugins.Items[i] as TPSPluginItem).Plugin = aComponent then
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ function UnloadProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSSt
|
|||
implementation
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
LCLIntf, Unix, baseunix, dynlibs, termio, sockets;
|
||||
Unix, baseunix, dynlibs, termio, sockets;
|
||||
{$ELSE}
|
||||
Windows;
|
||||
{$ENDIF}
|
||||
|
|
|
|||
|
|
@ -1537,7 +1537,11 @@ begin
|
|||
tkVariant: begin Result := '[Variant]'; exit; end;
|
||||
{$IFDEF DELPHI6UP}
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
tkWString: begin Result := ''''+tbtString(GetWideStrProp(Instance, pp))+''; end; {$ENDIF}
|
||||
tkWString: begin Result := ''''+tbtString(GetWideStrProp(Instance, pp))+''; end;
|
||||
{$IFDEF DELPHI2009UP}
|
||||
tkUString: begin Result := ''''+tbtUnicodeString(GetUnicodeStrProp(Instance, pp))+''; end;
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
else begin Result := '[Unknown]'; exit; end;
|
||||
end;
|
||||
|
|
@ -1599,9 +1603,9 @@ begin
|
|||
btS16: str(tbts16(p.dta^), Result);
|
||||
btU32: str(tbtu32(p.dta^), Result);
|
||||
btS32: str(tbts32(p.dta^), Result);
|
||||
btSingle: result := floattostr(tbtsingle(p.dta^));
|
||||
btDouble: result := floattostr(tbtdouble(p.dta^));
|
||||
btExtended: result := floattostr(tbtextended(p.dta^));
|
||||
btSingle: str(tbtsingle(p.dta^), Result);
|
||||
btDouble: str(tbtdouble(p.dta^), Result);
|
||||
btExtended: str(tbtextended(p.dta^), Result);
|
||||
btString: Result := makestring(tbtString(p.dta^));
|
||||
btPChar:
|
||||
begin
|
||||
|
|
@ -1975,7 +1979,7 @@ end;
|
|||
|
||||
class function TPSExec.About: tbtString;
|
||||
begin
|
||||
Result := 'RemObjects Pascal Script. Copyright (c) 2004-2009 by RemObjects Software';
|
||||
Result := 'RemObjects Pascal Script. Copyright (c) 2004-2010 by RemObjects Software';
|
||||
end;
|
||||
|
||||
procedure TPSExec.Cleanup;
|
||||
|
|
@ -8674,24 +8678,26 @@ begin
|
|||
1: Stack.SetInt(-1, StrToInt(Stack.GetAnsiString(-2))); // strtoint
|
||||
2: Stack.SetInt(-1, StrToIntDef(Stack.GetAnsiString(-2), Stack.GetInt(-3))); // strtointdef
|
||||
3:
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetInt(-1, Pos(Stack.GetUnicodeString(-2), Stack.GetUnicodeString(-3)))// pos
|
||||
else
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
|
||||
Stack.SetInt(-1, Pos(Stack.GetWideString(-2), Stack.GetWideString(-3)))// pos
|
||||
else
|
||||
else{$ENDIF}
|
||||
Stack.SetInt(-1, Pos(Stack.GetAnsiString(-2), Stack.GetAnsiString(-3)));// pos
|
||||
4:
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
|
||||
{$IFNDEF PS_NOWIDESTRING} if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
|
||||
Stack.SetWideString(-1, Copy(Stack.GetWideString(-2), Stack.GetInt(-3), Stack.GetInt(-4))) // copy
|
||||
else
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetUnicodeString(-1, Copy(Stack.GetUnicodeString(-2), Stack.GetInt(-3), Stack.GetInt(-4))) // copy
|
||||
else
|
||||
else{$ENDIF}
|
||||
Stack.SetAnsiString(-1, Copy(Stack.GetAnsiString(-2), Stack.GetInt(-3), Stack.GetInt(-4))); // copy
|
||||
5: //delete
|
||||
begin
|
||||
temp := NewTPSVariantIFC(Stack[Stack.Count -1], True);
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if (temp.Dta <> nil) and (temp.aType.BaseType = btUnicodeString) then
|
||||
begin
|
||||
Delete(tbtUnicodeString(temp.Dta^), Stack.GetInt(-2), Stack.GetInt(-3));
|
||||
|
|
@ -8699,7 +8705,7 @@ begin
|
|||
if (temp.Dta <> nil) and (temp.aType.BaseType = btWideString) then
|
||||
begin
|
||||
Delete(tbtwidestring(temp.Dta^), Stack.GetInt(-2), Stack.GetInt(-3));
|
||||
end else begin
|
||||
end else {$ENDIF} begin
|
||||
if (temp.Dta = nil) or (temp.aType.BaseType <> btString) then
|
||||
begin
|
||||
Result := False;
|
||||
|
|
@ -8711,11 +8717,12 @@ begin
|
|||
6: // insert
|
||||
begin
|
||||
temp := NewTPSVariantIFC(Stack[Stack.Count -2], True);
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if (temp.Dta <> nil) and (temp.aType.BaseType = btUnicodeString) then begin
|
||||
Insert(Stack.GetUnicodeString(-1), tbtUnicodeString(temp.Dta^), Stack.GetInt(-3));
|
||||
end else if (temp.Dta <> nil) and (temp.aType.BaseType = btWideString) then begin
|
||||
Insert(Stack.GetWideString(-1), tbtwidestring(temp.Dta^), Stack.GetInt(-3));
|
||||
end else begin
|
||||
end else {$ENDIF} begin
|
||||
if (temp.Dta = nil) or (temp.aType.BaseType <> btString) then
|
||||
begin
|
||||
Result := False;
|
||||
|
|
@ -8759,6 +8766,7 @@ begin
|
|||
tbtstring(temp.Dta^)[i] := tbtchar(Stack.GetInt(-1));
|
||||
end;
|
||||
10:
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
{$IFDEF DELPHI2009UP}
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetUnicodeString(-1, UpperCase(Stack.GetUnicodeString(-2))) // Uppercase
|
||||
|
|
@ -8768,8 +8776,10 @@ begin
|
|||
(Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString) then
|
||||
Stack.SetWideString(-1, WideUpperCase(Stack.GetWideString(-2))) // Uppercase
|
||||
else
|
||||
{$ENDIF}
|
||||
Stack.SetAnsiString(-1, FastUppercase(Stack.GetAnsiString(-2))); // Uppercase
|
||||
11:
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
{$IFDEF DELPHI2009UP}
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetUnicodeString(-1, LowerCase(Stack.GetUnicodeString(-2))) // Uppercase
|
||||
|
|
@ -8779,14 +8789,17 @@ begin
|
|||
(Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString) then
|
||||
Stack.SetWideString(-1, WideLowerCase(Stack.GetWideString(-2))) // Uppercase
|
||||
else
|
||||
{$ENDIF}
|
||||
Stack.SetAnsiString(-1, FastLowercase(Stack.GetAnsiString(-2)));// LowerCase
|
||||
12:
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetUnicodeString(-1, SysUtils.Trim(Stack.GetUnicodestring(-2))) // Uppercase
|
||||
else if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
|
||||
Stack.SetWideString(-1, SysUtils.Trim(Stack.GetWideString(-2))) // Uppercase
|
||||
else
|
||||
Stack.SetAnsiString(-1, Trim(Stack.GetAnsiString(-2)));// Trim
|
||||
{$ENDIF}
|
||||
Stack.SetAnsiString(-1, SysUtils.Trim(Stack.GetAnsiString(-2)));// Trim
|
||||
13: Stack.SetInt(-1, Length(Stack.GetAnsiString(-2))); // Length
|
||||
14: // SetLength
|
||||
begin
|
||||
|
|
@ -8809,28 +8822,31 @@ begin
|
|||
23: Stack.SetReal(-1, StrToFloat(Stack.GetAnsiString(-2))); // StrToFloat
|
||||
24: Stack.SetAnsiString(-1, FloatToStr(Stack.GetReal(-2)));// FloatToStr
|
||||
25:
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetUnicodeString(-1, upadL(Stack.GetUnicodeString(-2), Stack.GetInt(-3))) // PadL
|
||||
else
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
|
||||
Stack.SetWideString(-1, wPadL(Stack.GetWideString(-2), Stack.GetInt(-3))) // PadL
|
||||
else
|
||||
else{$ENDIF}
|
||||
Stack.SetAnsiString(-1, PadL(Stack.GetAnsiString(-2), Stack.GetInt(-3))); // PadL
|
||||
26:
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetUnicodeString(-1, uPadR(Stack.GetUnicodeString(-2), Stack.GetInt(-3))) // PadR
|
||||
else
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
|
||||
Stack.SetWideString(-1, wPadR(Stack.GetWideString(-2), Stack.GetInt(-3))) // PadR
|
||||
else
|
||||
else{$ENDIF}
|
||||
Stack.SetAnsiString(-1, PadR(Stack.GetAnsiString(-2), Stack.GetInt(-3))); // PadR
|
||||
27:
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btUnicodeString then
|
||||
Stack.SetUnicodeString(-1, uPadZ(Stack.GetUnicodeString(-2), Stack.GetInt(-3)))// PadZ
|
||||
else
|
||||
if Stack.GetItem(Stack.Count -2)^.FType.BaseType = btWideString then
|
||||
Stack.SetWideString(-1, wPadZ(Stack.GetWideString(-2), Stack.GetInt(-3)))// PadZ
|
||||
else
|
||||
else{$ENDIF}
|
||||
Stack.SetAnsiString(-1, PadZ(Stack.GetAnsiString(-2), Stack.GetInt(-3)));// PadZ
|
||||
28: Stack.SetAnsiString(-1, StringOfChar(tbtChar(Stack.GetInt(-2)), Stack.GetInt(-3))); // Replicate/StrOfChar
|
||||
29: // Assigned
|
||||
|
|
@ -12105,6 +12121,7 @@ begin
|
|||
Result := PSGetUInt(@PPSVariantData(val).Data, val.FType);
|
||||
end;
|
||||
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
function TPSStack.GetUnicodeString(ItemNo: Integer): tbtunicodestring;
|
||||
var
|
||||
val: PPSVariant;
|
||||
|
|
@ -12116,7 +12133,6 @@ begin
|
|||
Result := PSGetUnicodeString(@PPSVariantData(val).Data, val.FType);
|
||||
end;
|
||||
|
||||
{$IFNDEF PS_NOWIDESTRING}
|
||||
function TPSStack.GetWideString(ItemNo: Longint): tbtWideString;
|
||||
var
|
||||
val: PPSVariant;
|
||||
|
|
|
|||
Loading…
Reference in New Issue