From c9afc33bdfcebc248a20f336704c8f5a7bfc6bf8 Mon Sep 17 00:00:00 2001 From: carlokok Date: Thu, 13 Sep 2007 15:53:58 +0000 Subject: [PATCH] 0004176: Duplicate local with diff caps don't show errors 0004192: Fix for ErTypeMismatch in TPSExec.DoBooleanCalc 0004443: public.pascalscript: uPSComponentExt.pas issue 0003310: bugfix for PascalScript fix for casing of dll exports git-svn-id: http://code.remobjects.com/svn/pascalscript@35 5c9d2617-0215-0410-a2ee-e80e04d1c6d8 --- Source/BuildPackages_D11.groupproj | 44 ++++++++++++ Source/PascalScript_Core_D11.dpk | 76 ++++++++++++++++++++ Source/PascalScript_Core_D11.dproj | 112 +++++++++++++++++++++++++++++ Source/PascalScript_Core_D11.res | Bin 0 -> 5188 bytes Source/PascalScript_RO_D11.dpk | 47 ++++++++++++ Source/PascalScript_RO_D11.dproj | 81 +++++++++++++++++++++ Source/PascalScript_RO_D11.res | Bin 0 -> 5188 bytes Source/changelog.txt | 8 +++ Source/uPSC_dll.pas | 18 +++-- Source/uPSCompiler.pas | 4 +- Source/uPSComponentExt.pas | 71 +++++++++++++++--- Source/uPSRuntime.pas | 1 + 12 files changed, 443 insertions(+), 19 deletions(-) create mode 100644 Source/BuildPackages_D11.groupproj create mode 100644 Source/PascalScript_Core_D11.dpk create mode 100644 Source/PascalScript_Core_D11.dproj create mode 100644 Source/PascalScript_Core_D11.res create mode 100644 Source/PascalScript_RO_D11.dpk create mode 100644 Source/PascalScript_RO_D11.dproj create mode 100644 Source/PascalScript_RO_D11.res diff --git a/Source/BuildPackages_D11.groupproj b/Source/BuildPackages_D11.groupproj new file mode 100644 index 0000000..8bf0c0a --- /dev/null +++ b/Source/BuildPackages_D11.groupproj @@ -0,0 +1,44 @@ + + + {301d154e-a852-4e08-89a3-6bfb2774fb38} + + + + + + + + Default.Personality + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Source/PascalScript_Core_D11.dpk b/Source/PascalScript_Core_D11.dpk new file mode 100644 index 0000000..b76593c --- /dev/null +++ b/Source/PascalScript_Core_D11.dpk @@ -0,0 +1,76 @@ +package PascalScript_Core_D11; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'RemObjects Pascal Script - Core Package'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + dbrtl; + +contains + uPSC_extctrls in 'uPSC_extctrls.pas', + uPSC_forms in 'uPSC_forms.pas', + uPSC_graphics in 'uPSC_graphics.pas', + uPSC_menus in 'uPSC_menus.pas', + uPSC_std in 'uPSC_std.pas', + uPSC_stdctrls in 'uPSC_stdctrls.pas', + uPSCompiler in 'uPSCompiler.pas', + uPSComponent in 'uPSComponent.pas', + uPSComponent_COM in 'uPSComponent_COM.pas', + uPSComponent_Controls in 'uPSComponent_Controls.pas', + uPSComponent_DB in 'uPSComponent_DB.pas', + uPSComponent_Default in 'uPSComponent_Default.pas', + uPSComponent_Forms in 'uPSComponent_Forms.pas', + uPSComponent_StdCtrls in 'uPSComponent_StdCtrls.pas', + uPSDebugger in 'uPSDebugger.pas', + uPSDisassembly in 'uPSDisassembly.pas', + uPSPreProcessor in 'uPSPreProcessor.pas', + uPSR_buttons in 'uPSR_buttons.pas', + uPSR_classes in 'uPSR_classes.pas', + uPSR_comobj in 'uPSR_comobj.pas', + uPSR_controls in 'uPSR_controls.pas', + uPSR_dateutils in 'uPSR_dateutils.pas', + uPSR_DB in 'uPSR_DB.pas', + uPSR_dll in 'uPSR_dll.pas', + uPSR_extctrls in 'uPSR_extctrls.pas', + uPSR_forms in 'uPSR_forms.pas', + uPSR_graphics in 'uPSR_graphics.pas', + uPSR_menus in 'uPSR_menus.pas', + uPSR_std in 'uPSR_std.pas', + uPSR_stdctrls in 'uPSR_stdctrls.pas', + uPSRuntime in 'uPSRuntime.pas', + uPSUtils in 'uPSUtils.pas', + uPSC_buttons in 'uPSC_buttons.pas', + uPSC_classes in 'uPSC_classes.pas', + uPSC_comobj in 'uPSC_comobj.pas', + uPSC_controls in 'uPSC_controls.pas', + uPSC_dateutils in 'uPSC_dateutils.pas', + uPSC_DB in 'uPSC_DB.pas', + uPSC_dll in 'uPSC_dll.pas', + PascalScript_Core_Reg in 'PascalScript_Core_Reg.pas'; + +end. diff --git a/Source/PascalScript_Core_D11.dproj b/Source/PascalScript_Core_D11.dproj new file mode 100644 index 0000000..79ece82 --- /dev/null +++ b/Source/PascalScript_Core_D11.dproj @@ -0,0 +1,112 @@ + + + + {634be604-b73a-4b3d-bc81-719c905199e6} + PascalScript_Core_D11.dpk + Debug + AnyCPU + DCC32 + ..\Dcu\D11\PascalScript_Core_D11.bpl + + + 7.0 + False + False + True + 0 + ..\Dcu\D10 + ..\Dcu\D10 + ..\Dcu\D10 + ..\Dcu\D10 + ..\Dcu\D10 + ..\Dcu\D10 + ..\Dcu\D10 + ..\Dcu\D10 + ..\Dcu\D10 + RELEASE + False + False + False + False + False + False + False + False + + + 7.0 + True + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + False + False + False + False + False + False + False + False + + + Delphi.Personality + Package + +FalseTrueFalseRemObjects Pascal Script - Core PackageFalseTrueFalseTrueFalse306442FalseFalseFalseFalseFalse10331252RemObjects Software3.0.6.442Pascal Script3.0.0.0Tuesday, March 21, 2006 1:32 PMMonday, February 28, 2005 3:33 PMPascalScript_Core_D11.dpk + + + + + MainSource + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Source/PascalScript_Core_D11.res b/Source/PascalScript_Core_D11.res new file mode 100644 index 0000000000000000000000000000000000000000..32f721af69cfa3dde5d2b1ab3788f1ede09b62e1 GIT binary patch literal 5188 zcmbW5&ud&&6vt0&Q0t;*(T%GKA|gRbY=fW(qqG(a))w0-?w-~D)HW??MY?+VPo@hI zd4GZ+FKfxNOCepjx63ZX=l65YJ@Y1$Nlkp=77JP1L>5atga*|MwYHBir2Ew5G1z(@y*8@naheM@CHem8tgh zc+U6!zxaTW*y$Nd9?iJ%`A)o=dSs0_Oq=s*pV)}FvBad^cF|YteotbIN?!6Lm!_&M z#zPBufsGEkIB3lA!LA##9bxYz2ep-R-UANSjC-wJTj4Msc)_7-slRsYPVv*VH`R*A zM(s~jyXvNXIE>|$Z}uTS1~wW`bXGe#xL4of$frE6zpp|6l?e}O^gWUWjbh>8Ja+ch zkEZ1GI*2Eq=j?TGOwEnNpL|`XnkwSNfi>bXZO*lo_KK(O2HZLIN8Z3=AA>{a>T@-i zvf`tr;4rGoKC4#8OOO7vvtPVTjivrkHyYIwZ0cb=_OD=9s%2QqB5y-omD>2Rv>hmJ zD4k{OiD|BBSxbye`A78ISPwoJ)Esp;)+r|Yfv?=POt@QrYnf#kG9lKPK}MKsM}-O7=r_S_TRC`!XCg=zLFoXF6y^>x_0no z%+>69%ie1o?t6q>}jb#ISl*y(cF}m z`q77XI(YQ_lb3td1BTb8{NTpjg1&m+z@Ikdi!)s6t_qidI4hU$d8t45$oC1I6$=h^ z`QD2kcdoyu!etz6a(H_VKI>iYq4>$*5~lMfZoJQN2SojTHo!rTs_fC280lYAYvG`F z;)kDKzw57Dj#;s{VW#?-%R9$4(p;Q-d0}V$oc-7ztp#5OW*YOfdH;54U-lu+9rqU; zBNzFo-}hf_>UEteODsI!5%6i`oYlbhU|jAuYAE=jzxvu+Gv3kECf>El{=jXhIIZ>lk@xdh zm3LAc^0S>av-sZEUFV-2i81K!KRnD_3<5u_uR+T=boCJP4OZIeC|L#tH_mnB%-%jJCDPj`Z=FF+OP6C zKs)amKNI5U=U%vZcER%drr_oo1e+(h%)@7lv*>ycd%aWlU4BU2QG33-yk}rfIMmTb zi|L1X-m4dJn4I|m7;u^PyRp%@zh`Op9Kf1=7{lhh3(1K+BF68TVdC{ZKKBZa&O?5W zOrPi7bIcM@pK&bl_VqjQS;E<%Ms(v&qz^|wOB$d4F6aASG?)WD8Jck5jB(ZuVv2Q4 zok_kwU~uv8!|p>9av$VL4lg1_DuFvwpDCX9y{!_sh=IN zEwdxoQ?pl;`*mRqgf$dq*KHl?j+@!4tm}^1dHcl9*%z|Yc0oR$>EAW@HABB=EHC@7 z8vF{fV9#GN|AnLLmXv3~m#x~-#a#dVr8PCL*d?p<|5N)?t#gi0Io?^dd45~`>mTxo zuKl|3^286B)I-9^?p^=)m9S0u9@>W8wspH{XXWqMb!A?+8+K2#YaX*|YpV1E*_t@O z=rcR6e5Vz2*Y4X@#XnNjSJk^tQt`a5_67UKzEkU4VLVWsmlS_P?H?7n;gKuKvM|9t zqp=5yhR=P)-B$d%=i}d+y*3qlMX?)-?qg2b2{Alj@5|QocT#KK^!(KG(Bs#Id}kL^ zv$s9wbIsrMS*p6PdSG$WZfRva!L^UOtca_2P3!J@J>QE>J`sDN2l z*du#a(dX6L5biCtPuhDvc2c=krS-Da7ds Oj$`-xcy#g4#eV_$w2~MA literal 0 HcmV?d00001 diff --git a/Source/PascalScript_RO_D11.dpk b/Source/PascalScript_RO_D11.dpk new file mode 100644 index 0000000..f0e2e8a --- /dev/null +++ b/Source/PascalScript_RO_D11.dpk @@ -0,0 +1,47 @@ +package PascalScript_RO_D11; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES ON} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'RemObjects Pascal Script - RemObjects SDK 5.0 Integration'} +{$IMPLICITBUILD OFF} + +requires + rtl, + {$IFDEF RemObjects_INDY9} + Indy, + {$ELSE} + IndyCore, IndySystem, IndyProtocols, + {$ENDIF} + PascalScript_Core_D11, + RemObjects_Core_D11, + RemObjects_Indy_D11, + dbrtl, + vcl, + vclx; + +contains + PascalScript_RO_Reg in 'PascalScript_RO_Reg.pas', + uROPSServerLink in 'uROPSServerLink.pas', + uROPSImports in 'uROPSImports.pas'; + +end. diff --git a/Source/PascalScript_RO_D11.dproj b/Source/PascalScript_RO_D11.dproj new file mode 100644 index 0000000..c9cc027 --- /dev/null +++ b/Source/PascalScript_RO_D11.dproj @@ -0,0 +1,81 @@ + + + + {0eefdf9b-7853-40e5-9b29-b631f51beeda} + PascalScript_RO_D11.dpk + Debug + AnyCPU + DCC32 + ..\Dcu\D11\PascalScript_RO_D11.bpl + + + 7.0 + False + False + True + 0 + ..\Dcu\D9 + ..\Dcu\D9 + ..\Dcu\D9 + ..\Dcu\D9 + ..\Dcu\D9;$(BDS)\lib\Indy9;..\..\RemObjects SDK for Dephi\Dcu\D9 + ..\Dcu\D9;$(BDS)\lib\Indy9;..\..\RemObjects SDK for Dephi\Dcu\D9 + ..\Dcu\D9;$(BDS)\lib\Indy9;..\..\RemObjects SDK for Dephi\Dcu\D9 + ..\Dcu\D9;$(BDS)\lib\Indy9;..\..\RemObjects SDK for Dephi\Dcu\D9 + RELEASE + False + False + False + False + False + False + False + False + + + 7.0 + True + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11 + ..\Dcu\D11;..\..\RemObjects SDK for Dephi\Dcu\D11 + ..\Dcu\D11;..\..\RemObjects SDK for Dephi\Dcu\D11 + ..\Dcu\D11;..\..\RemObjects SDK for Dephi\Dcu\D11 + ..\Dcu\D11;..\..\RemObjects SDK for Dephi\Dcu\D11 + False + False + False + False + False + False + False + False + ..\Dcu\D11 + + + Delphi.Personality + Package + +FalseTrueFalseRemObjects Pascal Script - RemObjects SDK 5.0 IntegrationFalseFalseFalseTrueFalse306442FalseFalseFalseFalseFalse10331252RemObjects Software3.0.6.442Pascal Script3.0.0.0Tuesday, March 21, 2006 1:32 PMPascalScript_RO_D11.dpk + + + + + MainSource + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/Source/PascalScript_RO_D11.res b/Source/PascalScript_RO_D11.res new file mode 100644 index 0000000000000000000000000000000000000000..32f721af69cfa3dde5d2b1ab3788f1ede09b62e1 GIT binary patch literal 5188 zcmbW5&ud&&6vt0&Q0t;*(T%GKA|gRbY=fW(qqG(a))w0-?w-~D)HW??MY?+VPo@hI zd4GZ+FKfxNOCepjx63ZX=l65YJ@Y1$Nlkp=77JP1L>5atga*|MwYHBir2Ew5G1z(@y*8@naheM@CHem8tgh zc+U6!zxaTW*y$Nd9?iJ%`A)o=dSs0_Oq=s*pV)}FvBad^cF|YteotbIN?!6Lm!_&M z#zPBufsGEkIB3lA!LA##9bxYz2ep-R-UANSjC-wJTj4Msc)_7-slRsYPVv*VH`R*A zM(s~jyXvNXIE>|$Z}uTS1~wW`bXGe#xL4of$frE6zpp|6l?e}O^gWUWjbh>8Ja+ch zkEZ1GI*2Eq=j?TGOwEnNpL|`XnkwSNfi>bXZO*lo_KK(O2HZLIN8Z3=AA>{a>T@-i zvf`tr;4rGoKC4#8OOO7vvtPVTjivrkHyYIwZ0cb=_OD=9s%2QqB5y-omD>2Rv>hmJ zD4k{OiD|BBSxbye`A78ISPwoJ)Esp;)+r|Yfv?=POt@QrYnf#kG9lKPK}MKsM}-O7=r_S_TRC`!XCg=zLFoXF6y^>x_0no z%+>69%ie1o?t6q>}jb#ISl*y(cF}m z`q77XI(YQ_lb3td1BTb8{NTpjg1&m+z@Ikdi!)s6t_qidI4hU$d8t45$oC1I6$=h^ z`QD2kcdoyu!etz6a(H_VKI>iYq4>$*5~lMfZoJQN2SojTHo!rTs_fC280lYAYvG`F z;)kDKzw57Dj#;s{VW#?-%R9$4(p;Q-d0}V$oc-7ztp#5OW*YOfdH;54U-lu+9rqU; zBNzFo-}hf_>UEteODsI!5%6i`oYlbhU|jAuYAE=jzxvu+Gv3kECf>El{=jXhIIZ>lk@xdh zm3LAc^0S>av-sZEUFV-2i81K!KRnD_3<5u_uR+T=boCJP4OZIeC|L#tH_mnB%-%jJCDPj`Z=FF+OP6C zKs)amKNI5U=U%vZcER%drr_oo1e+(h%)@7lv*>ycd%aWlU4BU2QG33-yk}rfIMmTb zi|L1X-m4dJn4I|m7;u^PyRp%@zh`Op9Kf1=7{lhh3(1K+BF68TVdC{ZKKBZa&O?5W zOrPi7bIcM@pK&bl_VqjQS;E<%Ms(v&qz^|wOB$d4F6aASG?)WD8Jck5jB(ZuVv2Q4 zok_kwU~uv8!|p>9av$VL4lg1_DuFvwpDCX9y{!_sh=IN zEwdxoQ?pl;`*mRqgf$dq*KHl?j+@!4tm}^1dHcl9*%z|Yc0oR$>EAW@HABB=EHC@7 z8vF{fV9#GN|AnLLmXv3~m#x~-#a#dVr8PCL*d?p<|5N)?t#gi0Io?^dd45~`>mTxo zuKl|3^286B)I-9^?p^=)m9S0u9@>W8wspH{XXWqMb!A?+8+K2#YaX*|YpV1E*_t@O z=rcR6e5Vz2*Y4X@#XnNjSJk^tQt`a5_67UKzEkU4VLVWsmlS_P?H?7n;gKuKvM|9t zqp=5yhR=P)-B$d%=i}d+y*3qlMX?)-?qg2b2{Alj@5|QocT#KK^!(KG(Bs#Id}kL^ zv$s9wbIsrMS*p6PdSG$WZfRva!L^UOtca_2P3!J@J>QE>J`sDN2l z*du#a(dX6L5biCtPuhDvc2c=krS-Da7ds Oj$`-xcy#g4#eV_$w2~MA literal 0 HcmV?d00001 diff --git a/Source/changelog.txt b/Source/changelog.txt index 8d1461a..e60a03d 100644 --- a/Source/changelog.txt +++ b/Source/changelog.txt @@ -1,4 +1,12 @@ +Sept 2007 +- 0004176: Duplicate local with diff caps don't show errors +- 0004192: Fix for ErTypeMismatch in TPSExec.DoBooleanCalc +- 0004443: public.pascalscript: uPSComponentExt.pas issue +- 0003310: bugfix for PascalScript +- fix for casing of dll exports + April 2007 + - 11 apr: 0003310: bugfix for PascalScript in uPSComponentExt; Simon Forsberg - 5 apr: 0003274: Finally inside except block does not reset exception (reported by Martijn Laan) - 5 apr: Fix by Fabio Lindner: using AND on booleans and notification variants diff --git a/Source/uPSC_dll.pas b/Source/uPSC_dll.pas index ccc9d27..1554f98 100644 --- a/Source/uPSC_dll.pas +++ b/Source/uPSC_dll.pas @@ -23,13 +23,13 @@ const -function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const Name, FExternal: string): TPSRegProc; +function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: string): TPSRegProc; type - - TDllCallingConvention = (clRegister - , clPascal - , ClCdecl - , ClStdCall + + TDllCallingConvention = (clRegister + , clPascal + , ClCdecl + , ClStdCall ); var @@ -56,16 +56,19 @@ begin if (Result <> '') and (Result[Length(result)] = '"') then delete(result, length(result), 1); end; -function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const Name, FExternal: string): TPSRegProc; +function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const OriginalName, FExternal: string): TPSRegProc; var FuncName, + Name, FuncCC, s: string; CC: TDllCallingConvention; DelayLoad: Boolean; begin + Name := FastUpperCase(OriginalName); DelayLoad := False; FuncCC := FExternal; + if (pos('@', FuncCC) = 0) then begin Sender.MakeError('', ecCustomError, RPS_Invalid_External); @@ -122,6 +125,7 @@ begin Result.ImportDecl := FuncName; Result.Decl.Assign(Decl); Result.Name := Name; + Result.OrgName := OriginalName; Result.ExportName := False; end; diff --git a/Source/uPSCompiler.pas b/Source/uPSCompiler.pas index bb8ef28..a7a445b 100644 --- a/Source/uPSCompiler.pas +++ b/Source/uPSCompiler.pas @@ -4072,7 +4072,7 @@ begin for l := proc.ProcVars.Count - 1 downto 0 do begin if (PIFPSProcVar(proc.ProcVars.Data[l]).NameHash = h) and - (TPSVar(proc.ProcVars.Data[l]).Name = s) then + (PIFPSProcVar(proc.ProcVars.Data[l]).Name = s) then begin Result := True; exit; @@ -4726,7 +4726,7 @@ begin MakeError('', ecSemicolonExpected, ''); exit; end; - pp := FOnExternalProc(Self, FunctionDecl, FunctionName, FunctionParamNames); + pp := FOnExternalProc(Self, FunctionDecl, OriginalName, FunctionParamNames); if pp = nil then begin MakeError('', ecCustomError, ''); diff --git a/Source/uPSComponentExt.pas b/Source/uPSComponentExt.pas index 582a281..6ce497c 100644 --- a/Source/uPSComponentExt.pas +++ b/Source/uPSComponentExt.pas @@ -202,6 +202,7 @@ end; destructor TPSScriptExtension.Destroy; begin FMethodList.Free; + FMethodList := nil; inherited Destroy; end; @@ -545,7 +546,8 @@ procedure TPSScriptExtension.Notification(AComponent: TComponent; begin inherited; If Operation = opRemove then begin - MethodList.SetMethodName(aComponent,'',''); + if MethodList <> nil then + MethodList.SetMethodName(aComponent,'',''); end; end; @@ -676,15 +678,61 @@ var nProcs : Integer; line, test : String; + function IsItem(line,item:String; First :Boolean = false):Boolean; var nPos : Integer; begin - nPos := pos(item,line); - result := ((npos>0) and ((length(Line)-nPos<= length(item)) or not(line[nPos+length(item)] in ['0'..'9','A'..'Z','_'])) And - ((Npos = 1) or ((not first) and not(line[nPos-1] in ['0'..'9','A'..'Z','_'])))); + repeat + nPos := pos(item,line); + result := ((npos>0) and ((length(Line)-nPos<= length(item)) or not(line[nPos+length(item)] in ['0'..'9','A'..'Z','_'])) And + ((Npos = 1) or ((not first) and not(line[nPos-1] in ['0'..'9','A'..'Z','_'])))); + if nPos <> 0 then line := copy(line,nPos+Length(Item),Length(line)); + until (Result) or (nPos = 0); end; + function DelSpaces(AText: String): String; + var i: Integer; + begin + Result := ''; + for i := 1 to Length(AText) do + if AText[i] <> ' ' then + Result := Result + AText[i]; + end; + + function IsProcDecl(AnOriginalProcDecl: String): Boolean; + var + bIsFunc: Boolean; + iLineNo: Integer; + sProcKey: String; + sProcDecl: String; + begin + Result := false; + sProcDecl := Line; + iLineNo := x; + bIsFunc := isItem(AnOriginalProcDecl,'FUNCTION',true); + + if bIsFunc + then sProcKey := 'FUNCTION' + else sProcKey := 'PROCEDURE'; + + sProcDecl := copy(sProcDecl,Pos(sProcKey,sProcDecl),Length(sProcDecl)); + + while not IsItem(sProcDecl,'BEGIN') do + begin + inc(iLineNo); + if iLineNo > (fowner.script.Count - 1) then exit; + sProcDecl := sProcDecl + ' ' + uppercase(trim(fowner.script[iLineNo])) + ' '; + end; + + sProcDecl := DelSpaces(sProcDecl); + AnOriginalProcDecl := DelSpaces(AnOriginalProcDecl); + + sProcDecl := copy(sProcDecl,1,Length(AnOriginalProcDecl)); + + Result := sProcDecl = AnOriginalProcDecl; + + end; begin sl := TStringList.create; Try @@ -701,23 +749,26 @@ begin Line := fowner.script[x]; Line := uppercase(trim(line)); If IsItem(line,'PROCEDURE', true) or IsItem(line,'FUNCTION', true) then begin - If nBegins >0 then Raise exception.create('Missing some ''End'' statments'); - If (nProcs = 0) and (line = test) then + If nBegins >0 then Raise exception.create('Missing some ''end'' statments'); + If (nProcs = 0) and IsProcDecl(test) and + (not IsItem(line,'FORWARD')) and (not IsItem(line,'EXTERNAL')) then Exit; Inc(nProcs); end; + if IsItem(line,'FORWARD') or IsItem(line,'EXTERNAL') then + dec(nProcs); If Pos('END',line) < Pos('BEGIN',line) then begin If IsItem(line,'END') then begin If (nBegins = 0) and (nProcs=0) then Break; Dec(nBegins); If nBegins = 0 then Dec(nProcs); end; - If IsItem(line,'BEGIN') or IsItem(line,'TRY') then begin + If IsItem(line,'BEGIN') or IsItem(line,'TRY') or IsItem(line,'CASE') then begin If nProcs = 0 then Break; Inc(nBegins); end; end else begin - If IsItem(line,'BEGIN') or IsItem(line,'TRY') then begin + If IsItem(line,'BEGIN') or IsItem(line,'TRY') or IsItem(line,'CASE') then begin If nProcs = 0 then Break; Inc(nBegins); end; @@ -733,7 +784,7 @@ begin Try If (nProcs <> 0) or (nBegins<>0) then Raise exception.create(sMissingEndStatment); - If (Not Ontop) and (x>0) and (TRim(FOwner.script[x-1])<>'') then begin + If (Not Ontop) and (x>0) and (Trim(FOwner.script[x-1])<>'') then begin FOwner.script.Insert(x,''); inc(x); end; @@ -743,7 +794,7 @@ begin FOwner.script.EndUpdate; end; end; - + destructor TMethodList.Destroy; begin fProcList.Free; {<< Needs Eventlist for removing Methods} diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index 9fe8738..d73c839 100644 --- a/Source/uPSRuntime.pas +++ b/Source/uPSRuntime.pas @@ -4371,6 +4371,7 @@ var btS16: tbts16(Into^) := Longint(b); btU32: tbtu32(Into^) := Cardinal(b); btS32: tbts32(Into^) := Longint(b); + btVariant: Variant(Into^) := b; else begin CMD_Err(ErTypeMismatch); Ok := False;