1 {
2     This file is part of the Free Component Library
3 
4     Pascal source parser
5     Copyright (c) 2017 by Mattias Gaertner, mattias@freepascal.org
6 
7     See the file COPYING.FPC, included in this distribution,
8     for details about the copyright.
9 
10     This program is distributed in the hope that it will be useful,
11     but WITHOUT ANY WARRANTY; without even the implied warranty of
12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13 
14  **********************************************************************
15 
16 Abstract:
17   Evaluation of Pascal constants.
18 
19 Works:
20 - Emitting range check warnings
21 - Error on overflow
22 - bool:
23   - not, =, <>, and, or, xor, low(), high(), pred(), succ(), ord()
24   - boolean(0), boolean(1)
25 - int/uint
26   - unary +, -
27   - binary: +, -, *, div, mod, ^^, =, <>, <, >, <=, >=, and, or, xor, not, shl, shr
28   - Low(), High(), Pred(), Succ(), Ord(), Lo(), Hi()
29   - typecast longint(-1), word(-2), intsingle(-1), uintsingle(1)
30 - float:
31   - typecast single(double), double(single), float(integer)
32   - +, -, /, *, =, <>, <, >, <=, >=
33 - string:
34   - #65, '', 'a', 'ab'
35   - +, =, <>, <, >, <=, >=
36   - pred(), succ(), chr(), ord(), low(char), high(char)
37   - s[]
38   - length(string)
39   - #$DC00
40   - unicodestring
41 - enum
42   - ord(), low(), high(), pred(), succ()
43   - typecast enumtype(integer)
44 - set of enum, set of char, set of bool, set of int
45   - [a,b,c..d]
46   - +, -, *, ><, =, <>, >=, <=, in
47   - error on duplicate in const set
48 - arrays
49   - length()
50   - array of int, charm enum, bool
51 
52 ToDo:
53 - arrays
54   - [], [a..b], multi dim [a,b], concat with +
55   - array of record
56   - array of string
57   - error on: array[1..2] of longint = (1,2,3);
58 - anonymous enum range: type f=(a,b,c,d); g=b..c;
59 }
60 unit PasResolveEval;
61 
62 {$mode objfpc}{$H+}
63 
64 {$ifdef fpc}
65   {$define UsePChar}
66 {$endif}
67 
68 {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF}
69 {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF}
70 
71 interface
72 
73 uses
74   Sysutils, Classes, Math, PasTree, PScanner;
75 
76 // message numbers
77 const
78   nIdentifierNotFound = 3001;
79   nNotYetImplemented = 3002;
80   nIllegalQualifier = 3003;
81   nSyntaxErrorExpectedButFound = 3004;
82   nWrongNumberOfParametersForCallTo = 3005;
83   nIncompatibleTypeArgNo = 3006;
84   nIncompatibleTypeArgNoVarParamMustMatchExactly = 3007;
85   nVariableIdentifierExpected = 3008;
86   nDuplicateIdentifier = 3009;
87   nXExpectedButYFound = 3010;
88   nAncestorCycleDetected = 3011;
89   nCantUseForwardDeclarationAsAncestor = 3012;
90   nCantDetermineWhichOverloadedFunctionToCall = 3013;
91   nForwardTypeNotResolved = 3014;
92   nForwardProcNotResolved = 3015;
93   nInvalidXModifierY = 3016;
94   nAbstractMethodsMustNotHaveImplementation = 3017;
95   nCallingConventionMismatch = 3018;
96   nResultTypeMismatchExpectedButFound = 3019;
97   nFunctionHeaderMismatchForwardVarName = 3020;
98   nFunctionHidesIdentifier_NonVirtualMethod = 3021;
99   nNoMethodInAncestorToOverride = 3022;
100   nInheritedOnlyWorksInMethods = 3023;
101   nInheritedNeedsAncestor = 3024;
102   nNoPropertyFoundToOverride = 3025;
103   nExprTypeMustBeClassOrRecordTypeGot = 3026;
104   nPropertyNotWritable = 3027;
105   nIncompatibleTypesGotExpected = 3028;
106   nTypesAreNotRelatedXY = 3029;
107   nAbstractMethodsCannotBeCalledDirectly = 3030;
108   nMissingParameterX = 3031;
109   nInstanceMemberXInaccessible = 3032;
110   nInOperatorExpectsSetElementButGot = 3033;
111   nWrongNumberOfParametersForTypeCast = 3034;
112   nIllegalTypeConversionTo = 3035;
113   nConstantExpressionExpected = 3036;
114   nLeftSideOfIsOperatorExpectsAClassButGot = 3037;
115   nNotReadable = 3038;
116   nClassPropertyAccessorMustBeStatic = 3039;
117   nClassPropertyAccessorMustNotBeStatic = 3040;
118   nOnlyOneDefaultPropertyIsAllowed = 3041;
119   nWrongNumberOfParametersForArray = 3042;
120   nCantAssignValuesToAnAddress = 3043;
121   nIllegalExpression = 3044;
122   nCantAccessXMember = 3045;
123   nMustBeInsideALoop = 3046;
124   nExpectXArrayElementsButFoundY = 3047;
125   nCannotCreateADescendantOfTheSealedXY = 3048;
126   nAncestorIsNotExternal = 3049;
127   nPropertyMustHaveReadOrWrite = 3050;
128   nExternalClassInstanceCannotAccessStaticX = 3051;
129   nXModifierMismatchY = 3052;
130   nSymbolCannotBePublished = 3053;
131   nCannotTypecastAType = 3054;
132   nTypeIdentifierExpected = 3055;
133   nCannotNestAnonymousX = 3056;
134   nFoundCallCandidateX = 3057;
135   nTextAfterFinalIgnored = 3058;
136   nNoMemberIsProvidedToAccessProperty = 3059;
137   nTheUseOfXisNotAllowedInARecord = 3060;
138   nParameterlessConstructorsNotAllowedInRecords = 3061;
139   nMultipleXinTypeYNameZCAandB = 3062;
140   nXCannotHaveParameters = 3063;
141   nRangeCheckError = 3064;
142   nHighRangeLimitLTLowRangeLimit = 3065;
143   nRangeCheckEvaluatingConstantsVMinMax = 3066;
144   nIllegalChar = 3067;
145   nOverflowInArithmeticOperation = 3068;
146   nDivByZero = 3069;
147   nRangeCheckInSetConstructor = 3070;
148   nIncompatibleTypesGotParametersExpected = 3071;
149   nAddingIndexSpecifierRequiresNewX = 3072;
150   nCantFindUnitX = 3073;
151   nCannotFindEnumeratorForType = 3074;
152   nPreviousDeclMissesOverload = 3075;
153   nOverloadedProcMissesOverload = 3076;
154   nMethodHidesMethodOfBaseType = 3077;
155   nContextExpectedXButFoundY = 3078;
156   nContextXInvalidY = 3079;
157   nIdentifierXIsNotAnInstanceField = 3080;
158   nXIsNotSupported = 3081;
159   nOperatorIsNotOverloadedAOpB = 3082;
160   nIllegalQualifierAfter = 3084;
161   nIllegalQualifierInFrontOf = 3085;
162   nIllegalQualifierWithin = 3086;
163   nClassXNotFoundInThisModule = 3087;
164   nClassMethodsMustBeStaticInX = 3088;
165   nCannotMixMethodResolutionAndDelegationAtX = 3089;
166   nImplementsDoesNotSupportArrayProperty = 3101;
167   nImplementsDoesNotSupportIndex = 3102;
168   nImplementsUsedOnUnimplIntf = 3103;
169   nDuplicateImplementsForIntf = 3103;
170   nImplPropMustHaveReadSpec = 3104;
171   nDoesNotImplementInterface = 3105;
172   nTypeCycleFound = 3106;
173   nTypeXIsNotYetCompletelyDefined = 3107;
174   nDuplicateCaseValueXatY = 3108;
175   nMissingFieldsX = 3109;
176   nCantAssignValuesToConstVariable = 3110;
177   nIllegalAssignmentToForLoopVar = 3111;
178   nFunctionHidesIdentifier_NonProc = 3112;
179   nTypeXCannotBeExtendedByATypeHelper = 3113;
180   nTypeXCannotBeExtendedByARecordHelper = 3114;
181   nDerivedXMustExtendASubClassY = 3115;
182   nDefaultPropertyNotAllowedInHelperForX = 3116;
183   nHelpersCannotBeUsedAsTypes = 3117;
184   nMessageHandlersInvalidParams = 3118;
185   nImplictConversionUnicodeToAnsi = 3119;
186   nWrongTypeXInArrayConstructor = 3120;
187   nUnknownCustomAttributeX = 3121;
188   nAttributeIgnoredBecauseAbstractX = 3122;
189   nCreatingAnInstanceOfAbstractClassY = 3123;
190   nIllegalExpressionAfterX = 3124;
191   nMethodHidesNonVirtualMethodExactly = 3125;
192   nDuplicatePublishedMethodXAtY = 3126;
193   nConstraintXSpecifiedMoreThanOnce = 3127;
194   nConstraintXAndConstraintYCannotBeTogether = 3128;
195   nXIsNotAValidConstraint = 3129;
196   nWrongNumberOfParametersForGenericX = 3130;
197   nGenericsWithoutSpecializationAsType = 3131;
198   nDeclOfXDiffersFromPrevAtY = 3132;
199   nTypeParamXIsMissingConstraintY = 3133;
200   nTypeParamXIsNotCompatibleWithY = 3134;
201   nTypeParamXMustSupportIntfY = 3135;
202   nTypeParamsNotAllowedOnX = 3136;
203   nXMethodsCannotHaveTypeParams = 3137;
204   nImplMustNotRepeatConstraints = 3138;
205   nCouldNotInferTypeArgXForMethodY = 3139;
206   nInferredTypeXFromDiffArgsMismatchFromMethodY = 3140;
207   nParamOfThisTypeCannotHaveDefVal = 3141;
208   nClassTypesAreNotRelatedXY = 3142;
209   nDirectiveXNotAllowedHere = 3143;
210 
211   // using same IDs as FPC
212   nVirtualMethodXHasLowerVisibility = 3250; // was 3050
213   nConstructingClassXWithAbstractMethodY = 4046; // was 3080
214   nNoMatchingImplForIntfMethodXFound = 5042;  // was 3088
215   nSymbolXIsDeprecated = 5043;   // was 3062
216   nSymbolXBelongsToALibrary = 5065; // was 3061
217   nSymbolXIsDeprecatedY = 5066;   // 3063
218   nSymbolXIsNotPortable = 5076; // was 3058
219   nSymbolXIsNotImplemented = 5078; // was  3060
220   nSymbolXIsExperimental = 5079;  // was 3059
221 
222 // resourcestring patterns of messages
223 resourcestring
224   sIdentifierNotFound = 'identifier not found "%s"';
225   sNotYetImplemented = 'not yet implemented: %s';
226   sIllegalQualifier = 'illegal qualifier "%s"';
227   sSyntaxErrorExpectedButFound = 'Syntax error, "%s" expected but "%s" found';
228   sWrongNumberOfParametersForCallTo = 'Wrong number of parameters specified for call to "%s"';
229   sIncompatibleTypeArgNo = 'Incompatible type arg no. %s: Got "%s", expected "%s"';
230   sIncompatibleTypeArgNoVarParamMustMatchExactly = 'Incompatible type arg no. %s: Got "%s", expected "%s". Var param must match exactly.';
231   sVariableIdentifierExpected = 'Variable identifier expected';
232   sDuplicateIdentifier = 'Duplicate identifier "%s" at %s';
233   sXExpectedButYFound = '%s expected, but %s found';
234   sAncestorCycleDetected = 'Ancestor cycle detected';
235   sCantUseForwardDeclarationAsAncestor = 'Can''t use forward declaration "%s" as ancestor';
236   sCantDetermineWhichOverloadedFunctionToCall = 'Can''t determine which overloaded function to call';
237   sForwardTypeNotResolved = 'Forward type not resolved "%s"';
238   sForwardProcNotResolved = 'Forward %s not resolved "%s"';
239   sInvalidXModifierY = 'Invalid %s modifier %s';
240   sAbstractMethodsMustNotHaveImplementation = 'Abstract method must not have an implementation.';
241   sCallingConventionMismatch = 'Calling convention mismatch';
242   sResultTypeMismatchExpectedButFound = 'Result type mismatch, expected %s, but found %s';
243   sFunctionHeaderMismatchForwardVarName = 'function header "%s" doesn''t match forward : var name changes %s => %s';
244   sFunctionHidesIdentifier = 'function hides identifier at "%s". Use overload or reintroduce';
245   sNoMethodInAncestorToOverride = 'There is no method in an ancestor class to be overridden "%s"';
246   sInheritedOnlyWorksInMethods = 'Inherited works only in methods';
247   sInheritedNeedsAncestor = 'inherited needs an ancestor';
248   sNoPropertyFoundToOverride = 'No property found to override';
249   sExprTypeMustBeClassOrRecordTypeGot = 'Expression type must be class or record type, got %s';
250   sPropertyNotWritable = 'No member is provided to access property';
251   sIncompatibleTypesGotExpected = 'Incompatible types: got "%s" expected "%s"';
252   sTypesAreNotRelatedXY = 'Types are not related: "%s" and "%s"';
253   sAbstractMethodsCannotBeCalledDirectly = 'Abstract methods cannot be called directly';
254   sMissingParameterX = 'Missing parameter %s';
255   sInstanceMemberXInaccessible = 'Instance member "%s" inaccessible here';
256   sInOperatorExpectsSetElementButGot = 'the in-operator expects a set element, but got %s';
257   sWrongNumberOfParametersForTypeCast = 'wrong number of parameters for type cast to %s';
258   sIllegalTypeConversionTo = 'Illegal type conversion: "%s" to "%s"';
259   sConstantExpressionExpected = 'Constant expression expected';
260   sLeftSideOfIsOperatorExpectsAClassButGot = 'left side of is-operator expects a class, but got "%s"';
261   sNotReadable = 'not readable';
262   sClassPropertyAccessorMustBeStatic = 'class property accessor must be static';
263   sClassPropertyAccessorMustNotBeStatic = 'class property accessor must not be static';
264   sOnlyOneDefaultPropertyIsAllowed = 'Only one default property is allowed';
265   sWrongNumberOfParametersForArray = 'Wrong number of parameters for array';
266   sCantAssignValuesToAnAddress = 'Can''t assign values to an address';
267   sIllegalExpression = 'Illegal expression';
268   sCantAccessXMember = 'Can''t access %s member %s';
269   sMustBeInsideALoop = '%s must be inside a loop';
270   sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
271   sCannotCreateADescendantOfTheSealedXY = 'Cannot create a descendant of the sealed %s "%s"';
272   sAncestorIsNotExternal = 'Ancestor "%s" is not external';
273   sPropertyMustHaveReadOrWrite = 'Property must have read or write accessor';
274   sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
275   sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
276   sXModifierMismatchY = '%s modifier "%s" mismatch';
277   sSymbolCannotBePublished = 'Symbol cannot be published';
278   sCannotTypecastAType = 'Cannot type cast a type';
279   sTypeIdentifierExpected = 'Type identifier expected';
280   sCannotNestAnonymousX = 'Cannot nest anonymous %s';
281   sFoundCallCandidateX = 'Found call candidate %s';
282   sTextAfterFinalIgnored = 'Text after final ''end.''. ignored by compiler';
283   sNoMemberIsProvidedToAccessProperty = 'No member is provided to access property';
284   sTheUseOfXisNotAllowedInARecord = 'The use of "%s" is not allowed in a record';
285   sParameterlessConstructorsNotAllowedInRecords = 'Parameterless constructors are not allowed in records or record/type helpers';
286   sMultipleXinTypeYNameZCAandB = 'Multiple %s in %s %s: %s and %s';
287   sXCannotHaveParameters = '%s cannot have parameters';
288   sSymbolXIsNotPortable = 'Symbol "%s" is not portable';
289   sSymbolXIsExperimental = 'Symbol "%s" is experimental';
290   sSymbolXIsNotImplemented = 'Symbol "%s" is not implemented';
291   sSymbolXBelongsToALibrary = 'Symbol "%s" belongs to a library';
292   sSymbolXIsDeprecated = 'Symbol "%s" is deprecated';
293   sSymbolXIsDeprecatedY = 'Symbol "%s" is deprecated: %s';
294   sRangeCheckError = 'Range check error';
295   sHighRangeLimitLTLowRangeLimit = 'High range limit < low range limit';
296   sRangeCheckEvaluatingConstantsVMinMax = 'range check error while evaluating constants (%s is not between %s and %s)';
297   sIllegalChar = 'Illegal character';
298   sOverflowInArithmeticOperation = 'Overflow in arithmetic operation';
299   sDivByZero = 'Division by zero';
300   sRangeCheckInSetConstructor = 'range check error in set constructor or duplicate set element';
301   sIncompatibleTypesGotParametersExpected = 'Incompatible types, got %s parameters, expected %s';
302   sAddingIndexSpecifierRequiresNewX = 'adding index specifier requires new "%s" specifier';
303   sCantFindUnitX = 'can''t find unit "%s"';
304   sCannotFindEnumeratorForType = 'Cannot find an enumerator for the type "%s"';
305   sPreviousDeclMissesOverload = 'Previous declaration of "%s" at %s was not marked with "overload" directive';
306   sOverloadedProcMissesOverload = 'Overloaded procedure misses "overload" directive. Previous declaration is at %s';
307   sMethodHidesMethodOfBaseType = 'Method "%s" hides method of base type "%s" at %s';
308   sContextExpectedXButFoundY = '%s: expected "%s", but found "%s"';
309   sContextXInvalidY = '%s: invalid %s';
310   sIdentifierXIsNotAnInstanceField = 'Identifier "%s" is not an instance field';
311   sConstructingClassXWithAbstractMethodY = 'Constructing a class "%s" with abstract method "%s"';
312   sXIsNotSupported = '%s is not supported';
313   sOperatorIsNotOverloadedAOpB = 'Operator is not overloaded: "%s" %s "%s"';
314   sIllegalQualifierAfter = 'illegal qualifier "%s" after "%s"';
315   sIllegalQualifierInFrontOf = 'illegal qualifier "%s" in front of "%s"';
316   sIllegalQualifierWithin = 'illegal qualifier "%s" within "%s"';
317   sClassXNotFoundInThisModule = 'class "%s" not found in this module';
318   sNoMatchingImplForIntfMethodXFound = 'No matching implementation for interface method "%s" found';
319   sClassMethodsMustBeStaticInX = 'Class methods must be static in %s';
320   sCannotMixMethodResolutionAndDelegationAtX = 'Cannot mix method resolution and delegation at %s';
321   sImplementsDoesNotSupportArrayProperty = '"implements" does dot support array property';
322   sImplementsDoesNotSupportIndex = '"implements" does not support "index"';
323   sImplementsUsedOnUnimplIntf = 'Implements-property used on unimplemented interface: "%"';
324   sDuplicateImplementsForIntf = 'Duplicate implements for interface "%s" at %s';
325   sImplPropMustHaveReadSpec = 'Implements-property must have read specifier';
326   sDoesNotImplementInterface = '"%s" does not implement interface "%s"';
327   sTypeCycleFound = 'Type cycle found';
328   sTypeXIsNotYetCompletelyDefined = 'type "%s" is not yet completely defined';
329   sDuplicateCaseValueXatY = 'Duplicate case value "%s", other at %s';
330   sMissingFieldsX = 'Missing fields: "%s"';
331   sCantAssignValuesToConstVariable = 'Can''t assign values to const variable';
332   sIllegalAssignmentToForLoopVar = 'Illegal assignment to for-loop variable "%s"';
333   sTypeXCannotBeExtendedByATypeHelper = 'Type "%s" cannot be extended by a type helper';
334   sTypeXCannotBeExtendedByARecordHelper = 'Type "%s" cannot be extended by a record helper';
335   sDerivedXMustExtendASubClassY = 'Derived %s must extend a subclass of "%s" or the class itself';
336   sDefaultPropertyNotAllowedInHelperForX = 'Default property not allowed in helper for %s';
337   sHelpersCannotBeUsedAsTypes = 'helpers cannot be used as types';
338   sMessageHandlersInvalidParams = 'Message handlers can take only one call by ref. parameter';
339   sImplictConversionUnicodeToAnsi = 'Implicit string type conversion with potential data loss from "UnicodeString" to "AnsiString"';
340   sWrongTypeXInArrayConstructor = 'Wrong type "%s" in array constructor';
341   sUnknownCustomAttributeX = 'Unknown custom attribute "%s"';
342   sAttributeIgnoredBecauseAbstractX = 'attribute ignored because abstract %s';
343   sCreatingAnInstanceOfAbstractClassY = 'Creating an instance of abstract class "%s"';
344   sIllegalExpressionAfterX = 'illegal expression after %s';
345   sMethodHidesNonVirtualMethodExactly = 'method hides identifier at "%s". Use reintroduce';
346   sDuplicatePublishedMethodXAtY = 'Duplicate published method "%s" at %s';
347   sConstraintXSpecifiedMoreThanOnce = 'Constraint "%s" specified more than once';
348   sConstraintXAndConstraintYCannotBeTogether = '"%s" constraint and "%s" constraint cannot be specified together';
349   sXIsNotAValidConstraint = '"%s" is not a valid constraint';
350   sWrongNumberOfParametersForGenericX = 'wrong number of parameters for generic %s';
351   sGenericsWithoutSpecializationAsType = 'Generics without specialization cannot be used as a type for a %s';
352   sDeclOfXDiffersFromPrevAtY = 'Declaration of "%s" differs from previous declaration at %s';
353   sTypeParamXIsMissingConstraintY = 'Type parameter "%s" is missing constraint "%s"';
354   sTypeParamXIsNotCompatibleWithY = 'Type parameter "%s" is not compatible with type "%s"';
355   sTypeParamXMustSupportIntfY = 'Type parameter "%s" must support interface "%s"';
356   sTypeParamsNotAllowedOnX = 'Type parameters not allowed on %s';
357   sXMethodsCannotHaveTypeParams = '%s methods cannot have type parameters';
358   sImplMustNotRepeatConstraints = 'Implementations must not repeat constraints';
359   sCouldNotInferTypeArgXForMethodY = 'Could not infer generic type argument "%s" for method "%s"';
360   sInferredTypeXFromDiffArgsMismatchFromMethodY = 'Inferred type "%s" from different arguments mismatch for method "%s"';
361   sParamOfThisTypeCannotHaveDefVal = 'Parameters of this type cannot have default values';
362   sClassTypesAreNotRelatedXY = 'Class types "%s" and "%s" are not related';
363   sDirectiveXNotAllowedHere = 'Directive "%s" not allowed here';
364 
365 type
366   { TResolveData - base class for data stored in TPasElement.CustomData }
367 
368   TResolveData = Class(TPasElementBase)
369   private
370     FElement: TPasElement;
371     procedure SetElement(AValue: TPasElement);
372   public
373     Owner: TObject; // e.g. a TPasResolver
374     Next: TResolveData; // TPasResolver uses this for its memory chain
375     constructor Create; virtual;
376     destructor Destroy; override;
377     property Element: TPasElement read FElement write SetElement;// Element.CustomData=Self
378   end;
379   TResolveDataClass = class of TResolveData;
380 
381 type
382   {$ifdef pas2js}
383   TMaxPrecInt = nativeint;
384   TMaxPrecUInt = NativeUInt;
385   TMaxPrecFloat = double;
386   {$else}
387   TMaxPrecInt = int64;
388   TMaxPrecUInt = qword;
389   TMaxPrecFloat = extended;
390   {$endif}
391   TMaxPrecCurrency = currency;
392 
393   {$ifdef fpc}
394   PMaxPrecInt = ^TMaxPrecInt;
395   PMaxPrecUInt = ^TMaxPrecUInt;
396   PMaxPrecFloat = ^TMaxPrecFloat;
397   PMaxPrecCurrency = ^TMaxPrecCurrency;
398   {$endif}
399 const
400   // Note: when FPC compares int64 with qword it converts the qword to an int64,
401   //       possibly resulting in a range check error -> using a qword const instead
402   HighIntAsUInt = TMaxPrecUInt(High(TMaxPrecInt));
403 
404 const
405   MinSafeIntCurrency = -922337203685477; // .5808
406   MaxSafeIntCurrency =  922337203685477; // .5807
407   MinSafeIntSingle = -16777216;
408   MaxSafeIntSingle =  16777216;
409   MaskUIntSingle = $3fffff;
410   MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 54 bits (52 plus signed bit plus implicit highest bit)
411   MaxSafeIntDouble =  $1fffffffffffff; //  9007199254740991
412   MaskUIntDouble = $1fffffffffffff;
413 
414 type
415   { TResEvalValue }
416 
417   TREVKind = (
418     revkNone,
419     revkCustom,
420     revkNil,  // TResEvalValue
421     revkBool, // TResEvalBool
422     revkInt,  // TResEvalInt
423     revkUInt, // TResEvalUInt
424     revkFloat, // TResEvalFloat
425     revkCurrency, // TResEvalCurrency
426     {$ifdef FPC_HAS_CPSTRING}
427     revkString, // TResEvalString  rawbytestring
428     {$endif}
429     revkUnicodeString, // TResEvalUTF16
430     revkEnum,     // TResEvalEnum
431     revkRangeInt, // TResEvalRangeInt: range of enum, int, char, widechar, e.g. 1..2
432     revkRangeUInt, // TResEvalRangeUInt: range of uint, e.g. 1..2
433     revkSetOfInt,  // set of enum, int, char, widechar, e.g. [1,2..3]
434     revkExternal // TResEvalExternal: an external const
435     );
436 const
437   revkAllStrings = [{$ifdef FPC_HAS_CPSTRING}revkString,{$endif}revkUnicodeString];
438 type
439   TResEvalValue = class(TResolveData)
440   public
441     Kind: TREVKind;
442     IdentEl: TPasElement;
443     // Note: "Element" is used when the TResEvalValue is stored as CustomData of an Element
444     constructor CreateKind(const aKind: TREVKind);
Clonenull445     function Clone: TResEvalValue; virtual;
AsDebugStringnull446     function AsDebugString: string; virtual;
AsStringnull447     function AsString: string; virtual;
448   end;
449   TResEvalValueClass = class of TResEvalValue;
450 
451   { TResEvalBool }
452 
453   TResEvalBool = class(TResEvalValue)
454   public
455     B: boolean;
456     constructor Create; override;
457     constructor CreateValue(const aValue: boolean);
Clonenull458     function Clone: TResEvalValue; override;
AsStringnull459     function AsString: string; override;
460   end;
461 
462   TResEvalTypedInt = (
463     reitNone,
464     reitByte,
465     reitShortInt,
466     reitWord,
467     reitSmallInt,
468     reitUIntSingle,
469     reitIntSingle,
470     reitLongWord,
471     reitLongInt,
472     reitUIntDouble,
473     reitIntDouble);
474   TResEvalTypedInts = set of TResEvalTypedInt;
475 
476 const
477   reitDefaults = [reitNone,reitByte,reitShortInt,reitWord,reitSmallInt,reitLongWord,reitLongInt];
478   reitAllSigned = [reitNone,reitShortInt,reitSmallInt,reitIntSingle,reitLongInt,reitIntDouble];
479   reitAllUnsigned = [reitByte,reitWord,reitUIntSingle,reitLongWord,reitUIntDouble];
480 
481   reitLow: array[TResEvalTypedInt] of TMaxPrecInt = (
482     low(TMaxPrecInt), // reitNone,
483     low(Byte), // reitByte,
484     low(ShortInt), // reitShortInt,
485     low(Word), // reitWord,
486     low(SmallInt), // reitSmallInt,
487     0, // reitUIntSingle,
488     MinSafeIntSingle, // reitIntSingle,
489     low(LongWord), // reitLongWord,
490     low(LongInt), // reitLongInt,
491     0, // reitUIntDouble,
492     MinSafeIntDouble // reitIntDouble)
493     );
494   reitHigh: array[TResEvalTypedInt] of TMaxPrecInt = (
495     high(TMaxPrecInt), // reitNone,
496     high(Byte), // reitByte,
497     high(ShortInt), // reitShortInt,
498     high(Word), // reitWord,
499     high(SmallInt), // reitSmallInt,
500     MaxSafeIntSingle, // reitUIntSingle,
501     MaxSafeIntSingle, // reitIntSingle,
502     high(LongWord), // reitLongWord,
503     high(LongInt), // reitLongInt,
504     MaxSafeIntDouble, // reitUIntDouble,
505     MaxSafeIntDouble // reitIntDouble)
506     );
507 
508 type
509   { TResEvalInt }
510 
511   TResEvalInt = class(TResEvalValue)
512   public
513     Int: TMaxPrecInt;
514     Typed: TResEvalTypedInt;
515     constructor Create; override;
516     constructor CreateValue(const aValue: TMaxPrecInt);
517     constructor CreateValue(const aValue: TMaxPrecInt; aTyped: TResEvalTypedInt);
Clonenull518     function Clone: TResEvalValue; override;
AsStringnull519     function AsString: string; override;
AsDebugStringnull520     function AsDebugString: string; override;
521   end;
522 
523   { TResEvalUInt }
524 
525   TResEvalUInt = class(TResEvalValue)
526   public
527     UInt: TMaxPrecUInt;
528     constructor Create; override;
529     constructor CreateValue(const aValue: TMaxPrecUInt);
Clonenull530     function Clone: TResEvalValue; override;
AsStringnull531     function AsString: string; override;
532   end;
533 
534   { TResEvalFloat }
535 
536   TResEvalFloat = class(TResEvalValue)
537   public
538     FloatValue: TMaxPrecFloat;
539     constructor Create; override;
540     constructor CreateValue(const aValue: TMaxPrecFloat);
Clonenull541     function Clone: TResEvalValue; override;
AsStringnull542     function AsString: string; override;
IsIntnull543     function IsInt(out Int: TMaxPrecInt): boolean;
544   end;
545 
546   { TResEvalCurrency }
547 
548   TResEvalCurrency = class(TResEvalValue)
549   public
550     Value: TMaxPrecCurrency;
551     constructor Create; override;
552     constructor CreateValue(const aValue: TMaxPrecCurrency);
Clonenull553     function Clone: TResEvalValue; override;
AsStringnull554     function AsString: string; override;
IsIntnull555     function IsInt(out Int: TMaxPrecInt): boolean;
AsIntnull556     function AsInt: TMaxPrecInt; // value * 10.000
557   end;
558 
559   {$ifdef FPC_HAS_CPSTRING}
560   { TResEvalString - Kind=revkString }
561 
562   TResEvalString = class(TResEvalValue)
563   public
564     S: RawByteString;
565     constructor Create; override;
566     constructor CreateValue(const aValue: RawByteString);
Clonenull567     function Clone: TResEvalValue; override;
AsStringnull568     function AsString: string; override;
569   end;
570   {$endif}
571 
572   { TResEvalUTF16 - Kind=revkUnicodeString }
573 
574   TResEvalUTF16 = class(TResEvalValue)
575   public
576     S: UnicodeString;
577     constructor Create; override;
578     constructor CreateValue(const aValue: UnicodeString);
Clonenull579     function Clone: TResEvalValue; override;
AsStringnull580     function AsString: string; override;
581   end;
582 
583   { TResEvalEnum - Kind=revkEnum, Value.Int }
584 
585   TResEvalEnum = class(TResEvalValue)
586   public
587     Index: integer; // Beware: might be outside TPasEnumType
588     ElType: TPasEnumType; // TPasEnumType
589     constructor Create; override;
590     constructor CreateValue(const aValue: integer; aIdentEl: TPasEnumValue);
GetEnumValuenull591     function GetEnumValue: TPasEnumValue;
GetEnumNamenull592     function GetEnumName: String;
Clonenull593     function Clone: TResEvalValue; override;
AsDebugStringnull594     function AsDebugString: string; override;
AsStringnull595     function AsString: string; override;
596   end;
597 
598   TRESetElKind = (
599     revskNone,
600     revskEnum, // ElType is TPasEnumType
601     revskInt,
602     revskChar,
603     revskBool
604     );
605 
606   { TResEvalRangeInt - Kind=revkRangeInt }
607 
608   TResEvalRangeInt = class(TResEvalValue)
609   public
610     ElKind: TRESetElKind;
611     RangeStart, RangeEnd: TMaxPrecInt;
612     ElType: TPasType; // revskEnum: TPasEnumType
613     constructor Create; override;
614     constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
615       const aRangeStart, aRangeEnd: TMaxPrecInt); virtual;
Clonenull616     function Clone: TResEvalValue; override;
AsStringnull617     function AsString: string; override;
AsDebugStringnull618     function AsDebugString: string; override;
ElementAsStringnull619     function ElementAsString(El: TMaxPrecInt): string; virtual;
620   end;
621 
622   { TResEvalRangeUInt }
623 
624   TResEvalRangeUInt = class(TResEvalValue)
625   public
626     RangeStart, RangeEnd: TMaxPrecUInt;
627     constructor Create; override;
628     constructor CreateValue(const aRangeStart, aRangeEnd: TMaxPrecUInt);
Clonenull629     function Clone: TResEvalValue; override;
AsStringnull630     function AsString: string; override;
631   end;
632 
633   { TResEvalSet - Kind=revkSetOfInt }
634 
635   TResEvalSet = class(TResEvalRangeInt)
636   public
637     const MaxCount = $ffff;
638     type
639       TItem = record
640         RangeStart, RangeEnd: TMaxPrecInt;
641       end;
642       TItems = array of TItem;
643   public
644     Ranges: TItems; // disjunct, sorted ascending
645     constructor Create; override;
646     constructor CreateEmpty(const aElKind: TRESetElKind; aElType: TPasType = nil);
647     constructor CreateEmptySameKind(aSet: TResEvalSet);
648     constructor CreateValue(const aElKind: TRESetElKind; aElType: TPasType;
649       const aRangeStart, aRangeEnd: TMaxPrecInt); override;
Clonenull650     function Clone: TResEvalValue; override;
AsStringnull651     function AsString: string; override;
Addnull652     function Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean; // false if duplicate ignored
IndexOfRangenull653     function IndexOfRange(Index: TMaxPrecInt; FindInsertPos: boolean = false): integer;
Intersectsnull654     function Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer; // returns index of first intersecting range
655     procedure ConsistencyCheck;
656   end;
657 
658   { TResEvalExternal }
659 
660   TResEvalExternal = class(TResEvalValue)
661   public
662     constructor Create; override;
Clonenull663     function Clone: TResEvalValue; override;
AsStringnull664     function AsString: string; override;
665   end;
666 
667   TResEvalFlag = (
668     refConst, // computing a const, error if a value is not const
669     refConstExt, // as refConst, except allow external const
670     refAutoConst, // set refConst if in a const
671     refAutoConstExt // set refConstExt if in a const
672     );
673   TResEvalFlags = set of TResEvalFlag;
674 
675   TResExprEvaluator = class;
676 
677   TPasResEvalLogHandler = procedure(Sender: TResExprEvaluator; const id: TMaxPrecInt;
678     MsgType: TMessageType; MsgNumber: integer;
679     const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement) of object;
endernull680   TPasResEvalIdentHandler = function(Sender: TResExprEvaluator;
681     Expr: TPrimitiveExpr; Flags: TResEvalFlags): TResEvalValue of object;
endernull682   TPasResEvalParamsHandler = function(Sender: TResExprEvaluator;
683     Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue of object;
684   TPasResEvalRangeCheckElHandler = procedure(Sender: TResExprEvaluator;
685     El: TPasElement; var MsgType: TMessageType) of object;
686 
687   { TResExprEvaluator }
688 
689   TResExprEvaluator = class
690   private
691     FAllowedInts: TResEvalTypedInts;
692     {$ifdef FPC_HAS_CPSTRING}
693     FDefaultEncoding: TSystemCodePage;
694     {$endif}
695     FOnEvalIdentifier: TPasResEvalIdentHandler;
696     FOnEvalParams: TPasResEvalParamsHandler;
697     FOnLog: TPasResEvalLogHandler;
698     FOnRangeCheckEl: TPasResEvalRangeCheckElHandler;
699   protected
700     procedure LogMsg(const id: TMaxPrecInt; MsgType: TMessageType; MsgNumber: integer;
701       const Fmt: String; Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif}; PosEl: TPasElement); overload;
702     procedure RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer; const Fmt: String;
703       Args: Array of {$ifdef pas2js}jsvalue{$else}const{$endif}; ErrorPosEl: TPasElement);
704     procedure RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement; Msg: string = ''); virtual;
705     procedure RaiseInternalError(id: TMaxPrecInt; const Msg: string = '');
706     procedure RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement);
707     procedure RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
708     procedure RaiseOverflowArithmetic(id: TMaxPrecInt; ErrorEl: TPasElement);
709     procedure RaiseDivByZero(id: TMaxPrecInt; ErrorEl: TPasElement);
EvalUnaryExprnull710     function EvalUnaryExpr(Expr: TUnaryExpr; Flags: TResEvalFlags): TResEvalValue;
EvalBinaryExprnull711     function EvalBinaryExpr(Expr: TBinaryExpr; Flags: TResEvalFlags): TResEvalValue;
EvalBinaryRangeExprnull712     function EvalBinaryRangeExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryAddExprnull713     function EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinarySubExprnull714     function EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryMulExprnull715     function EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryDivideExprnull716     function EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryDivExprnull717     function EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryModExprnull718     function EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryPowerExprnull719     function EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryShiftExprnull720     function EvalBinaryShiftExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryBoolOpExprnull721     function EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryNEqualExprnull722     function EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryLessGreaterExprnull723     function EvalBinaryLessGreaterExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinaryInExprnull724     function EvalBinaryInExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalBinarySymmetricaldifferenceExprnull725     function EvalBinarySymmetricaldifferenceExpr(Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
EvalParamsExprnull726     function EvalParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
EvalArrayParamsExprnull727     function EvalArrayParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalValue;
EvalSetParamsExprnull728     function EvalSetParamsExpr(Expr: TParamsExpr; Flags: TResEvalFlags): TResEvalSet;
EvalSetExprnull729     function EvalSetExpr(Expr: TPasExpr; ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
EvalArrayValuesExprnull730     function EvalArrayValuesExpr(Expr: TArrayValues; Flags: TResEvalFlags): TResEvalSet;
EvalPrimitiveExprStringnull731     function EvalPrimitiveExprString(Expr: TPrimitiveExpr): TResEvalValue; virtual;
732     procedure PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
733     procedure SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
734     procedure PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
735     procedure SuccInt(Value: TResEvalInt; ErrorEl: TPasElement);
736     procedure PredUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
737     procedure SuccUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
738     {$ifdef FPC_HAS_CPSTRING}
739     procedure PredString(Value: TResEvalString; ErrorEl: TPasElement);
740     procedure SuccString(Value: TResEvalString; ErrorEl: TPasElement);
741     {$endif}
742     procedure PredUnicodeString(Value: TResEvalUTF16; ErrorEl: TPasElement);
743     procedure SuccUnicodeString(Value: TResEvalUTF16; ErrorEl: TPasElement);
744     procedure PredEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
745     procedure SuccEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
CreateResEvalIntnull746     function CreateResEvalInt(UInt: TMaxPrecUInt): TResEvalValue; virtual;
747   public
748     constructor Create;
Evalnull749     function Eval(Expr: TPasExpr; Flags: TResEvalFlags): TResEvalValue;
IsInRangenull750     function IsInRange(Expr, RangeExpr: TPasExpr; EmitHints: boolean): boolean;
IsInRangenull751     function IsInRange(Value: TResEvalValue; ValueExpr: TPasExpr;
752       RangeValue: TResEvalValue; RangeExpr: TPasExpr; EmitHints: boolean): boolean;
IsSetCompatiblenull753     function IsSetCompatible(Value: TResEvalValue; ValueExpr: TPasExpr;
754       RangeValue: TResEvalValue; EmitHints: boolean): boolean;
IsConstnull755     function IsConst(Expr: TPasExpr): boolean;
IsSimpleExprnull756     function IsSimpleExpr(Expr: TPasExpr): boolean; // true = no need to store result
757     procedure EmitRangeCheckConst(id: TMaxPrecInt; const aValue, MinVal, MaxVal: String;
758       PosEl: TPasElement; MsgType: TMessageType = mtWarning); virtual;
759     procedure EmitRangeCheckConst(id: TMaxPrecInt; const aValue: String;
760       MinVal, MaxVal: TMaxPrecInt; PosEl: TPasElement; MsgType: TMessageType = mtWarning);
ChrValuenull761     function ChrValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalValue; virtual;
OrdValuenull762     function OrdValue(Value: TResEvalValue; ErrorEl: TPasElement): TResEvalValue; virtual;
StringToOrdnull763     function StringToOrd(Value: TResEvalValue; PosEl: TPasElement): longword; virtual;
764     procedure PredValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
765     procedure SuccValue(Value: TResEvalValue; ErrorEl: TPasElement); virtual;
EvalStrFuncnull766     function EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags): TResEvalValue; virtual;
EvalStringAddExprnull767     function EvalStringAddExpr(Expr, LeftExpr, RightExpr: TPasExpr;
768       LeftValue, RightValue: TResEvalValue): TResEvalValue; virtual;
LoHiValuenull769     function LoHiValue(Value: TResEvalValue; ShiftSize: Integer; Mask: LongWord;
770       ErrorEl: TPasElement): TResEvalValue; virtual;
EnumTypeCastnull771     function EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
772       Flags: TResEvalFlags): TResEvalEnum; virtual;
773     {$ifdef FPC_HAS_CPSTRING}
CheckValidUTF8null774     function CheckValidUTF8(const s: RawByteString; ErrorEl: TPasElement): boolean;
GetCodePagenull775     function GetCodePage(const s: RawByteString): TSystemCodePage;
GetRawByteStringnull776     function GetRawByteString(const s: UnicodeString; CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
GetUTF8Strnull777     function GetUTF8Str(const s: RawByteString; ErrorEl: TPasElement): String;
GetUnicodeStrnull778     function GetUnicodeStr(const s: RawByteString; ErrorEl: TPasElement): UnicodeString;
GetWideCharnull779     function GetWideChar(const s: RawByteString; out w: WideChar): boolean;
780     {$endif}
781     property OnLog: TPasResEvalLogHandler read FOnLog write FOnLog;
782     property OnEvalIdentifier: TPasResEvalIdentHandler read FOnEvalIdentifier write FOnEvalIdentifier;
783     property OnEvalParams: TPasResEvalParamsHandler read FOnEvalParams write FOnEvalParams;
784     property OnRangeCheckEl: TPasResEvalRangeCheckElHandler read FOnRangeCheckEl write FOnRangeCheckEl;
785     property AllowedInts: TResEvalTypedInts read FAllowedInts write FAllowedInts;
786     {$ifdef FPC_HAS_CPSTRING}
787     property DefaultStringCodePage: TSystemCodePage read FDefaultEncoding write FDefaultEncoding;
788     {$endif}
789   end;
790   TResExprEvaluatorClass = class of TResExprEvaluator;
791 
792 procedure ReleaseEvalValue(var Value: TResEvalValue);
NumberIsFloatnull793 function NumberIsFloat(const Value: string): boolean;
794 
795 {$ifdef FPC_HAS_CPSTRING}
RawStrToCaptionnull796 function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
797 {$endif}
UnicodeStrToCaptionnull798 function UnicodeStrToCaption(const u: UnicodeString; MaxLength: integer): Unicodestring;
CodePointToStringnull799 function CodePointToString(CodePoint: longword): String;
CodePointToUnicodeStringnull800 function CodePointToUnicodeString(u: longword): UnicodeString;
801 
GetObjNamenull802 function GetObjName(o: TObject): string;
GetObjPathnull803 function GetObjPath(o: TObject): string;
GetGenericParamCommasnull804 function GetGenericParamCommas(Cnt: integer): string;
GetElementNameAndParamsnull805 function GetElementNameAndParams(El: TPasElement; MaxLvl: integer = 3): string;
GetTypeParamNamesnull806 function GetTypeParamNames(Templates: TFPList; MaxLvl: integer = 3): string;
dbgsnull807 function dbgs(const Flags: TResEvalFlags): string; overload;
dbgsnull808 function dbgs(v: TResEvalValue): string; overload;
LastPosnull809 function LastPos(c: char; const s: string): sizeint;
810 
811 implementation
812 
813 procedure ReleaseEvalValue(var Value: TResEvalValue);
814 begin
815   if Value=nil then exit;
816   if Value.Element<>nil then exit;
817   Value.{$ifdef pas2js}Destroy{$else}Free{$endif};
818   Value:=nil;
819 end;
820 
NumberIsFloatnull821 function NumberIsFloat(const Value: string): boolean;
822 var
823   i: Integer;
824 begin
825   if Value='' then exit(false);
826   if Value[1] in ['$','%','&'] then exit(false);
827   for i:=2 to length(Value) do
828     if Value[i] in ['.','E','e'] then exit(true);
829   Result:=false;
830 end;
831 
832 {$ifdef FPC_HAS_CPSTRING}
RawStrToCaptionnull833 function RawStrToCaption(const r: RawByteString; MaxLength: integer): string;
834 var
835   s: RawByteString;
836   p: PAnsiChar;
837   InLit: boolean;
838   Len: integer;
839 
840   procedure AddHash(o: integer);
841   var
842     h: String;
843   begin
844     if (Result<>'') and InLit then
845       begin
846       Result:=Result+'''';
847       inc(Len);
848       InLit:=false;
849       end;
850     h:='#'+IntToStr(o);
851     inc(Len,length(h));
852     if Len<=MaxLength then
853       Result:=Result+h;
854   end;
855 
856   procedure AddLit(const Lit: string; CaptionLen: integer);
857   begin
858     if not InLit then
859       begin
860       Result:=Result+'''';
861       inc(Len);
862       InLit:=true;
863       end;
864     Result:=Result+Lit;
865     inc(Len,CaptionLen);
866   end;
867 
868 var
869   l: SizeInt;
870   CP: TSystemCodePage;
871   EndP: PAnsiChar;
872 begin
873   Result:='';
874   s:=r;
875   CP:=StringCodePage(s);
876   if (CP<>CP_ACP) and (CP<>CP_UTF8) then
877     SetCodePage(s, CP_ACP, true);
878   p:=PAnsiChar(s);
879   EndP:=p+length(s);
880   Len:=0;
881   InLit:=false;
882   while Len<MaxLength do
883     case p^ of
884     #0:
885       begin
886       if p-PAnsiChar(s)=length(s) then
887         break;
888       AddHash(0);
889       inc(p);
890       end;
891     '''':
892       begin
893       AddLit('''''',2);
894       inc(p);
895       end;
896     #1..#31,#127..#192:
897       begin
898       AddHash(ord(p^));
899       inc(p);
900       end
901     else
902       begin
903       l:=Utf8CodePointLen(p,EndP-p,true);
904       if l<=0 then
905         begin
906         // invalid
907         AddHash(ord(p^));
908         inc(p);
909         end
910       else
911         begin
912         AddLit(copy(s,p-PAnsiChar(s)+1,l),1);
913         inc(p,l);
914         end;
915       end;
916     end;
917   if InLit then
918     Result:=Result+'''';
919 end;
920 {$endif}
921 
UnicodeStrToCaptionnull922 function UnicodeStrToCaption(const u: UnicodeString; MaxLength: integer
923   ): Unicodestring;
924 var
925   InLit: boolean;
926   Len: integer;
927 
928   procedure AddHash(o: integer);
929   var
930     h: UnicodeString;
931   begin
932     if (Result<>'') and InLit then
933       begin
934       Result:=Result+'''';
935       inc(Len);
936       InLit:=false;
937       end;
938     h:='#'+UnicodeString(IntToStr(o));
939     inc(Len,length(h));
940     if Len<=MaxLength then
941       Result:=Result+h;
942   end;
943 
944   procedure AddLit(const Lit: Unicodestring; CaptionLen: integer);
945   begin
946     if not InLit then
947       begin
948       Result:=Result+'''';
949       inc(Len);
950       InLit:=true;
951       end;
952     Result:=Result+Lit;
953     inc(Len,CaptionLen);
954   end;
955 
956 var
957   p: integer;
958 begin
959   Result:='';
960   p:=1;
961   Len:=0;
962   InLit:=false;
963   while (Len<MaxLength) and (p<=length(u)) do
964     case u[p] of
965     '''':
966       begin
967       AddLit('''''',2);
968       inc(p);
969       end;
970     #0..#31,#127..#255,#$D800..#$ffff:
971       begin
972       AddHash(ord(u[p]));
973       inc(p);
974       end
975     else
976       begin
977       AddLit(u[p],1);
978       inc(p);
979       end;
980     end;
981   if InLit then
982     Result:=Result+'''';
983 end;
984 
CodePointToStringnull985 function CodePointToString(CodePoint: longword): String;
986 begin
987   case CodePoint of
988     0..$7f:
989       begin
990         Result:=char(byte(CodePoint));
991       end;
992     $80..$7ff:
993       begin
994         Result:=char(byte($c0 or (CodePoint shr 6)))
995                +char(byte($80 or (CodePoint and $3f)));
996       end;
997     $800..$ffff:
998       begin
999         Result:=char(byte($e0 or (CodePoint shr 12)))
1000                +char(byte((CodePoint shr 6) and $3f) or $80)
1001                +char(byte(CodePoint and $3f) or $80);
1002       end;
1003     $10000..$10ffff:
1004       begin
1005         Result:=char(byte($f0 or (CodePoint shr 18)))
1006                +char(byte((CodePoint shr 12) and $3f) or $80)
1007                +char(byte((CodePoint shr 6) and $3f) or $80)
1008                +char(byte(CodePoint and $3f) or $80);
1009       end;
1010   else
1011     Result:='';
1012   end;
1013 end;
1014 
CodePointToUnicodeStringnull1015 function CodePointToUnicodeString(u: longword): UnicodeString;
1016 begin
1017   if u < $10000 then
1018     // Note: codepoints $D800 - $DFFF are reserved
1019     Result:=WideChar(u)
1020   else
1021     Result:=WideChar($D800+((u - $10000) shr 10))+WideChar($DC00+((u - $10000) and $3ff));
1022 end;
1023 
GetObjNamenull1024 function GetObjName(o: TObject): string;
1025 var
1026   GenType: TPasGenericType;
1027 begin
1028   if o=nil then
1029     Result:='nil'
1030   else if o is TPasElement then
1031     begin
1032     Result:=TPasElement(o).Name;
1033     if o is TPasGenericType then
1034       begin
1035       GenType:=TPasGenericType(o);
1036       if (GenType.GenericTemplateTypes<>nil)
1037           and (GenType.GenericTemplateTypes.Count>0) then
1038         Result:=Result+GetGenericParamCommas(GenType.GenericTemplateTypes.Count);
1039       end;
1040     Result:=Result+':'+o.ClassName;
1041     end
1042   else
1043     Result:=o.ClassName;
1044 end;
1045 
GetObjPathnull1046 function GetObjPath(o: TObject): string;
1047 var
1048   El: TPasElement;
1049   GenType: TPasGenericType;
1050 begin
1051   if o is TPasElement then
1052     begin
1053     El:=TPasElement(o);
1054     Result:=':'+El.ClassName;
1055     while El<>nil do
1056       begin
1057       if El<>o then
1058         Result:='.'+Result;
1059       if El is TPasGenericType then
1060         begin
1061         GenType:=TPasGenericType(El);
1062         if (GenType.GenericTemplateTypes<>nil)
1063             and (GenType.GenericTemplateTypes.Count>0) then
1064           Result:=GetGenericParamCommas(GenType.GenericTemplateTypes.Count)+Result;
1065         end;
1066       if El.Name<>'' then
1067         begin
1068         if IsValidIdent(El.Name) then
1069           Result:=El.Name+Result
1070         else
1071           Result:='"'+El.Name+'"'+Result;
1072         end
1073       else
1074         Result:='['+El.ClassName+']'+Result;
1075       El:=El.Parent;
1076       end;
1077     end
1078   else
1079     Result:=GetObjName(o);
1080 end;
1081 
GetGenericParamCommasnull1082 function GetGenericParamCommas(Cnt: integer): string;
1083 begin
1084   if Cnt<=0 then
1085     Result:=''
1086   else
1087     Result:='<'+StringOfChar(',',Cnt-1)+'>';
1088 end;
1089 
GetElementNameAndParamsnull1090 function GetElementNameAndParams(El: TPasElement; MaxLvl: integer): string;
1091 begin
1092   if El=nil then
1093     exit('(nil)');
1094   Result:=El.Name;
1095   if El is TPasGenericType then
1096     Result:=Result+GetTypeParamNames(TPasGenericType(El).GenericTemplateTypes,MaxLvl-1);
1097 end;
1098 
GetTypeParamNamesnull1099 function GetTypeParamNames(Templates: TFPList; MaxLvl: integer): string;
1100 var
1101   i: Integer;
1102   El: TPasElement;
1103 begin
1104   if (Templates=nil) or (Templates.Count=0) then
1105     exit('');
1106   if MaxLvl<=0 then
1107     exit('...');
1108   Result:='<';
1109   for i:=0 to Templates.Count-1 do
1110     begin
1111     if i>0 then
1112       Result:=Result+',';
1113     El:=TPasElement(Templates[i]);
1114     if El.Name<>'' then
1115       Result:=Result+GetElementNameAndParams(El,MaxLvl-1)
1116     else if El is TPasArrayType then
1117       Result:=Result+'array...'
1118     else
1119       Result:=Result+'...';
1120     end;
1121   Result:=Result+'>';
1122 end;
1123 
dbgsnull1124 function dbgs(const Flags: TResEvalFlags): string;
1125 var
1126   s: string;
1127   f: TResEvalFlag;
1128 begin
1129   Result:='';
1130   for f in Flags do
1131     if f in Flags then
1132       begin
1133       if Result<>'' then Result:=Result+',';
1134       str(f,s);
1135       Result:=Result+s;
1136       end;
1137   Result:='['+Result+']';
1138 end;
1139 
dbgsnull1140 function dbgs(v: TResEvalValue): string;
1141 begin
1142   if v=nil then
1143     Result:='nil'
1144   else
1145     Result:=v.AsDebugString;
1146 end;
1147 
LastPosnull1148 function LastPos(c: char; const s: string): sizeint;
1149 var
1150   i: SizeInt;
1151 begin
1152   for i:=length(s) downto 1 do
1153     if s[i]=c then exit(i);
1154   Result:=-1;
1155 end;
1156 
1157 { TResEvalExternal }
1158 
1159 constructor TResEvalExternal.Create;
1160 begin
1161   inherited Create;
1162   Kind:=revkExternal;
1163 end;
1164 
TResEvalExternal.Clonenull1165 function TResEvalExternal.Clone: TResEvalValue;
1166 begin
1167   Result:=inherited Clone;
1168 end;
1169 
AsStringnull1170 function TResEvalExternal.AsString: string;
1171 begin
1172   Result:=inherited AsString;
1173 end;
1174 
1175 { TResEvalCurrency }
1176 
1177 constructor TResEvalCurrency.Create;
1178 begin
1179   inherited Create;
1180   Kind:=revkCurrency;
1181 end;
1182 
1183 constructor TResEvalCurrency.CreateValue(const aValue: TMaxPrecCurrency);
1184 begin
1185   Create;
1186   Value:=aValue;
1187 end;
1188 
TResEvalCurrency.Clonenull1189 function TResEvalCurrency.Clone: TResEvalValue;
1190 begin
1191   Result:=inherited Clone;
1192   TResEvalCurrency(Result).Value:=Value;
1193 end;
1194 
AsStringnull1195 function TResEvalCurrency.AsString: string;
1196 begin
1197   str(Value,Result);
1198 end;
1199 
TResEvalCurrency.IsIntnull1200 function TResEvalCurrency.IsInt(out Int: TMaxPrecInt): boolean;
1201 var
1202   i: TMaxPrecInt;
1203 begin
1204   i:=AsInt;
1205   Result:=(i mod 10000)=0;
1206   Int:=i div 10000;
1207 end;
1208 
TResEvalCurrency.AsIntnull1209 function TResEvalCurrency.AsInt: TMaxPrecInt;
1210 begin
1211   {$ifdef pas2js}
1212   Result:=NativeInt(Value); // pas2js stores currency as a double with factor 10.000
1213   {$else}
1214   Result:=PInt64(@Value)^; // fpc stores currency as an int64 with factor 10.000
1215   {$endif};
1216 end;
1217 
1218 { TResEvalBool }
1219 
1220 constructor TResEvalBool.Create;
1221 begin
1222   inherited Create;
1223   Kind:=revkBool;
1224 end;
1225 
1226 constructor TResEvalBool.CreateValue(const aValue: boolean);
1227 begin
1228   Create;
1229   B:=aValue;
1230 end;
1231 
TResEvalBool.Clonenull1232 function TResEvalBool.Clone: TResEvalValue;
1233 begin
1234   Result:=inherited Clone;
1235   TResEvalBool(Result).B:=B;
1236 end;
1237 
AsStringnull1238 function TResEvalBool.AsString: string;
1239 begin
1240   if B then
1241     Result:='true'
1242   else
1243     Result:='false';
1244 end;
1245 
1246 { TResEvalRangeUInt }
1247 
1248 constructor TResEvalRangeUInt.Create;
1249 begin
1250   inherited Create;
1251   Kind:=revkRangeInt;
1252 end;
1253 
1254 constructor TResEvalRangeUInt.CreateValue(const aRangeStart,
1255   aRangeEnd: TMaxPrecUInt);
1256 begin
1257   Create;
1258   RangeStart:=aRangeStart;
1259   RangeEnd:=aRangeEnd;
1260 end;
1261 
TResEvalRangeUInt.Clonenull1262 function TResEvalRangeUInt.Clone: TResEvalValue;
1263 begin
1264   Result:=inherited Clone;
1265   TResEvalRangeUInt(Result).RangeStart:=RangeStart;
1266   TResEvalRangeUInt(Result).RangeEnd:=RangeEnd;
1267 end;
1268 
AsStringnull1269 function TResEvalRangeUInt.AsString: string;
1270 begin
1271   Result:=IntToStr(RangeStart)+'..'+IntToStr(RangeEnd);
1272 end;
1273 
1274 { TResExprEvaluator }
1275 
1276 procedure TResExprEvaluator.LogMsg(const id: TMaxPrecInt; MsgType: TMessageType;
1277   MsgNumber: integer; const Fmt: String;
1278   Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
1279   PosEl: TPasElement);
1280 begin
1281   OnLog(Self,id,MsgType,MsgNumber,Fmt,Args,PosEl);
1282 end;
1283 
1284 procedure TResExprEvaluator.RaiseMsg(const Id: TMaxPrecInt; MsgNumber: integer;
1285   const Fmt: String; Args: array of {$ifdef pas2js}jsvalue{$else}const{$endif};
1286   ErrorPosEl: TPasElement);
1287 begin
1288   LogMsg(id,mtError,MsgNumber,Fmt,Args,ErrorPosEl);
1289   raise Exception.Create('['+IntToStr(id)+'] ('+IntToStr(MsgNumber)+') '+SafeFormat(Fmt,Args));
1290 end;
1291 
1292 procedure TResExprEvaluator.RaiseNotYetImplemented(id: TMaxPrecInt; El: TPasElement;
1293   Msg: string);
1294 var
1295   s: String;
1296 begin
1297   s:=sNotYetImplemented+' ['+IntToStr(id)+']';
1298   if Msg<>'' then
1299     s:=s+' '+Msg;
1300   {$IFDEF VerbosePasResolver}
1301   writeln('TResExprEvaluator.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
1302   {$ENDIF}
1303   RaiseMsg(id,nNotYetImplemented,s,[GetObjName(El)],El);
1304 end;
1305 
1306 procedure TResExprEvaluator.RaiseInternalError(id: TMaxPrecInt; const Msg: string);
1307 begin
1308   raise Exception.Create('Internal error: ['+IntToStr(id)+'] '+Msg);
1309 end;
1310 
1311 procedure TResExprEvaluator.RaiseConstantExprExp(id: TMaxPrecInt; ErrorEl: TPasElement
1312   );
1313 begin
1314   RaiseMsg(id,nConstantExpressionExpected,sConstantExpressionExpected,[],ErrorEl);
1315 end;
1316 
1317 procedure TResExprEvaluator.RaiseRangeCheck(id: TMaxPrecInt; ErrorEl: TPasElement);
1318 begin
1319   RaiseMsg(id,nRangeCheckError,sRangeCheckError,[],ErrorEl);
1320 end;
1321 
1322 procedure TResExprEvaluator.RaiseOverflowArithmetic(id: TMaxPrecInt;
1323   ErrorEl: TPasElement);
1324 begin
1325   RaiseMsg(id,nOverflowInArithmeticOperation,sOverflowInArithmeticOperation,[],ErrorEl);
1326 end;
1327 
1328 procedure TResExprEvaluator.RaiseDivByZero(id: TMaxPrecInt; ErrorEl: TPasElement);
1329 begin
1330   RaiseMsg(id,nDivByZero,sDivByZero,[],ErrorEl);
1331 end;
1332 
EvalUnaryExprnull1333 function TResExprEvaluator.EvalUnaryExpr(Expr: TUnaryExpr; Flags: TResEvalFlags
1334   ): TResEvalValue;
1335 var
1336   Int: TMaxPrecInt;
1337   UInt: TMaxPrecUInt;
1338 begin
1339   Result:=Eval(Expr.Operand,Flags);
1340   if Result=nil then exit;
1341   {$IFDEF VerbosePasResEval}
1342   writeln('TResExprEvaluator.EvalUnaryExpr ',OpcodeStrings[Expr.OpCode],' Value=',Result.AsDebugString);
1343   {$ENDIF}
1344   case Expr.OpCode of
1345     eopAdd: ;
1346     eopSubtract:
1347       case Result.Kind of
1348       revkInt:
1349         begin
1350         Int:=TResEvalInt(Result).Int;
1351         if Int=0 then exit;
1352         if Result.Element<>nil then
1353           Result:=Result.Clone;
1354         if (TResEvalInt(Result).Typed in reitAllSigned) then
1355           begin
1356           if Int=reitLow[TResEvalInt(Result).Typed] then
1357             begin
1358             // need higher precision
1359             if TResEvalInt(Result).Typed<>reitNone then
1360               // unsigned -> switch to untyped
1361               TResEvalInt(Result).Typed:=reitNone
1362             else
1363               begin
1364               // switch to float
1365               ReleaseEvalValue(Result);
1366               Result:=TResEvalFloat.CreateValue(-TMaxPrecFloat(low(TMaxPrecInt)));
1367               exit;
1368               end;
1369             end;
1370           end
1371         else
1372           begin
1373           // unsigned -> switch to untyped
1374           TResEvalInt(Result).Typed:=reitNone;
1375           end ;
1376         // negate
1377         TResEvalInt(Result).Int:=-Int;
1378         end;
1379       revkUInt:
1380         begin
1381         UInt:=TResEvalUInt(Result).UInt;
1382         if UInt=0 then exit;
1383         if UInt<=High(TMaxPrecInt) then
1384           begin
1385           ReleaseEvalValue(Result);
1386           Result:=TResEvalInt.CreateValue(-TMaxPrecInt(UInt));
1387           end
1388         else
1389           begin
1390           // switch to float
1391           ReleaseEvalValue(Result);
1392           Result:=TResEvalFloat.CreateValue(-TMaxPrecFloat(UInt));
1393           end;
1394         end;
1395       revkFloat:
1396         begin
1397         if TResEvalFloat(Result).FloatValue=0 then exit;
1398         if Result.Element<>nil then
1399           Result:=Result.Clone;
1400         TResEvalFloat(Result).FloatValue:=-TResEvalFloat(Result).FloatValue;
1401         end;
1402       revkCurrency:
1403         begin
1404         if TResEvalCurrency(Result).Value=0 then exit;
1405         if Result.Element<>nil then
1406           Result:=Result.Clone;
1407         TResEvalCurrency(Result).Value:=-TResEvalCurrency(Result).Value;
1408         end;
1409       revkExternal:
1410         exit;
1411       else
1412         begin
1413         if Result.Element=nil then
1414           Result.Free;
1415         RaiseNotYetImplemented(20170518230738,Expr);
1416         end;
1417       end;
1418     eopNot:
1419       case Result.Kind of
1420       revkBool:
1421         begin
1422         if Result.Element<>nil then
1423           Result:=Result.Clone;
1424         TResEvalBool(Result).B:=not TResEvalBool(Result).B;
1425         end;
1426       revkInt:
1427         begin
1428         if Result.Element<>nil then
1429           Result:=Result.Clone;
1430         case TResEvalInt(Result).Typed of
1431           reitByte: TResEvalInt(Result).Int:=not byte(TResEvalInt(Result).Int);
1432           reitShortInt: TResEvalInt(Result).Int:=not shortint(TResEvalInt(Result).Int);
1433           reitWord: TResEvalInt(Result).Int:=not word(TResEvalInt(Result).Int);
1434           reitSmallInt: TResEvalInt(Result).Int:=not smallint(TResEvalInt(Result).Int);
1435           reitUIntSingle: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $3fffff;
1436           reitIntSingle: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $7fffff;
1437           reitLongWord: TResEvalInt(Result).Int:=not longword(TResEvalInt(Result).Int);
1438           reitLongInt: TResEvalInt(Result).Int:=not longint(TResEvalInt(Result).Int);
1439           reitUIntDouble: TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $fffffffffffff;
1440           reitIntDouble: {$ifdef fpc}TResEvalInt(Result).Int:=(not TResEvalInt(Result).Int) and $1fffffffffffff{$endif};
1441           else TResEvalInt(Result).Int:=not TResEvalInt(Result).Int;
1442         end;
1443         end;
1444       revkUInt:
1445         begin
1446         if Result.Element<>nil then
1447           Result:=Result.Clone;
1448         TResEvalUInt(Result).UInt:=not TResEvalUInt(Result).UInt;
1449         end;
1450       revkExternal:
1451         exit;
1452       else
1453         begin
1454         if Result.Element=nil then
1455           Result.Free;
1456         RaiseNotYetImplemented(20170518232804,Expr);
1457         end;
1458       end;
1459     eopAddress:
1460       begin
1461       if Result.Element=nil then
1462         Result.Free;
1463       // @ operator requires a compiler (not just a resolver) -> return nil
1464       Result:=TResEvalValue.CreateKind(revkNil);
1465       end
1466     else
1467       RaiseNotYetImplemented(20170518232823,Expr,'operator='+OpcodeStrings[Expr.OpCode]);
1468     end;
1469 end;
1470 
TResExprEvaluator.EvalBinaryExprnull1471 function TResExprEvaluator.EvalBinaryExpr(Expr: TBinaryExpr;
1472   Flags: TResEvalFlags): TResEvalValue;
1473 var
1474   LeftValue, RightValue: TResEvalValue;
1475 begin
1476   Result:=nil;
1477   if (Expr.Kind=pekBinary) and (Expr.OpCode=eopSubIdent) then
1478     begin
1479     Result:=Eval(Expr.right,Flags);
1480     exit;
1481     end;
1482   LeftValue:=nil;
1483   RightValue:=nil;
1484   try
1485     LeftValue:=Eval(Expr.left,Flags);
1486     if LeftValue=nil then exit;
1487     RightValue:=Eval(Expr.right,Flags);
1488     if RightValue=nil then exit;
1489 
1490     if LeftValue.Kind=revkExternal then
1491       begin
1492       if [refConst,refConstExt]*Flags=[refConst] then
1493         RaiseConstantExprExp(20181024134508,Expr.left);
1494       Result:=LeftValue;
1495       LeftValue:=nil;
1496       exit;
1497       end;
1498     if RightValue.Kind=revkExternal then
1499       begin
1500       if [refConst,refConstExt]*Flags=[refConst] then
1501         RaiseConstantExprExp(20181024134545,Expr.right);
1502       Result:=RightValue;
1503       RightValue:=nil;
1504       exit;
1505       end;
1506 
1507     case Expr.Kind of
1508     pekRange:
1509       // leftvalue..rightvalue
1510       Result:=EvalBinaryRangeExpr(Expr,LeftValue,RightValue);
1511     pekBinary:
1512       case Expr.OpCode of
1513       eopAdd:
1514         Result:=EvalBinaryAddExpr(Expr,LeftValue,RightValue);
1515       eopSubtract:
1516         Result:=EvalBinarySubExpr(Expr,LeftValue,RightValue);
1517       eopMultiply:
1518         Result:=EvalBinaryMulExpr(Expr,LeftValue,RightValue);
1519       eopDivide:
1520         Result:=EvalBinaryDivideExpr(Expr,LeftValue,RightValue);
1521       eopDiv:
1522         Result:=EvalBinaryDivExpr(Expr,LeftValue,RightValue);
1523       eopMod:
1524         Result:=EvalBinaryModExpr(Expr,LeftValue,RightValue);
1525       eopPower:
1526         Result:=EvalBinaryPowerExpr(Expr,LeftValue,RightValue);
1527       eopShl,eopShr:
1528         Result:=EvalBinaryShiftExpr(Expr,LeftValue,RightValue);
1529       eopAnd,eopOr,eopXor:
1530         Result:=EvalBinaryBoolOpExpr(Expr,LeftValue,RightValue);
1531       eopEqual,eopNotEqual:
1532         Result:=EvalBinaryNEqualExpr(Expr,LeftValue,RightValue);
1533       eopLessThan,eopGreaterThan, eopLessthanEqual,eopGreaterThanEqual:
1534         Result:=EvalBinaryLessGreaterExpr(Expr,LeftValue,RightValue);
1535       eopIn:
1536         Result:=EvalBinaryInExpr(Expr,LeftValue,RightValue);
1537       eopSymmetricaldifference:
1538         Result:=EvalBinarySymmetricaldifferenceExpr(Expr,LeftValue,RightValue);
1539       else
1540         {$IFDEF VerbosePasResolver}
1541         writeln('TResExprEvaluator.EvalBinaryExpr Kind=',Expr.Kind,' Opcode=',OpcodeStrings[Expr.OpCode],' Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1542         {$ENDIF}
1543         RaiseNotYetImplemented(20170530100823,Expr);
1544       end;
1545     else
1546       {$IFDEF VerbosePasResolver}
1547       writeln('TResExprEvaluator.EvalBinaryExpr Kind=',Expr.Kind,' Opcode=',OpcodeStrings[Expr.OpCode]);
1548       {$ENDIF}
1549       RaiseNotYetImplemented(20170530100827,Expr);
1550     end;
1551     {$IFDEF VerbosePasResEval}
1552     {AllowWriteln}
1553     if Result<>nil then
1554       writeln('TResExprEvaluator.EvalBinaryExpr Left=',LeftValue.AsDebugString,' Opcode=',OpcodeStrings[Expr.OpCode],' Right=',RightValue.AsDebugString,' Result=',Result.AsDebugString)
1555     else
1556       writeln('TResExprEvaluator.EvalBinaryExpr Left=',LeftValue.AsDebugString,' Opcode=',OpcodeStrings[Expr.OpCode],' Right=',RightValue.AsDebugString,' Result not set');
1557     {AllowWriteln-}
1558     {$ENDIF}
1559   finally
1560     ReleaseEvalValue(LeftValue);
1561     ReleaseEvalValue(RightValue);
1562   end;
1563 end;
1564 
TResExprEvaluator.EvalBinaryRangeExprnull1565 function TResExprEvaluator.EvalBinaryRangeExpr(Expr: TBinaryExpr; LeftValue,
1566   RightValue: TResEvalValue): TResEvalValue;
1567 // LeftValue..RightValue
1568 var
1569   LeftInt, RightInt: TMaxPrecInt;
1570 begin
1571   case LeftValue.Kind of
1572   revkBool:
1573     if RightValue.Kind<>revkBool then
1574       RaiseRangeCheck(20170714133017,Expr.Right)
1575     else
1576       begin
1577       LeftInt:=ord(TResEvalBool(LeftValue).B);
1578       RightInt:=ord(TResEvalBool(RightValue).B);
1579       if LeftInt>RightInt then
1580         RaiseMsg(20170714133540,nHighRangeLimitLTLowRangeLimit,
1581            sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1582       Result:=TResEvalRangeInt.CreateValue(revskBool,nil,LeftInt,RightInt);
1583       exit;
1584       end;
1585   revkInt:
1586     if RightValue.Kind=revkInt then
1587       begin
1588       LeftInt:=TResEvalInt(LeftValue).Int;
1589       RightInt:=TResEvalInt(RightValue).Int;
1590       if LeftInt>RightInt then
1591         RaiseMsg(20170518222939,nHighRangeLimitLTLowRangeLimit,
1592           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1593       Result:=TResEvalRangeInt.CreateValue(revskInt,nil,LeftInt,RightInt);
1594       exit;
1595       end
1596     else if RightValue.Kind=revkUInt then
1597       begin
1598       // Note: when FPC compares int64 with qword it converts the qword to an int64
1599       if TResEvalUInt(RightValue).UInt<=HighIntAsUInt then
1600         begin
1601         if TResEvalInt(LeftValue).Int>TResEvalUInt(RightValue).UInt then
1602           RaiseMsg(20170519000235,nHighRangeLimitLTLowRangeLimit,
1603             sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1604         Result:=TResEvalRangeInt.CreateValue(revskInt,nil,
1605            TResEvalInt(LeftValue).Int,TMaxPrecInt(TResEvalUInt(RightValue).UInt));
1606         exit;
1607         end
1608       else if TResEvalInt(LeftValue).Int<0 then
1609         RaiseRangeCheck(20170522151629,Expr.Right)
1610       else if TMaxPrecUInt(TResEvalInt(LeftValue).Int)>TResEvalUInt(RightValue).UInt then
1611         RaiseMsg(20170522151708,nHighRangeLimitLTLowRangeLimit,
1612           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1613       Result:=TResEvalRangeUInt.CreateValue(TMaxPrecUInt(TResEvalInt(LeftValue).Int),
1614          TResEvalUInt(RightValue).UInt);
1615       exit;
1616       end
1617     else
1618       RaiseRangeCheck(20170518222812,Expr.Right);
1619   revkUInt:
1620     if RightValue.Kind=revkInt then
1621       begin
1622       // Note: when FPC compares int64 with qword it converts the qword to an int64
1623       if TResEvalUInt(LeftValue).UInt>HighIntAsUInt then
1624         begin
1625         if TResEvalInt(RightValue).Int<0 then
1626           RaiseRangeCheck(20170522152608,Expr.Right)
1627         else if TResEvalUInt(LeftValue).UInt>TMaxPrecUInt(TResEvalInt(RightValue).Int) then
1628           RaiseMsg(20170522152648,nHighRangeLimitLTLowRangeLimit,
1629             sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1630         Result:=TResEvalRangeUInt.CreateValue(TResEvalUInt(LeftValue).UInt,
1631           TMaxPrecUInt(TResEvalInt(RightValue).Int));
1632         exit;
1633         end
1634       else if TResEvalUInt(LeftValue).UInt>TResEvalInt(RightValue).Int then
1635         RaiseMsg(20170522152804,nHighRangeLimitLTLowRangeLimit,
1636           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1637       Result:=TResEvalRangeInt.CreateValue(revskInt,nil,
1638         TMaxPrecInt(TResEvalUInt(LeftValue).UInt),TResEvalInt(RightValue).Int);
1639       exit;
1640       end
1641     else if RightValue.Kind=revkUInt then
1642       begin
1643       if TResEvalUInt(LeftValue).UInt>TResEvalUInt(RightValue).UInt then
1644         RaiseMsg(20170519000240,nHighRangeLimitLTLowRangeLimit,
1645           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1646       Result:=TResEvalRangeUInt.CreateValue(TResEvalUInt(LeftValue).UInt,
1647         TResEvalUInt(RightValue).UInt);
1648       exit;
1649       end
1650     else
1651       RaiseRangeCheck(20170522123106,Expr.Right);
1652   revkEnum:
1653     if (RightValue.Kind<>revkEnum) then
1654       RaiseRangeCheck(20170522153003,Expr.Right)
1655     else if (TResEvalEnum(LeftValue).ElType<>TResEvalEnum(RightValue).ElType) then
1656       begin
1657       {$IFDEF VerbosePasResolver}
1658       writeln('TResExprEvaluator.EvalBinaryRangeExpr LeftValue=',dbgs(LeftValue),',',GetObjName(TResEvalEnum(LeftValue).ElType),' RightValue=',dbgs(RightValue),',',GetObjName(TResEvalEnum(RightValue).ElType));
1659       {$ENDIF}
1660       RaiseRangeCheck(20170522123241,Expr.Right) // mismatch enumtype
1661       end
1662     else if TResEvalEnum(LeftValue).Index>TResEvalEnum(RightValue).Index then
1663       RaiseMsg(20170522123320,nHighRangeLimitLTLowRangeLimit,
1664         sHighRangeLimitLTLowRangeLimit,[],Expr.Right)
1665     else
1666       begin
1667       Result:=TResEvalRangeInt.CreateValue(revskEnum,
1668         TResEvalEnum(LeftValue).ElType as TPasEnumType,
1669         TResEvalEnum(LeftValue).Index,TResEvalEnum(RightValue).Index);
1670       exit;
1671       end;
1672   {$ifdef FPC_HAS_CPSTRING}
1673   revkString,
1674   {$endif}
1675   revkUnicodeString:
1676     begin
1677     LeftInt:=StringToOrd(LeftValue,Expr.left);
1678     if RightValue.Kind in revkAllStrings then
1679       begin
1680       RightInt:=StringToOrd(RightValue,Expr.right);
1681       if LeftInt>RightInt then
1682         RaiseMsg(20170523151508,nHighRangeLimitLTLowRangeLimit,
1683           sHighRangeLimitLTLowRangeLimit,[],Expr.Right);
1684       Result:=TResEvalRangeInt.CreateValue(revskChar,nil,LeftInt,RightInt);
1685       exit;
1686       end
1687     else
1688       RaiseRangeCheck(20170522123106,Expr.Right);
1689     end
1690   else
1691     {$IFDEF VerbosePasResolver}
1692     writeln('TResExprEvaluator.EvalBinaryRangeExpr Left=',GetObjName(Expr.Left),' LeftValue.Kind=',LeftValue.Kind);
1693     RaiseNotYetImplemented(20170518221103,Expr.Left);
1694     {$ENDIF}
1695   end;
1696 end;
1697 
EvalBinaryAddExprnull1698 function TResExprEvaluator.EvalBinaryAddExpr(Expr: TBinaryExpr; LeftValue,
1699   RightValue: TResEvalValue): TResEvalValue;
1700 
1701   procedure IntAddUInt(const i: TMaxPrecInt; const u: TMaxPrecUInt);
1702   var
1703     Int: TMaxPrecInt;
1704     UInt: TMaxPrecUInt;
1705   begin
1706     if (i>=0) then
1707       begin
1708       UInt:=TMaxPrecUInt(i)+u;
1709       Result:=CreateResEvalInt(UInt);
1710       end
1711     else if u<=HighIntAsUInt then
1712       begin
1713       Int:=i + TMaxPrecInt(u);
1714       Result:=TResEvalInt.CreateValue(Int);
1715       end
1716     else
1717       RaiseRangeCheck(20170601140523,Expr);
1718   end;
1719 
1720 var
1721   Int: TMaxPrecInt;
1722   UInt: TMaxPrecUInt;
1723   Flo: TMaxPrecFloat;
1724   aCurrency: TMaxPrecCurrency;
1725   LeftSet, RightSet: TResEvalSet;
1726   i: Integer;
1727 begin
1728   Result:=nil;
1729   try
1730     {$Q+} // enable overflow and range checks
1731     {$R+}
1732     case LeftValue.Kind of
1733     revkInt:
1734       begin
1735       Int:=TResEvalInt(LeftValue).Int;
1736       case RightValue.Kind of
1737       revkInt: // int + int
1738         if (Int>0) and (TResEvalInt(RightValue).Int>0) then
1739           begin
1740           UInt:=TMaxPrecUInt(Int)+TMaxPrecUInt(TResEvalInt(RightValue).Int);
1741           Result:=CreateResEvalInt(UInt);
1742           end
1743         else
1744           begin
1745           Int:=Int + TResEvalInt(RightValue).Int;
1746           Result:=TResEvalInt.CreateValue(Int);
1747           end;
1748       revkUInt: // int + uint
1749         IntAddUInt(Int,TResEvalUInt(RightValue).UInt);
1750       revkFloat: // int + float
1751         Result:=TResEvalFloat.CreateValue(Int + TResEvalFloat(RightValue).FloatValue);
1752       revkCurrency: // int + currency
1753         Result:=TResEvalCurrency.CreateValue(Int + TResEvalCurrency(RightValue).Value);
1754       else
1755         {$IFDEF VerbosePasResolver}
1756         writeln('TResExprEvaluator.EvalBinaryAddExpr int+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1757         {$ENDIF}
1758         RaiseNotYetImplemented(20170525115537,Expr);
1759       end;
1760       end;
1761     revkUInt:
1762       begin
1763       UInt:=TResEvalUInt(LeftValue).UInt;
1764       case RightValue.Kind of
1765       revkInt: // uint + int
1766         IntAddUInt(UInt,TResEvalInt(RightValue).Int);
1767       revkUInt: // uint + uint
1768         begin
1769         UInt:=UInt+TResEvalUInt(RightValue).UInt;
1770         Result:=TResEvalUInt.CreateValue(UInt);
1771         end;
1772       revkFloat: // uint + float
1773         Result:=TResEvalFloat.CreateValue(UInt + TResEvalFloat(RightValue).FloatValue);
1774       revkCurrency: // uint + currency
1775         Result:=TResEvalCurrency.CreateValue(UInt + TResEvalCurrency(RightValue).Value);
1776       else
1777         {$IFDEF VerbosePasResolver}
1778         writeln('TResExprEvaluator.EvalBinaryAddExpr uint+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1779         {$ENDIF}
1780         RaiseNotYetImplemented(20170601141031,Expr);
1781       end;
1782       end;
1783     revkFloat:
1784       begin
1785       Flo:=TResEvalFloat(LeftValue).FloatValue;
1786       case RightValue.Kind of
1787       revkInt: // float + int
1788         Result:=TResEvalFloat.CreateValue(Flo + TResEvalInt(RightValue).Int);
1789       revkUInt: // float + uint
1790         Result:=TResEvalFloat.CreateValue(Flo + TResEvalUInt(RightValue).UInt);
1791       revkFloat: // float + float
1792         Result:=TResEvalFloat.CreateValue(Flo + TResEvalFloat(RightValue).FloatValue);
1793       revkCurrency: // float + Currency
1794         Result:=TResEvalCurrency.CreateValue(Flo + TResEvalCurrency(RightValue).Value);
1795       else
1796         {$IFDEF VerbosePasResolver}
1797         writeln('TResExprEvaluator.EvalBinaryAddExpr float+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1798         {$ENDIF}
1799         RaiseNotYetImplemented(20170711145637,Expr);
1800       end;
1801       end;
1802     revkCurrency:
1803       begin
1804       aCurrency:=TResEvalCurrency(LeftValue).Value;
1805       case RightValue.Kind of
1806       revkInt: // currency + int
1807         Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalInt(RightValue).Int);
1808       revkUInt: // currency + uint
1809         Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalUInt(RightValue).UInt);
1810       revkFloat: // currency + float
1811         Result:=TResEvalFloat.CreateValue(aCurrency + TResEvalFloat(RightValue).FloatValue);
1812       revkCurrency: // currency + currency
1813         Result:=TResEvalCurrency.CreateValue(aCurrency + TResEvalCurrency(RightValue).Value);
1814       else
1815         {$IFDEF VerbosePasResolver}
1816         writeln('TResExprEvaluator.EvalBinaryAddExpr currency+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1817         {$ENDIF}
1818         RaiseNotYetImplemented(20180421163819,Expr);
1819       end;
1820       end;
1821     {$ifdef FPC_HAS_CPSTRING}
1822     revkString,
1823     {$endif}
1824     revkUnicodeString:
1825       Result:=EvalStringAddExpr(Expr,Expr.left,Expr.right,LeftValue,RightValue);
1826     revkSetOfInt:
1827       case RightValue.Kind of
1828       revkSetOfInt:
1829         begin
1830         // union
1831         LeftSet:=TResEvalSet(LeftValue);
1832         RightSet:=TResEvalSet(RightValue);
1833         if LeftSet.ElKind=revskNone then
1834           Result:=RightSet.Clone
1835         else if RightSet.ElKind=revskNone then
1836           Result:=LeftSet.Clone
1837         else
1838           begin
1839           Result:=RightSet.Clone;
1840           // add elements of left
1841           for i:=0 to length(LeftSet.Ranges)-1 do
1842             begin
1843             Int:=LeftSet.Ranges[i].RangeStart;
1844             while Int<=LeftSet.Ranges[i].RangeEnd do
1845               begin
1846               TResEvalSet(Result).Add(Int,Int);
1847               inc(Int);
1848               end;
1849             end;
1850           end;
1851         end;
1852       else
1853         {$IFDEF VerbosePasResolver}
1854         writeln('TResExprEvaluator.EvalBinaryMulExpr add set+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1855         {$ENDIF}
1856         RaiseNotYetImplemented(20170714114055,Expr);
1857       end
1858     else
1859       {$IFDEF VerbosePasResolver}
1860       writeln('TResExprEvaluator.EvalBinaryAddExpr ?+ Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1861       {$ENDIF}
1862       RaiseNotYetImplemented(20170525115548,Expr);
1863     end;
1864   except
1865     on EOverflow do
1866       RaiseOverflowArithmetic(20170601140130,Expr);
1867     on ERangeError do
1868       RaiseRangeCheck(20170601140132,Expr);
1869   end;
1870 end;
1871 
EvalBinarySubExprnull1872 function TResExprEvaluator.EvalBinarySubExpr(Expr: TBinaryExpr; LeftValue,
1873   RightValue: TResEvalValue): TResEvalValue;
1874 var
1875   Int: TMaxPrecInt;
1876   UInt: TMaxPrecUInt;
1877   Flo: TMaxPrecFloat;
1878   aCurrency: TMaxPrecCurrency;
1879   LeftSet, RightSet: TResEvalSet;
1880   i: Integer;
1881 begin
1882   Result:=nil;
1883   case LeftValue.Kind of
1884   revkInt:
1885     begin
1886     Int:=TResEvalInt(LeftValue).Int;
1887     case RightValue.Kind of
1888     revkInt:
1889       // int - int
1890       try
1891         {$Q+}
1892         Int:=Int - TResEvalInt(RightValue).Int;
1893         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1894         Result:=TResEvalInt.CreateValue(Int);
1895       except
1896         on E: EOverflow do
1897           if (Int>0) and (TResEvalInt(RightValue).Int<0) then
1898             begin
1899             UInt:=TMaxPrecUInt(Int)+TMaxPrecUInt(-TResEvalInt(RightValue).Int);
1900             Result:=CreateResEvalInt(UInt);
1901             end
1902           else
1903             RaiseOverflowArithmetic(20170525230247,Expr);
1904       end;
1905     revkUInt:
1906       // int - uint
1907       try
1908         {$Q+}
1909         Int:=Int - TResEvalUInt(RightValue).UInt;
1910         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1911         Result:=TResEvalInt.CreateValue(Int);
1912       except
1913         on E: EOverflow do
1914           RaiseOverflowArithmetic(20170711151201,Expr);
1915       end;
1916     revkFloat:
1917       // int - float
1918       try
1919         {$Q+}
1920         Flo:=TMaxPrecFloat(Int) - TResEvalFloat(RightValue).FloatValue;
1921         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1922         Result:=TResEvalFloat.CreateValue(Flo);
1923       except
1924         on E: EOverflow do
1925           RaiseOverflowArithmetic(20170711151313,Expr);
1926       end;
1927     revkCurrency:
1928       // int - currency
1929       try
1930         {$Q+}
1931         aCurrency:=TMaxPrecCurrency(Int) - TResEvalCurrency(RightValue).Value;
1932         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1933         Result:=TResEvalCurrency.CreateValue(aCurrency);
1934       except
1935         on E: EOverflow do
1936           RaiseOverflowArithmetic(20180421164011,Expr);
1937       end;
1938     else
1939       {$IFDEF VerbosePasResolver}
1940       writeln('TResExprEvaluator.EvalBinarySubExpr sub int-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1941       {$ENDIF}
1942       RaiseNotYetImplemented(20170525230028,Expr);
1943     end;
1944     end;
1945   revkUInt:
1946     begin
1947     UInt:=TResEvalUInt(LeftValue).UInt;
1948     case RightValue.Kind of
1949     revkInt:
1950       // uint - int
1951       try
1952         {$Q+}
1953         UInt:=UInt - TResEvalInt(RightValue).Int;
1954         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1955         Result:=TResEvalUInt.CreateValue(UInt);
1956       except
1957         on E: EOverflow do
1958           RaiseOverflowArithmetic(20170711151405,Expr);
1959       end;
1960     revkUInt:
1961       // uint - uint
1962       try
1963         {$Q+}
1964         UInt:=UInt - TResEvalUInt(RightValue).UInt;
1965         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1966         Result:=TResEvalUInt.CreateValue(UInt);
1967       except
1968         on E: EOverflow do
1969           RaiseOverflowArithmetic(20170711151419,Expr);
1970       end;
1971     revkFloat:
1972       // uint - float
1973       try
1974         {$Q+}
1975         Flo:=TMaxPrecFloat(UInt) - TResEvalFloat(RightValue).FloatValue;
1976         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1977         Result:=TResEvalFloat.CreateValue(Flo);
1978       except
1979         on E: EOverflow do
1980           RaiseOverflowArithmetic(20170711151428,Expr);
1981       end;
1982     revkCurrency:
1983       // uint - currency
1984       try
1985         {$Q+}
1986         aCurrency:=TMaxPrecCurrency(UInt) - TResEvalCurrency(RightValue).Value;
1987         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
1988         Result:=TResEvalCurrency.CreateValue(aCurrency);
1989       except
1990         on E: EOverflow do
1991           RaiseOverflowArithmetic(20180421164005,Expr);
1992       end;
1993     else
1994       {$IFDEF VerbosePasResolver}
1995       writeln('TResExprEvaluator.EvalBinarySubExpr sub uint-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
1996       {$ENDIF}
1997       RaiseNotYetImplemented(20170711151435,Expr);
1998     end;
1999     end;
2000   revkFloat:
2001     begin
2002     Flo:=TResEvalFloat(LeftValue).FloatValue;
2003     case RightValue.Kind of
2004     revkInt:
2005       // float - int
2006       try
2007         {$Q+}
2008         Flo:=Flo - TResEvalInt(RightValue).Int;
2009         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2010         Result:=TResEvalFloat.CreateValue(Flo);
2011       except
2012         on E: EOverflow do
2013           RaiseOverflowArithmetic(20170711151519,Expr);
2014       end;
2015     revkUInt:
2016       // float - uint
2017       try
2018         {$Q+}
2019         Flo:=Flo - TResEvalUInt(RightValue).UInt;
2020         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2021         Result:=TResEvalFloat.CreateValue(Flo);
2022       except
2023         on E: EOverflow do
2024           RaiseOverflowArithmetic(20170711151538,Expr);
2025       end;
2026     revkFloat:
2027       // float - float
2028       try
2029         {$Q+}
2030         Flo:=Flo - TResEvalFloat(RightValue).FloatValue;
2031         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2032         Result:=TResEvalFloat.CreateValue(Flo);
2033       except
2034         on E: EOverflow do
2035           RaiseOverflowArithmetic(20170711151552,Expr);
2036       end;
2037     revkCurrency:
2038       // float - currency
2039       try
2040         {$Q+}
2041         aCurrency:=Flo - TResEvalCurrency(RightValue).Value;
2042         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2043         Result:=TResEvalCurrency.CreateValue(aCurrency);
2044       except
2045         on E: EOverflow do
2046           RaiseOverflowArithmetic(20180421164054,Expr);
2047       end;
2048     else
2049       {$IFDEF VerbosePasResolver}
2050       writeln('TResExprEvaluator.EvalBinarySubExpr sub float-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2051       {$ENDIF}
2052       RaiseNotYetImplemented(20170711151600,Expr);
2053     end;
2054     end;
2055   revkCurrency:
2056     begin
2057     aCurrency:=TResEvalCurrency(LeftValue).Value;
2058     case RightValue.Kind of
2059     revkInt:
2060       // currency - int
2061       try
2062         {$Q+}
2063         aCurrency:=aCurrency - TResEvalInt(RightValue).Int;
2064         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2065         Result:=TResEvalCurrency.CreateValue(aCurrency);
2066       except
2067         on E: EOverflow do
2068           RaiseOverflowArithmetic(20180421164200,Expr);
2069       end;
2070     revkUInt:
2071       // currency - uint
2072       try
2073         {$Q+}
2074         aCurrency:=aCurrency - TResEvalUInt(RightValue).UInt;
2075         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2076         Result:=TResEvalCurrency.CreateValue(aCurrency);
2077       except
2078         on E: EOverflow do
2079           RaiseOverflowArithmetic(20180421164218,Expr);
2080       end;
2081     revkFloat:
2082       // currency - float
2083       try
2084         {$Q+}
2085         aCurrency:=aCurrency - TResEvalFloat(RightValue).FloatValue;
2086         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2087         Result:=TResEvalCurrency.CreateValue(aCurrency);
2088       except
2089         on E: EOverflow do
2090           RaiseOverflowArithmetic(20180421164250,Expr);
2091       end;
2092     revkCurrency:
2093       // currency - currency
2094       try
2095         {$Q+}
2096         aCurrency:=aCurrency - TResEvalCurrency(RightValue).Value;
2097         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2098         Result:=TResEvalCurrency.CreateValue(aCurrency);
2099       except
2100         on E: EOverflow do
2101           RaiseOverflowArithmetic(20180421164258,Expr);
2102       end;
2103     else
2104       {$IFDEF VerbosePasResolver}
2105       writeln('TResExprEvaluator.EvalBinarySubExpr sub currency-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2106       {$ENDIF}
2107       RaiseNotYetImplemented(20180421164312,Expr);
2108     end;
2109     end;
2110   revkSetOfInt:
2111     case RightValue.Kind of
2112     revkSetOfInt:
2113       begin
2114       // difference
2115       LeftSet:=TResEvalSet(LeftValue);
2116       RightSet:=TResEvalSet(RightValue);
2117       if LeftSet.ElKind=revskNone then
2118         Result:=TResEvalSet.CreateEmptySameKind(RightSet)
2119       else
2120         begin
2121         Result:=TResEvalSet.CreateEmptySameKind(LeftSet);
2122         // add elements, which exists only in LeftSet
2123         for i:=0 to length(LeftSet.Ranges)-1 do
2124           begin
2125           Int:=LeftSet.Ranges[i].RangeStart;
2126           while Int<=LeftSet.Ranges[i].RangeEnd do
2127             begin
2128             if RightSet.IndexOfRange(Int)<0 then
2129               TResEvalSet(Result).Add(Int,Int);
2130             inc(Int);
2131             end;
2132           end;
2133         end;
2134       end;
2135     else
2136       {$IFDEF VerbosePasResolver}
2137       writeln('TResExprEvaluator.EvalBinarySubExpr sub set-? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2138       {$ENDIF}
2139       RaiseNotYetImplemented(20170714114101,Expr);
2140     end;
2141   else
2142     {$IFDEF VerbosePasResolver}
2143     writeln('TResExprEvaluator.EvalBinarySubExpr sub ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2144     {$ENDIF}
2145     RaiseNotYetImplemented(20170525225946,Expr);
2146   end;
2147 end;
2148 
EvalBinaryMulExprnull2149 function TResExprEvaluator.EvalBinaryMulExpr(Expr: TBinaryExpr; LeftValue,
2150   RightValue: TResEvalValue): TResEvalValue;
2151 var
2152   Int: TMaxPrecInt;
2153   UInt: TMaxPrecUInt;
2154   Flo: TMaxPrecFloat;
2155   aCurrency: TMaxPrecCurrency;
2156   LeftSet, RightSet: TResEvalSet;
2157   i: Integer;
2158 begin
2159   Result:=nil;
2160   case LeftValue.Kind of
2161   revkInt:
2162     begin
2163     Int:=TResEvalInt(LeftValue).Int;
2164     case RightValue.Kind of
2165     revkInt:
2166       // int * int
2167       try
2168         {$Q+}
2169         Int:=Int * TResEvalInt(RightValue).Int;
2170         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2171         Result:=TResEvalInt.CreateValue(Int);
2172       except
2173         on E: EOverflow do
2174           if (Int>0) and (TResEvalInt(RightValue).Int>0) then
2175             try
2176               // try uint*uint
2177               {$Q+}
2178               UInt:=TMaxPrecUInt(Int) * TMaxPrecUInt(TResEvalInt(RightValue).Int);
2179               {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2180               Result:=CreateResEvalInt(UInt);
2181             except
2182               on E: EOverflow do
2183                 RaiseOverflowArithmetic(20170530101616,Expr);
2184             end
2185           else
2186             RaiseOverflowArithmetic(20170525230247,Expr);
2187       end;
2188     revkUInt:
2189       // int * uint
2190       try
2191         {$Q+}
2192         Int:=Int * TResEvalUInt(RightValue).UInt;
2193         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2194         Result:=TResEvalInt.CreateValue(Int);
2195       except
2196         RaiseOverflowArithmetic(20170711164445,Expr);
2197       end;
2198     revkFloat:
2199       // int * float
2200       try
2201         {$Q+}
2202         Flo:=Int * TResEvalFloat(RightValue).FloatValue;
2203         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2204         Result:=TResEvalFloat.CreateValue(Flo);
2205       except
2206         RaiseOverflowArithmetic(20170711164541,Expr);
2207       end;
2208     revkCurrency:
2209       // int * currency
2210       try
2211         {$Q+}
2212         aCurrency:=Int * TResEvalCurrency(RightValue).Value;
2213         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2214         Result:=TResEvalCurrency.CreateValue(aCurrency);
2215       except
2216         RaiseOverflowArithmetic(20180421164426,Expr);
2217       end;
2218     else
2219       {$IFDEF VerbosePasResolver}
2220       writeln('TResExprEvaluator.EvalBinaryMulExpr mul int*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2221       {$ENDIF}
2222       RaiseNotYetImplemented(20170525230028,Expr);
2223     end;
2224     end;
2225   revkUInt:
2226     begin
2227     UInt:=TResEvalUInt(LeftValue).UInt;
2228     case RightValue.Kind of
2229     revkInt:
2230       // uint * int
2231       if TResEvalInt(RightValue).Int>=0 then
2232         try
2233           {$Q+}
2234           UInt:=UInt * TResEvalInt(RightValue).Int;
2235           {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2236           Result:=TResEvalUInt.CreateValue(UInt);
2237         except
2238           on E: EOverflow do
2239             RaiseOverflowArithmetic(20170711164714,Expr);
2240         end
2241       else
2242         try
2243           {$Q+}
2244           Int:=UInt * TResEvalInt(RightValue).Int;
2245           {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2246           Result:=TResEvalInt.CreateValue(Int);
2247         except
2248           on E: EOverflow do
2249             RaiseOverflowArithmetic(20170711164736,Expr);
2250         end;
2251     revkUInt:
2252       // uint * uint
2253       try
2254         {$Q+}
2255         UInt:=UInt * TResEvalUInt(RightValue).UInt;
2256         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2257         Result:=TResEvalUInt.CreateValue(UInt);
2258       except
2259         RaiseOverflowArithmetic(20170711164751,Expr);
2260       end;
2261     revkFloat:
2262       // uint * float
2263       try
2264         {$Q+}
2265         Flo:=UInt * TResEvalFloat(RightValue).FloatValue;
2266         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2267         Result:=TResEvalFloat.CreateValue(Flo);
2268       except
2269         RaiseOverflowArithmetic(20170711164800,Expr);
2270       end;
2271     revkCurrency:
2272       // uint * currency
2273       try
2274         {$Q+}
2275         aCurrency:=UInt * TResEvalCurrency(RightValue).Value;
2276         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2277         Result:=TResEvalCurrency.CreateValue(aCurrency);
2278       except
2279         RaiseOverflowArithmetic(20180421164500,Expr);
2280       end;
2281     else
2282       {$IFDEF VerbosePasResolver}
2283       writeln('TResExprEvaluator.EvalBinaryMulExpr mul uint*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2284       {$ENDIF}
2285       RaiseNotYetImplemented(20170711164810,Expr);
2286     end;
2287     end;
2288   revkFloat:
2289     begin
2290     Flo:=TResEvalFloat(LeftValue).FloatValue;
2291     case RightValue.Kind of
2292     revkInt:
2293       // float * int
2294       try
2295         {$Q+}
2296         Flo:=Flo * TResEvalInt(RightValue).Int;
2297         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2298         Result:=TResEvalFloat.CreateValue(Flo);
2299       except
2300         on E: EOverflow do
2301           RaiseOverflowArithmetic(20170711164920,Expr);
2302       end;
2303     revkUInt:
2304       // float * uint
2305       try
2306         {$Q+}
2307         Flo:=Flo * TResEvalUInt(RightValue).UInt;
2308         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2309         Result:=TResEvalFloat.CreateValue(Flo);
2310       except
2311         RaiseOverflowArithmetic(20170711164940,Expr);
2312       end;
2313     revkFloat:
2314       // float * float
2315       try
2316         {$Q+}
2317         Flo:=Flo * TResEvalFloat(RightValue).FloatValue;
2318         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2319         Result:=TResEvalFloat.CreateValue(Flo);
2320       except
2321         RaiseOverflowArithmetic(20170711164955,Expr);
2322       end;
2323     revkCurrency:
2324       // float * currency
2325       try
2326         {$Q+}
2327         Flo:=Flo * TResEvalCurrency(RightValue).Value;
2328         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2329         Result:=TResEvalFloat.CreateValue(Flo);
2330       except
2331         RaiseOverflowArithmetic(20180421164542,Expr);
2332       end;
2333     else
2334       {$IFDEF VerbosePasResolver}
2335       writeln('TResExprEvaluator.EvalBinaryMulExpr mul float*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2336       {$ENDIF}
2337       RaiseNotYetImplemented(20170711165004,Expr);
2338     end;
2339     end;
2340   revkCurrency:
2341     begin
2342     aCurrency:=TResEvalCurrency(LeftValue).Value;
2343     case RightValue.Kind of
2344     revkInt:
2345       // currency * int
2346       try
2347         {$Q+}
2348         aCurrency:=aCurrency * TResEvalInt(RightValue).Int;
2349         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2350         Result:=TResEvalCurrency.CreateValue(aCurrency);
2351       except
2352         on E: EOverflow do
2353           RaiseOverflowArithmetic(20180421164636,Expr);
2354       end;
2355     revkUInt:
2356       // currency * uint
2357       try
2358         {$Q+}
2359         aCurrency:=aCurrency * TResEvalUInt(RightValue).UInt;
2360         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2361         Result:=TResEvalCurrency.CreateValue(aCurrency);
2362       except
2363         RaiseOverflowArithmetic(20180421164654,Expr);
2364       end;
2365     revkFloat:
2366       // currency * float
2367       try
2368         {$Q+}
2369         Flo:=aCurrency * TResEvalFloat(RightValue).FloatValue;
2370         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2371         Result:=TResEvalFloat.CreateValue(Flo);
2372       except
2373         RaiseOverflowArithmetic(20180421164718,Expr);
2374       end;
2375     revkCurrency:
2376       // currency * currency
2377       try
2378         {$Q+}
2379         aCurrency:=aCurrency * TResEvalCurrency(RightValue).Value;
2380         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
2381         Result:=TResEvalCurrency.CreateValue(aCurrency);
2382       except
2383         RaiseOverflowArithmetic(20180421164806,Expr);
2384       end;
2385     else
2386       {$IFDEF VerbosePasResolver}
2387       writeln('TResExprEvaluator.EvalBinaryMulExpr mul currency*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2388       {$ENDIF}
2389       RaiseNotYetImplemented(20180421164817,Expr);
2390     end;
2391     end;
2392   revkSetOfInt:
2393     case RightValue.Kind of
2394     revkSetOfInt:
2395       begin
2396       // intersect
2397       LeftSet:=TResEvalSet(LeftValue);
2398       RightSet:=TResEvalSet(RightValue);
2399       if LeftSet.ElKind=revskNone then
2400         Result:=TResEvalSet.CreateEmptySameKind(RightSet)
2401       else
2402         begin
2403         Result:=TResEvalSet.CreateEmptySameKind(LeftSet);
2404         // add elements, which exists in both
2405         for i:=0 to length(LeftSet.Ranges)-1 do
2406           begin
2407           Int:=LeftSet.Ranges[i].RangeStart;
2408           while Int<=LeftSet.Ranges[i].RangeEnd do
2409             begin
2410             if RightSet.IndexOfRange(Int)>=0 then
2411               TResEvalSet(Result).Add(Int,Int);
2412             inc(Int);
2413             end;
2414           end;
2415         end;
2416       end;
2417     else
2418       {$IFDEF VerbosePasResolver}
2419       writeln('TResExprEvaluator.EvalBinaryMulExpr mul set*? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2420       {$ENDIF}
2421       RaiseNotYetImplemented(20170714110420,Expr);
2422     end
2423   else
2424     {$IFDEF VerbosePasResolver}
2425     writeln('TResExprEvaluator.EvalBinaryMulExpr mul ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2426     {$ENDIF}
2427     RaiseNotYetImplemented(20170525225946,Expr);
2428   end;
2429 end;
2430 
EvalBinaryDivideExprnull2431 function TResExprEvaluator.EvalBinaryDivideExpr(Expr: TBinaryExpr; LeftValue,
2432   RightValue: TResEvalValue): TResEvalValue;
2433 var
2434   Int: TMaxPrecInt;
2435   UInt: TMaxPrecUInt;
2436   Flo: TMaxPrecFloat;
2437   aCurrency: TMaxPrecCurrency;
2438 begin
2439   Result:=nil;
2440   case LeftValue.Kind of
2441   revkInt:
2442     begin
2443     Int:=TResEvalInt(LeftValue).Int;
2444     case RightValue.Kind of
2445     revkInt:
2446       // int / int
2447       if TResEvalInt(RightValue).Int=0 then
2448         RaiseDivByZero(20170711143925,Expr)
2449       else
2450         Result:=TResEvalFloat.CreateValue(Int / TResEvalInt(RightValue).Int);
2451     revkUInt:
2452       // int / uint
2453       if TResEvalUInt(RightValue).UInt=0 then
2454         RaiseDivByZero(20170711144013,Expr)
2455       else
2456         Result:=TResEvalFloat.CreateValue(Int / TResEvalUInt(RightValue).UInt);
2457     revkFloat:
2458       begin
2459       // int / float
2460       try
2461         Flo:=Int / TResEvalFloat(RightValue).FloatValue;
2462       except
2463         RaiseMsg(20170711144525,nDivByZero,sDivByZero,[],Expr);
2464       end;
2465       Result:=TResEvalFloat.CreateValue(Flo);
2466       end;
2467     revkCurrency:
2468       begin
2469       // int / currency
2470       try
2471         aCurrency:=Int / TResEvalCurrency(RightValue).Value;
2472       except
2473         RaiseMsg(20180421164915,nDivByZero,sDivByZero,[],Expr);
2474       end;
2475       Result:=TResEvalCurrency.CreateValue(aCurrency);
2476       end;
2477     else
2478       {$IFDEF VerbosePasResolver}
2479       writeln('TResExprEvaluator.EvalBinaryDivideExpr int / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2480       {$ENDIF}
2481       RaiseNotYetImplemented(20170711144057,Expr);
2482     end;
2483     end;
2484   revkUInt:
2485     begin
2486     UInt:=TResEvalUInt(LeftValue).UInt;
2487     case RightValue.Kind of
2488     revkInt:
2489       // uint / int
2490       if TResEvalInt(RightValue).Int=0 then
2491         RaiseDivByZero(20170711144103,Expr)
2492       else
2493         Result:=TResEvalFloat.CreateValue(UInt / TResEvalInt(RightValue).Int);
2494     revkUInt:
2495       // uint / uint
2496       if TResEvalUInt(RightValue).UInt=0 then
2497         RaiseDivByZero(20170711144203,Expr)
2498       else
2499         Result:=TResEvalFloat.CreateValue(UInt / TResEvalUInt(RightValue).UInt);
2500     revkFloat:
2501       begin
2502       // uint / float
2503       try
2504         Flo:=UInt / TResEvalFloat(RightValue).FloatValue;
2505       except
2506         RaiseMsg(20170711144912,nDivByZero,sDivByZero,[],Expr);
2507       end;
2508       Result:=TResEvalFloat.CreateValue(Flo);
2509       end;
2510     revkCurrency:
2511       begin
2512       // uint / currency
2513       try
2514         aCurrency:=UInt / TResEvalCurrency(RightValue).Value;
2515       except
2516         RaiseMsg(20180421164959,nDivByZero,sDivByZero,[],Expr);
2517       end;
2518       Result:=TResEvalCurrency.CreateValue(aCurrency);
2519       end;
2520     else
2521       {$IFDEF VerbosePasResolver}
2522       writeln('TResExprEvaluator.EvalBinaryDivideExpr uint / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2523       {$ENDIF}
2524       RaiseNotYetImplemented(20170711144239,Expr);
2525     end;
2526     end;
2527   revkFloat:
2528     begin
2529     Flo:=TResEvalFloat(LeftValue).FloatValue;
2530     case RightValue.Kind of
2531     revkInt:
2532       // float / int
2533       if TResEvalInt(RightValue).Int=0 then
2534         RaiseDivByZero(20170711144954,Expr)
2535       else
2536         Result:=TResEvalFloat.CreateValue(Flo / TResEvalInt(RightValue).Int);
2537     revkUInt:
2538       // float / uint
2539       if TResEvalUInt(RightValue).UInt=0 then
2540         RaiseDivByZero(20170711145023,Expr)
2541       else
2542         Result:=TResEvalFloat.CreateValue(Flo / TResEvalUInt(RightValue).UInt);
2543     revkFloat:
2544       begin
2545       // float / float
2546       try
2547         Flo:=Flo / TResEvalFloat(RightValue).FloatValue;
2548       except
2549         RaiseMsg(20170711145040,nDivByZero,sDivByZero,[],Expr);
2550       end;
2551       Result:=TResEvalFloat.CreateValue(Flo);
2552       end;
2553     revkCurrency:
2554       begin
2555       // float / currency
2556       try
2557         aCurrency:=Flo / TResEvalCurrency(RightValue).Value;
2558       except
2559         RaiseMsg(20180421165058,nDivByZero,sDivByZero,[],Expr);
2560       end;
2561       Result:=TResEvalCurrency.CreateValue(aCurrency);
2562       end;
2563     else
2564       {$IFDEF VerbosePasResolver}
2565       writeln('TResExprEvaluator.EvalBinaryDivideExpr float / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2566       {$ENDIF}
2567       RaiseNotYetImplemented(20170711145050,Expr);
2568     end;
2569     end;
2570   revkCurrency:
2571     begin
2572     aCurrency:=TResEvalCurrency(LeftValue).Value;
2573     case RightValue.Kind of
2574     revkInt:
2575       // currency / int
2576       if TResEvalInt(RightValue).Int=0 then
2577         RaiseDivByZero(20180421165154,Expr)
2578       else
2579         Result:=TResEvalCurrency.CreateValue(aCurrency / TResEvalInt(RightValue).Int);
2580     revkUInt:
2581       // currency / uint
2582       if TResEvalUInt(RightValue).UInt=0 then
2583         RaiseDivByZero(20180421165205,Expr)
2584       else
2585         Result:=TResEvalCurrency.CreateValue(aCurrency / TResEvalUInt(RightValue).UInt);
2586     revkFloat:
2587       begin
2588       // currency / float
2589       try
2590         aCurrency:=aCurrency / TResEvalFloat(RightValue).FloatValue;
2591       except
2592         RaiseMsg(20180421165237,nDivByZero,sDivByZero,[],Expr);
2593       end;
2594       Result:=TResEvalCurrency.CreateValue(aCurrency);
2595       end;
2596     revkCurrency:
2597       begin
2598       // currency / currency
2599       try
2600         aCurrency:=aCurrency / TResEvalCurrency(RightValue).Value;
2601       except
2602         RaiseMsg(20180421165252,nDivByZero,sDivByZero,[],Expr);
2603       end;
2604       Result:=TResEvalCurrency.CreateValue(aCurrency);
2605       end;
2606     else
2607       {$IFDEF VerbosePasResolver}
2608       writeln('TResExprEvaluator.EvalBinaryDivideExpr currency / ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2609       {$ENDIF}
2610       RaiseNotYetImplemented(20180421165301,Expr);
2611     end;
2612     end;
2613   else
2614     {$IFDEF VerbosePasResolver}
2615     writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2616     {$ENDIF}
2617     RaiseNotYetImplemented(20170530102352,Expr);
2618   end;
2619 end;
2620 
TResExprEvaluator.EvalBinaryDivExprnull2621 function TResExprEvaluator.EvalBinaryDivExpr(Expr: TBinaryExpr; LeftValue,
2622   RightValue: TResEvalValue): TResEvalValue;
2623 var
2624   Int: TMaxPrecInt;
2625   UInt: TMaxPrecUInt;
2626 begin
2627   Result:=nil;
2628   case LeftValue.Kind of
2629   revkInt:
2630     case RightValue.Kind of
2631     revkInt:
2632       // int div int
2633       if TResEvalInt(RightValue).Int=0 then
2634         RaiseDivByZero(20170530102619,Expr)
2635       else
2636         begin
2637         Int:=TResEvalInt(LeftValue).Int div TResEvalInt(RightValue).Int;
2638         Result:=TResEvalInt.CreateValue(Int);
2639         end;
2640     revkUInt:
2641       // int div uint
2642       if TResEvalUInt(RightValue).UInt=0 then
2643         RaiseDivByZero(20170530102745,Expr)
2644       else
2645         begin
2646         if TResEvalUInt(RightValue).UInt>HighIntAsUInt then
2647           Int:=0
2648         else
2649           Int:=TResEvalInt(LeftValue).Int div TResEvalUInt(RightValue).UInt;
2650         Result:=TResEvalInt.CreateValue(Int);
2651         end;
2652     else
2653       {$IFDEF VerbosePasResolver}
2654       writeln('TResExprEvaluator.EvalBinaryDivExpr int div ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2655       {$ENDIF}
2656       RaiseNotYetImplemented(20170530102403,Expr);
2657     end;
2658   revkUInt:
2659     case RightValue.Kind of
2660     revkInt:
2661       // uint div int
2662       if TResEvalInt(RightValue).Int=0 then
2663         RaiseDivByZero(20170530103026,Expr)
2664       else if TResEvalUInt(LeftValue).UInt<=HighIntAsUInt then
2665         begin
2666         Int:=TMaxPrecInt(TResEvalUInt(LeftValue).UInt) div TResEvalInt(RightValue).Int;
2667         Result:=TResEvalInt.CreateValue(Int);
2668         end
2669       else if TResEvalInt(RightValue).Int>0 then
2670         begin
2671         UInt:=TResEvalUInt(LeftValue).UInt div TMaxPrecUInt(TResEvalInt(RightValue).Int);
2672         Result:=CreateResEvalInt(UInt);
2673         end
2674       else
2675         RaiseOverflowArithmetic(20170530104315,Expr);
2676     revkUInt:
2677       // uint div uint
2678       if TResEvalInt(RightValue).Int=0 then
2679         RaiseDivByZero(20170530103026,Expr)
2680       else
2681         begin
2682         UInt:=TResEvalUInt(LeftValue).UInt div TResEvalUInt(RightValue).UInt;
2683         Result:=CreateResEvalInt(UInt);
2684         end;
2685     else
2686       {$IFDEF VerbosePasResolver}
2687       writeln('TResExprEvaluator.EvalBinaryDivExpr uint div ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2688       {$ENDIF}
2689       RaiseNotYetImplemented(20170530102403,Expr);
2690     end;
2691   else
2692     {$IFDEF VerbosePasResolver}
2693     writeln('TResExprEvaluator.EvalBinaryDivExpr div ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2694     {$ENDIF}
2695     RaiseNotYetImplemented(20170530102352,Expr);
2696   end;
2697 end;
2698 
EvalBinaryModExprnull2699 function TResExprEvaluator.EvalBinaryModExpr(Expr: TBinaryExpr; LeftValue,
2700   RightValue: TResEvalValue): TResEvalValue;
2701 var
2702   Int: TMaxPrecInt;
2703   UInt: TMaxPrecUInt;
2704 begin
2705   Result:=nil;
2706   case LeftValue.Kind of
2707   revkInt:
2708     case RightValue.Kind of
2709     revkInt:
2710       // int mod int
2711       if TResEvalInt(RightValue).Int=0 then
2712         RaiseDivByZero(20170530104638,Expr)
2713       else
2714         begin
2715         Int:=TResEvalInt(LeftValue).Int mod TResEvalInt(RightValue).Int;
2716         Result:=TResEvalInt.CreateValue(Int);
2717         end;
2718     revkUInt:
2719       // int mod uint
2720       if TResEvalUInt(RightValue).UInt=0 then
2721         RaiseDivByZero(20170530104758,Expr)
2722       else
2723         begin
2724         if TResEvalInt(LeftValue).Int<0 then
2725           UInt:=TMaxPrecUInt(-TResEvalInt(LeftValue).Int) mod TResEvalUInt(RightValue).UInt
2726         else
2727           UInt:=TMaxPrecUInt(TResEvalInt(LeftValue).Int) mod TResEvalUInt(RightValue).UInt;
2728         Result:=CreateResEvalInt(UInt);
2729         end;
2730     else
2731       {$IFDEF VerbosePasResolver}
2732       writeln('TResExprEvaluator.EvalBinaryModExpr int mod ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2733       {$ENDIF}
2734       RaiseNotYetImplemented(20170530110057,Expr);
2735     end;
2736   revkUInt:
2737     case RightValue.Kind of
2738     revkInt:
2739       // uint mod int
2740       if TResEvalInt(RightValue).Int=0 then
2741         RaiseDivByZero(20170530110110,Expr)
2742       else if TResEvalUInt(LeftValue).UInt<=HighIntAsUInt then
2743         begin
2744         Int:=TMaxPrecInt(TResEvalUInt(LeftValue).UInt) mod TResEvalInt(RightValue).Int;
2745         Result:=TResEvalInt.CreateValue(Int);
2746         end
2747       else if TResEvalInt(RightValue).Int>0 then
2748         begin
2749         UInt:=TResEvalUInt(LeftValue).UInt mod TMaxPrecUInt(TResEvalInt(RightValue).Int);
2750         Result:=CreateResEvalInt(UInt);
2751         end
2752       else
2753         RaiseOverflowArithmetic(20170530110602,Expr);
2754     revkUInt:
2755       // uint div uint
2756       if TResEvalInt(RightValue).Int=0 then
2757         RaiseDivByZero(20170530110609,Expr)
2758       else
2759         begin
2760         UInt:=TResEvalUInt(LeftValue).UInt mod TResEvalUInt(RightValue).UInt;
2761         Result:=CreateResEvalInt(UInt);
2762         end;
2763     else
2764       {$IFDEF VerbosePasResolver}
2765       writeln('TResExprEvaluator.EvalBinaryModExpr uint mod ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2766       {$ENDIF}
2767       RaiseNotYetImplemented(20170530110633,Expr);
2768     end;
2769   else
2770     {$IFDEF VerbosePasResolver}
2771     writeln('TResExprEvaluator.EvalBinaryModExpr mod ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2772     {$ENDIF}
2773     RaiseNotYetImplemented(20170530110644,Expr);
2774   end;
2775 end;
2776 
EvalBinaryShiftExprnull2777 function TResExprEvaluator.EvalBinaryShiftExpr(Expr: TBinaryExpr; LeftValue,
2778   RightValue: TResEvalValue): TResEvalValue;
2779 var
2780   Int: TMaxPrecInt;
2781   UInt: TMaxPrecUInt;
2782   ShiftLeft: Boolean;
2783 begin
2784   Result:=nil;
2785   ShiftLeft:=Expr.OpCode=eopShl;
2786   case LeftValue.Kind of
2787   revkInt:
2788     case RightValue.Kind of
2789     revkInt:
2790       // int shl int
2791       begin
2792       if (TResEvalInt(RightValue).Int<0) or (TResEvalInt(RightValue).Int>63) then
2793         EmitRangeCheckConst(20170530203840,IntToStr(TResEvalInt(RightValue).Int),0,63,Expr);
2794       if ShiftLeft then
2795         Int:=TResEvalInt(LeftValue).Int shl byte(TResEvalInt(RightValue).Int)
2796       else
2797         Int:=TResEvalInt(LeftValue).Int shr byte(TResEvalInt(RightValue).Int);
2798       Result:=TResEvalInt.CreateValue(Int);
2799       end;
2800     revkUInt:
2801       // int shl uint
2802       begin
2803       if (TResEvalUInt(RightValue).UInt>63) then
2804         EmitRangeCheckConst(20170530203840,IntToStr(TResEvalUInt(RightValue).UInt),0,63,Expr);
2805       if ShiftLeft then
2806         Int:=TResEvalInt(LeftValue).Int shl byte(TResEvalUInt(RightValue).UInt)
2807       else
2808         Int:=TResEvalInt(LeftValue).Int shr byte(TResEvalUInt(RightValue).UInt);
2809       Result:=TResEvalInt.CreateValue(Int);
2810       end;
2811     else
2812       {$IFDEF VerbosePasResolver}
2813       writeln('TResExprEvaluator.EvalBinaryModExpr int shl/shr ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2814       {$ENDIF}
2815       RaiseNotYetImplemented(20170530205332,Expr);
2816     end;
2817   revkUInt:
2818     case RightValue.Kind of
2819     revkInt:
2820       // uint shl int
2821       begin
2822       if (TResEvalInt(RightValue).Int<0) or (TResEvalInt(RightValue).Int>63) then
2823         EmitRangeCheckConst(20170530205414,IntToStr(TResEvalInt(RightValue).Int),0,63,Expr);
2824       if ShiftLeft then
2825         UInt:=TResEvalUInt(LeftValue).UInt shl byte(TResEvalInt(RightValue).Int)
2826       else
2827         UInt:=TResEvalUInt(LeftValue).UInt shr byte(TResEvalInt(RightValue).Int);
2828       Result:=CreateResEvalInt(UInt);
2829       end;
2830     revkUInt:
2831       // uint shl uint
2832       begin
2833       if (TResEvalUInt(RightValue).UInt>63) then
2834         EmitRangeCheckConst(20170530205601,IntToStr(TResEvalUInt(RightValue).UInt),0,63,Expr);
2835       if ShiftLeft then
2836         UInt:=TResEvalUInt(LeftValue).UInt shl byte(TResEvalUInt(RightValue).UInt)
2837       else
2838         UInt:=TResEvalUInt(LeftValue).UInt shr byte(TResEvalUInt(RightValue).UInt);
2839       Result:=CreateResEvalInt(UInt);
2840       end;
2841     else
2842       {$IFDEF VerbosePasResolver}
2843       writeln('TResExprEvaluator.EvalBinaryShiftExpr uint shl/shr ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2844       {$ENDIF}
2845       RaiseNotYetImplemented(20170530205640,Expr);
2846     end;
2847   else
2848     {$IFDEF VerbosePasResolver}
2849     writeln('TResExprEvaluator.EvalBinaryShiftExpr shl/shr ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2850     {$ENDIF}
2851     RaiseNotYetImplemented(20170530205646,Expr);
2852   end;
2853 end;
2854 
TResExprEvaluator.EvalBinaryBoolOpExprnull2855 function TResExprEvaluator.EvalBinaryBoolOpExpr(Expr: TBinaryExpr; LeftValue,
2856   RightValue: TResEvalValue): TResEvalValue;
2857 // AND, OR, XOR
2858 begin
2859   Result:=nil;
2860   case LeftValue.Kind of
2861   revkBool:
2862     case RightValue.Kind of
2863     revkBool:
2864       begin
2865       // logical and/or/xor
2866       Result:=TResEvalBool.Create;
2867       case Expr.OpCode of
2868       eopAnd: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B and TResEvalBool(RightValue).B;
2869       eopOr: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B or TResEvalBool(RightValue).B;
2870       eopXor: TResEvalBool(Result).B:=TResEvalBool(LeftValue).B xor TResEvalBool(RightValue).B;
2871       end;
2872       end;
2873     else
2874       {$IFDEF VerbosePasResolver}
2875       writeln('TResExprEvaluator.EvalBinaryBoolOpExpr bool ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2876       {$ENDIF}
2877       RaiseNotYetImplemented(20170531011502,Expr);
2878     end;
2879   revkInt:
2880     case RightValue.Kind of
2881     revkInt:
2882       begin
2883       // bitwise and/or/xor
2884       Result:=TResEvalInt.Create;
2885       case Expr.OpCode of
2886       eopAnd: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int and TResEvalInt(RightValue).Int;
2887       eopOr: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int or TResEvalInt(RightValue).Int;
2888       eopXor: TResEvalInt(Result).Int:=TResEvalInt(LeftValue).Int xor TResEvalInt(RightValue).Int;
2889       end;
2890       end;
2891     else
2892       {$IFDEF VerbosePasResolver}
2893       writeln('TResExprEvaluator.EvalBinaryBoolOpExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2894       {$ENDIF}
2895       RaiseNotYetImplemented(20170530211140,Expr);
2896     end;
2897   revkUInt:
2898     case RightValue.Kind of
2899     revkUInt:
2900       begin
2901       // bitwise and/or/xor
2902       Result:=TResEvalUInt.Create;
2903       case Expr.OpCode of
2904       eopAnd: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt and TResEvalUInt(RightValue).UInt;
2905       eopOr: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt or TResEvalUInt(RightValue).UInt;
2906       eopXor: TResEvalUInt(Result).UInt:=TResEvalUInt(LeftValue).UInt xor TResEvalUInt(RightValue).UInt;
2907       end;
2908       end;
2909     else
2910       {$IFDEF VerbosePasResolver}
2911       writeln('TResExprEvaluator.EvalBinaryBoolOpExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2912       {$ENDIF}
2913       RaiseNotYetImplemented(20170530211140,Expr);
2914     end;
2915   else
2916     {$IFDEF VerbosePasResolver}
2917     writeln('TResExprEvaluator.EvalBinaryBoolOpExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2918     {$ENDIF}
2919     RaiseNotYetImplemented(20170530205938,Expr);
2920   end;
2921 end;
2922 
EvalBinaryNEqualExprnull2923 function TResExprEvaluator.EvalBinaryNEqualExpr(Expr: TBinaryExpr; LeftValue,
2924   RightValue: TResEvalValue): TResEvalValue;
2925 var
2926   UInt: TMaxPrecUInt;
2927   LeftSet, RightSet: TResEvalSet;
2928   i: Integer;
2929 begin
2930   Result:=TResEvalBool.Create;
2931   try
2932     {$Q+}
2933     {$R+}
2934     case LeftValue.Kind of
2935     revkBool:
2936       case RightValue.Kind of
2937       revkBool:
2938         TResEvalBool(Result).B:=TResEvalBool(LeftValue).B=TResEvalBool(RightValue).B;
2939       else
2940         {$IFDEF VerbosePasResolver}
2941         writeln('TResExprEvaluator.EvalBinaryNEqualExpr bool ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2942         {$ENDIF}
2943         Result.Free;
2944         RaiseNotYetImplemented(20170531011937,Expr);
2945       end;
2946     revkInt:
2947       case RightValue.Kind of
2948       revkInt:
2949         TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalInt(RightValue).Int;
2950       revkUInt:
2951         TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalUInt(RightValue).UInt;
2952       revkFloat:
2953         TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalFloat(RightValue).FloatValue;
2954       revkCurrency:
2955         TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int=TResEvalCurrency(RightValue).Value;
2956       else
2957         {$IFDEF VerbosePasResolver}
2958         writeln('TResExprEvaluator.EvalBinaryNEqualExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2959         {$ENDIF}
2960         Result.Free;
2961         RaiseNotYetImplemented(20170531012412,Expr);
2962       end;
2963     revkUInt:
2964       begin
2965       UInt:=TResEvalUInt(LeftValue).UInt;
2966       case RightValue.Kind of
2967       revkInt:
2968         TResEvalBool(Result).B:=(UInt<=HighIntAsUInt)
2969                                and (TMaxPrecInt(UInt)=TResEvalInt(RightValue).Int);
2970       revkUInt:
2971         TResEvalBool(Result).B:=UInt=TResEvalUInt(RightValue).UInt;
2972       revkFloat:
2973         TResEvalBool(Result).B:=UInt=TResEvalFloat(RightValue).FloatValue;
2974       revkCurrency:
2975         TResEvalBool(Result).B:=UInt=TResEvalCurrency(RightValue).Value;
2976       else
2977         {$IFDEF VerbosePasResolver}
2978         writeln('TResExprEvaluator.EvalBinaryNEqualExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2979         {$ENDIF}
2980         Result.Free;
2981         RaiseNotYetImplemented(20170601122803,Expr);
2982       end;
2983       end;
2984     revkFloat:
2985       case RightValue.Kind of
2986       revkInt:
2987         TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalInt(RightValue).Int;
2988       revkUInt:
2989         TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalUInt(RightValue).UInt;
2990       revkFloat:
2991         TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalFloat(RightValue).FloatValue;
2992       revkCurrency:
2993         TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue=TResEvalCurrency(RightValue).Value;
2994       else
2995         {$IFDEF VerbosePasResolver}
2996         writeln('TResExprEvaluator.EvalBinaryNEqualExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
2997         {$ENDIF}
2998         Result.Free;
2999         RaiseNotYetImplemented(20170601122806,Expr);
3000       end;
3001     revkCurrency:
3002       case RightValue.Kind of
3003       revkInt:
3004         TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalInt(RightValue).Int;
3005       revkUInt:
3006         TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalUInt(RightValue).UInt;
3007       revkFloat:
3008         TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalFloat(RightValue).FloatValue;
3009       revkCurrency:
3010         TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value=TResEvalCurrency(RightValue).Value;
3011       else
3012         {$IFDEF VerbosePasResolver}
3013         writeln('TResExprEvaluator.EvalBinaryNEqualExpr currency ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3014         {$ENDIF}
3015         Result.Free;
3016         RaiseNotYetImplemented(20180421165438,Expr);
3017       end;
3018     {$ifdef FPC_HAS_CPSTRING}
3019     revkString:
3020       case RightValue.Kind of
3021       revkString:
3022         if GetCodePage(TResEvalString(LeftValue).S)=GetCodePage(TResEvalString(RightValue).S) then
3023           TResEvalBool(Result).B:=TResEvalString(LeftValue).S=TResEvalString(RightValue).S
3024         else
3025           TResEvalBool(Result).B:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
3026                                  =GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
3027       revkUnicodeString:
3028         TResEvalBool(Result).B:=GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left)
3029                                =TResEvalUTF16(RightValue).S;
3030       else
3031         {$IFDEF VerbosePasResolver}
3032         writeln('TResExprEvaluator.EvalBinaryNEqualExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3033         {$ENDIF}
3034         Result.Free;
3035         RaiseNotYetImplemented(20170711175409,Expr);
3036       end;
3037     {$endif}
3038     revkUnicodeString:
3039       case RightValue.Kind of
3040       {$ifdef FPC_HAS_CPSTRING}
3041       revkString:
3042         TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S
3043                                =GetUnicodeStr(TResEvalString(RightValue).S,Expr.right);
3044       {$endif}
3045       revkUnicodeString:
3046         TResEvalBool(Result).B:=TResEvalUTF16(LeftValue).S
3047                                =TResEvalUTF16(RightValue).S;
3048       else
3049         {$IFDEF VerbosePasResolver}
3050         writeln('TResExprEvaluator.EvalBinaryNEqualExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3051         {$ENDIF}
3052         Result.Free;
3053         RaiseNotYetImplemented(20170711175409,Expr);
3054       end;
3055     revkSetOfInt:
3056       case RightValue.Kind of
3057       revkSetOfInt:
3058         begin
3059         LeftSet:=TResEvalSet(LeftValue);
3060         RightSet:=TResEvalSet(RightValue);
3061         if LeftSet.ElKind=revskNone then
3062           TResEvalBool(Result).B:=length(RightSet.Ranges)=0
3063         else if RightSet.ElKind=revskNone then
3064           TResEvalBool(Result).B:=length(LeftSet.Ranges)=0
3065         else if length(LeftSet.Ranges)<>length(RightSet.Ranges) then
3066           TResEvalBool(Result).B:=false
3067         else
3068           begin
3069           TResEvalBool(Result).B:=true;
3070           for i:=0 to length(LeftSet.Ranges)-1 do
3071             if (LeftSet.Ranges[i].RangeStart<>RightSet.Ranges[i].RangeStart)
3072                 or (LeftSet.Ranges[i].RangeEnd<>RightSet.Ranges[i].RangeEnd) then
3073               begin
3074               TResEvalBool(Result).B:=false;
3075               break;
3076               end;
3077           end;
3078         end;
3079       else
3080         {$IFDEF VerbosePasResolver}
3081         writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' set=? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3082         {$ENDIF}
3083         RaiseNotYetImplemented(20170714120756,Expr);
3084       end;
3085     else
3086       {$IFDEF VerbosePasResolver}
3087       writeln('TResExprEvaluator.EvalBinaryNEqualExpr ',Expr.OpCode,' ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3088       {$ENDIF}
3089       Result.Free;
3090       RaiseNotYetImplemented(20170531011931,Expr);
3091     end;
3092     {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3093     {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3094   except
3095     on EOverflow do
3096       RaiseOverflowArithmetic(20170601132729,Expr);
3097     on ERangeError do
3098       RaiseRangeCheck(20170601132740,Expr);
3099   end;
3100   if Expr.OpCode=eopNotEqual then
3101     TResEvalBool(Result).B:=not TResEvalBool(Result).B;
3102 end;
3103 
TResExprEvaluator.EvalBinaryLessGreaterExprnull3104 function TResExprEvaluator.EvalBinaryLessGreaterExpr(Expr: TBinaryExpr;
3105   LeftValue, RightValue: TResEvalValue): TResEvalValue;
3106 
3107   procedure CmpUnicode(const LeftUnicode, RightUnicode: UnicodeString);
3108   begin
3109     case Expr.OpCode of
3110     eopLessThan:
3111       TResEvalBool(Result).B:=LeftUnicode < RightUnicode;
3112     eopGreaterThan:
3113       TResEvalBool(Result).B:=LeftUnicode > RightUnicode;
3114     eopLessthanEqual:
3115       TResEvalBool(Result).B:=LeftUnicode <= RightUnicode;
3116     eopGreaterThanEqual:
3117       TResEvalBool(Result).B:=LeftUnicode >= RightUnicode;
3118     end;
3119   end;
3120 
3121 var
3122   LeftSet, RightSet: TResEvalSet;
3123   i: Integer;
3124   Int: TMaxPrecInt;
3125 begin
3126   Result:=TResEvalBool.Create;
3127   try
3128     {$Q+}
3129     {$R+}
3130     case LeftValue.Kind of
3131     revkInt:
3132       case RightValue.Kind of
3133       revkInt:
3134         case Expr.OpCode of
3135         eopLessThan:
3136           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalInt(RightValue).Int;
3137         eopGreaterThan:
3138           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalInt(RightValue).Int;
3139         eopLessthanEqual:
3140           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalInt(RightValue).Int;
3141         eopGreaterThanEqual:
3142           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalInt(RightValue).Int;
3143         end;
3144       revkUInt:
3145         case Expr.OpCode of
3146         eopLessThan:
3147           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalUInt(RightValue).UInt;
3148         eopGreaterThan:
3149           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalUInt(RightValue).UInt;
3150         eopLessthanEqual:
3151           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalUInt(RightValue).UInt;
3152         eopGreaterThanEqual:
3153           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalUInt(RightValue).UInt;
3154         end;
3155       revkFloat:
3156         case Expr.OpCode of
3157         eopLessThan:
3158           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalFloat(RightValue).FloatValue;
3159         eopGreaterThan:
3160           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalFloat(RightValue).FloatValue;
3161         eopLessthanEqual:
3162           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalFloat(RightValue).FloatValue;
3163         eopGreaterThanEqual:
3164           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalFloat(RightValue).FloatValue;
3165         end;
3166       revkCurrency:
3167         case Expr.OpCode of
3168         eopLessThan:
3169           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int < TResEvalCurrency(RightValue).Value;
3170         eopGreaterThan:
3171           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int > TResEvalCurrency(RightValue).Value;
3172         eopLessthanEqual:
3173           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int <= TResEvalCurrency(RightValue).Value;
3174         eopGreaterThanEqual:
3175           TResEvalBool(Result).B:=TResEvalInt(LeftValue).Int >= TResEvalCurrency(RightValue).Value;
3176         end;
3177       else
3178         {$IFDEF VerbosePasResolver}
3179         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr int ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3180         {$ENDIF}
3181         Result.Free;
3182         RaiseNotYetImplemented(20170601122512,Expr);
3183       end;
3184     revkUInt:
3185       case RightValue.Kind of
3186       revkInt:
3187         case Expr.OpCode of
3188         eopLessThan:
3189           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalInt(RightValue).Int;
3190         eopGreaterThan:
3191           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalInt(RightValue).Int;
3192         eopLessthanEqual:
3193           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalInt(RightValue).Int;
3194         eopGreaterThanEqual:
3195           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalInt(RightValue).Int;
3196         end;
3197       revkUInt:
3198         case Expr.OpCode of
3199         eopLessThan:
3200           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalUInt(RightValue).UInt;
3201         eopGreaterThan:
3202           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalUInt(RightValue).UInt;
3203         eopLessthanEqual:
3204           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalUInt(RightValue).UInt;
3205         eopGreaterThanEqual:
3206           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalUInt(RightValue).UInt;
3207         end;
3208       revkFloat:
3209         case Expr.OpCode of
3210         eopLessThan:
3211           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalFloat(RightValue).FloatValue;
3212         eopGreaterThan:
3213           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalFloat(RightValue).FloatValue;
3214         eopLessthanEqual:
3215           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalFloat(RightValue).FloatValue;
3216         eopGreaterThanEqual:
3217           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalFloat(RightValue).FloatValue;
3218         end;
3219       revkCurrency:
3220         case Expr.OpCode of
3221         eopLessThan:
3222           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt < TResEvalCurrency(RightValue).Value;
3223         eopGreaterThan:
3224           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt > TResEvalCurrency(RightValue).Value;
3225         eopLessthanEqual:
3226           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt <= TResEvalCurrency(RightValue).Value;
3227         eopGreaterThanEqual:
3228           TResEvalBool(Result).B:=TResEvalUInt(LeftValue).UInt >= TResEvalCurrency(RightValue).Value;
3229         end;
3230       else
3231         {$IFDEF VerbosePasResolver}
3232         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr uint ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3233         {$ENDIF}
3234         Result.Free;
3235         RaiseNotYetImplemented(20170601133222,Expr);
3236       end;
3237     revkFloat:
3238       case RightValue.Kind of
3239       revkInt:
3240         case Expr.OpCode of
3241         eopLessThan:
3242           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalInt(RightValue).Int;
3243         eopGreaterThan:
3244           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalInt(RightValue).Int;
3245         eopLessthanEqual:
3246           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalInt(RightValue).Int;
3247         eopGreaterThanEqual:
3248           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalInt(RightValue).Int;
3249         end;
3250       revkUInt:
3251         case Expr.OpCode of
3252         eopLessThan:
3253           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalUInt(RightValue).UInt;
3254         eopGreaterThan:
3255           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalUInt(RightValue).UInt;
3256         eopLessthanEqual:
3257           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalUInt(RightValue).UInt;
3258         eopGreaterThanEqual:
3259           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalUInt(RightValue).UInt;
3260         end;
3261       revkFloat:
3262         case Expr.OpCode of
3263         eopLessThan:
3264           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalFloat(RightValue).FloatValue;
3265         eopGreaterThan:
3266           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalFloat(RightValue).FloatValue;
3267         eopLessthanEqual:
3268           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalFloat(RightValue).FloatValue;
3269         eopGreaterThanEqual:
3270           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalFloat(RightValue).FloatValue;
3271         end;
3272       revkCurrency:
3273         case Expr.OpCode of
3274         eopLessThan:
3275           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue < TResEvalCurrency(RightValue).Value;
3276         eopGreaterThan:
3277           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue > TResEvalCurrency(RightValue).Value;
3278         eopLessthanEqual:
3279           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue <= TResEvalCurrency(RightValue).Value;
3280         eopGreaterThanEqual:
3281           TResEvalBool(Result).B:=TResEvalFloat(LeftValue).FloatValue >= TResEvalCurrency(RightValue).Value;
3282         end;
3283       else
3284         {$IFDEF VerbosePasResolver}
3285         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr float ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3286         {$ENDIF}
3287         Result.Free;
3288         RaiseNotYetImplemented(20170601133421,Expr);
3289       end;
3290     revkCurrency:
3291       case RightValue.Kind of
3292       revkInt:
3293         case Expr.OpCode of
3294         eopLessThan:
3295           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalInt(RightValue).Int;
3296         eopGreaterThan:
3297           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalInt(RightValue).Int;
3298         eopLessthanEqual:
3299           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalInt(RightValue).Int;
3300         eopGreaterThanEqual:
3301           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalInt(RightValue).Int;
3302         end;
3303       revkUInt:
3304         case Expr.OpCode of
3305         eopLessThan:
3306           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalUInt(RightValue).UInt;
3307         eopGreaterThan:
3308           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalUInt(RightValue).UInt;
3309         eopLessthanEqual:
3310           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalUInt(RightValue).UInt;
3311         eopGreaterThanEqual:
3312           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalUInt(RightValue).UInt;
3313         end;
3314       revkFloat:
3315         case Expr.OpCode of
3316         eopLessThan:
3317           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalFloat(RightValue).FloatValue;
3318         eopGreaterThan:
3319           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalFloat(RightValue).FloatValue;
3320         eopLessthanEqual:
3321           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalFloat(RightValue).FloatValue;
3322         eopGreaterThanEqual:
3323           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalFloat(RightValue).FloatValue;
3324         end;
3325       revkCurrency:
3326         case Expr.OpCode of
3327         eopLessThan:
3328           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value < TResEvalCurrency(RightValue).Value;
3329         eopGreaterThan:
3330           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value > TResEvalCurrency(RightValue).Value;
3331         eopLessthanEqual:
3332           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value <= TResEvalCurrency(RightValue).Value;
3333         eopGreaterThanEqual:
3334           TResEvalBool(Result).B:=TResEvalCurrency(LeftValue).Value >= TResEvalCurrency(RightValue).Value;
3335         end;
3336       else
3337         {$IFDEF VerbosePasResolver}
3338         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr currency ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3339         {$ENDIF}
3340         Result.Free;
3341         RaiseNotYetImplemented(20180421165752,Expr);
3342       end;
3343     {$ifdef FPC_HAS_CPSTRING}
3344     revkString:
3345       case RightValue.Kind of
3346       revkString:
3347         if GetCodePage(TResEvalString(LeftValue).S)=GetCodePage(TResEvalString(RightValue).S) then
3348           case Expr.OpCode of
3349           eopLessThan:
3350             TResEvalBool(Result).B:=TResEvalString(LeftValue).S < TResEvalString(RightValue).S;
3351           eopGreaterThan:
3352             TResEvalBool(Result).B:=TResEvalString(LeftValue).S > TResEvalString(RightValue).S;
3353           eopLessthanEqual:
3354             TResEvalBool(Result).B:=TResEvalString(LeftValue).S <= TResEvalString(RightValue).S;
3355           eopGreaterThanEqual:
3356             TResEvalBool(Result).B:=TResEvalString(LeftValue).S >= TResEvalString(RightValue).S;
3357           end
3358         else
3359           CmpUnicode(GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left),
3360                      GetUnicodeStr(TResEvalString(RightValue).S,Expr.right));
3361       revkUnicodeString:
3362         CmpUnicode(GetUnicodeStr(TResEvalString(LeftValue).S,Expr.left),
3363                    TResEvalUTF16(RightValue).S);
3364       else
3365         {$IFDEF VerbosePasResolver}
3366         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr string ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3367         {$ENDIF}
3368         Result.Free;
3369         RaiseNotYetImplemented(20170711175629,Expr);
3370       end;
3371     {$endif}
3372     revkUnicodeString:
3373       case RightValue.Kind of
3374       {$ifdef FPC_HAS_CPSTRING}
3375       revkString:
3376         CmpUnicode(TResEvalUTF16(LeftValue).S,
3377                    GetUnicodeStr(TResEvalString(RightValue).S,Expr.right));
3378       {$endif}
3379       revkUnicodeString:
3380         CmpUnicode(TResEvalUTF16(LeftValue).S,TResEvalUTF16(RightValue).S);
3381       else
3382         {$IFDEF VerbosePasResolver}
3383         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr unicodestring ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3384         {$ENDIF}
3385         Result.Free;
3386         RaiseNotYetImplemented(20170711210730,Expr);
3387       end;
3388     revkSetOfInt:
3389       case RightValue.Kind of
3390       revkSetOfInt:
3391         begin
3392         LeftSet:=TResEvalSet(LeftValue);
3393         RightSet:=TResEvalSet(RightValue);
3394         case Expr.OpCode of
3395         eopGreaterThanEqual:
3396           begin
3397           // >=  ->  true if all elements of RightSet are in LeftSet
3398           TResEvalBool(Result).B:=true;
3399           for i:=0 to length(RightSet.Ranges)-1 do
3400             begin
3401             Int:=RightSet.Ranges[i].RangeStart;
3402             while Int<=RightSet.Ranges[i].RangeEnd do
3403               begin
3404               if LeftSet.IndexOfRange(Int)<0 then
3405                 begin
3406                 TResEvalBool(Result).B:=false;
3407                 break;
3408                 end;
3409               inc(Int);
3410               end;
3411             end;
3412           end;
3413         eopLessthanEqual:
3414           begin
3415           // <=  ->  true if all elements of LeftSet are in RightSet
3416           TResEvalBool(Result).B:=true;
3417           for i:=0 to length(LeftSet.Ranges)-1 do
3418             begin
3419             Int:=LeftSet.Ranges[i].RangeStart;
3420             while Int<=LeftSet.Ranges[i].RangeEnd do
3421               begin
3422               if RightSet.IndexOfRange(Int)<0 then
3423                 begin
3424                 TResEvalBool(Result).B:=false;
3425                 break;
3426                 end;
3427               inc(Int);
3428               end;
3429             end;
3430           end
3431         else
3432           {$IFDEF VerbosePasResolver}
3433           writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr set ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3434           {$ENDIF}
3435           Result.Free;
3436           RaiseNotYetImplemented(20170714122121,Expr);
3437         end;
3438         end;
3439       else
3440         {$IFDEF VerbosePasResolver}
3441         writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr set ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3442         {$ENDIF}
3443         Result.Free;
3444         RaiseNotYetImplemented(20170714121925,Expr);
3445       end;
3446     else
3447       {$IFDEF VerbosePasResolver}
3448       writeln('TResExprEvaluator.EvalBinaryLowerGreaterExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3449       {$ENDIF}
3450       Result.Free;
3451       RaiseNotYetImplemented(20170601122529,Expr);
3452     end;
3453   except
3454     on EOverflow do
3455       RaiseOverflowArithmetic(20170601132956,Expr);
3456     on ERangeError do
3457       RaiseRangeCheck(20170601132958,Expr);
3458   end;
3459 end;
3460 
EvalBinaryInExprnull3461 function TResExprEvaluator.EvalBinaryInExpr(Expr: TBinaryExpr; LeftValue,
3462   RightValue: TResEvalValue): TResEvalValue;
3463 var
3464   RightSet: TResEvalSet;
3465   Int: TMaxPrecInt;
3466 begin
3467   Result:=nil;
3468   case RightValue.Kind of
3469   revkSetOfInt:
3470     begin
3471     RightSet:=TResEvalSet(RightValue);
3472     case LeftValue.Kind of
3473     revkBool:
3474       Int:=ord(TResEvalBool(LeftValue).B);
3475     revkInt:
3476       Int:=TResEvalInt(LeftValue).Int;
3477     revkUInt:
3478       // Note: when FPC compares int64 with qword it converts the qword to an int64
3479       if TResEvalUInt(LeftValue).UInt>HighIntAsUInt then
3480         RaiseMsg(20170714123700,nRangeCheckError,sRangeCheckError,[],Expr)
3481       else
3482         Int:=TResEvalUInt(LeftValue).UInt;
3483     {$ifdef FPC_HAS_CPSTRING}
3484     revkString,
3485     {$endif}
3486     revkUnicodeString:
3487       Int:=StringToOrd(LeftValue,Expr);
3488     revkEnum:
3489       Int:=TResEvalEnum(LeftValue).Index;
3490     else
3491       {$IFDEF VerbosePasResolver}
3492       writeln('TResExprEvaluator.EvalBinaryInExpr ? in Set Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3493       {$ENDIF}
3494       RaiseNotYetImplemented(20170714123412,Expr);
3495     end;
3496     Result:=TResEvalBool.CreateValue(RightSet.IndexOfRange(Int)>=0);
3497     end;
3498   else
3499     {$IFDEF VerbosePasResolver}
3500     writeln('TResExprEvaluator.EvalBinaryInExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3501     {$ENDIF}
3502     RaiseNotYetImplemented(20170714123409,Expr);
3503   end;
3504 end;
3505 
EvalBinarySymmetricaldifferenceExprnull3506 function TResExprEvaluator.EvalBinarySymmetricaldifferenceExpr(
3507   Expr: TBinaryExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
3508 var
3509   LeftSet, RightSet: TResEvalSet;
3510   i: Integer;
3511   Int: TMaxPrecInt;
3512 begin
3513   case LeftValue.Kind of
3514   revkSetOfInt:
3515     case RightValue.Kind of
3516     revkSetOfInt:
3517       begin
3518       // sym diff
3519       LeftSet:=TResEvalSet(LeftValue);
3520       RightSet:=TResEvalSet(RightValue);
3521       // elements, which exists in either, but not both
3522       if LeftSet.ElKind=revskNone then
3523         Result:=RightSet.Clone
3524       else
3525         begin
3526         Result:=TResEvalSet.CreateEmptySameKind(LeftSet);
3527         for i:=0 to length(LeftSet.Ranges)-1 do
3528           begin
3529           Int:=LeftSet.Ranges[i].RangeStart;
3530           while Int<=LeftSet.Ranges[i].RangeEnd do
3531             begin
3532             if RightSet.IndexOfRange(Int)<0 then
3533               TResEvalSet(Result).Add(Int,Int);
3534             inc(Int);
3535             end;
3536           end;
3537         for i:=0 to length(RightSet.Ranges)-1 do
3538           begin
3539           Int:=RightSet.Ranges[i].RangeStart;
3540           while Int<=RightSet.Ranges[i].RangeEnd do
3541             begin
3542             if LeftSet.IndexOfRange(Int)<0 then
3543               TResEvalSet(Result).Add(Int,Int);
3544             inc(Int);
3545             end;
3546           end;
3547         end;
3548       end
3549     else
3550       {$IFDEF VerbosePasResolver}
3551       writeln('TResExprEvaluator.EvalBinarySymmetricaldifferenceExpr Set><? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3552       {$ENDIF}
3553       RaiseNotYetImplemented(20170714114144,Expr);
3554     end;
3555   else
3556     {$IFDEF VerbosePasResolver}
3557     writeln('TResExprEvaluator.EvalBinarySymmetricaldifferenceExpr ? ',Expr.OpCode,' ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3558     {$ENDIF}
3559     RaiseNotYetImplemented(20170714114119,Expr);
3560   end;
3561 end;
3562 
EvalParamsExprnull3563 function TResExprEvaluator.EvalParamsExpr(Expr: TParamsExpr;
3564   Flags: TResEvalFlags): TResEvalValue;
3565 begin
3566   Result:=OnEvalParams(Self,Expr,Flags);
3567   if Result<>nil then exit;
3568   case Expr.Kind of
3569   pekArrayParams: Result:=EvalArrayParamsExpr(Expr,Flags);
3570   pekSet: Result:=EvalSetParamsExpr(Expr,Flags);
3571   end;
3572   if Result=nil then
3573     begin
3574     if [refConst,refConstExt]*Flags<>[] then
3575       RaiseConstantExprExp(20170713124038,Expr);
3576     exit;
3577     end;
3578 end;
3579 
TResExprEvaluator.EvalArrayParamsExprnull3580 function TResExprEvaluator.EvalArrayParamsExpr(Expr: TParamsExpr;
3581   Flags: TResEvalFlags): TResEvalValue;
3582 var
3583   ArrayValue, IndexValue: TResEvalValue;
3584   Int: TMaxPrecInt;
3585   Param0: TPasExpr;
3586   MaxIndex: Integer;
3587 begin
3588   Result:=nil;
3589   ArrayValue:=Eval(Expr.Value,Flags);
3590   if ArrayValue=nil then
3591     begin
3592     if [refConst,refConstExt]*Flags<>[] then
3593       RaiseConstantExprExp(20170711181321,Expr.Value);
3594     exit;
3595     end;
3596   IndexValue:=nil;
3597   try
3598     case ArrayValue.Kind of
3599     {$ifdef FPC_HAS_CPSTRING}
3600     revkString,
3601     {$endif}
3602     revkUnicodeString:
3603       begin
3604       // string[index]
3605       Param0:=Expr.Params[0];
3606       IndexValue:=Eval(Param0,Flags);
3607       if IndexValue=nil then
3608         begin
3609         if [refConst,refConstExt]*Flags<>[] then
3610           RaiseConstantExprExp(20170711181603,Param0);
3611         exit;
3612         end;
3613       case IndexValue.Kind of
3614         revkInt: Int:=TResEvalInt(IndexValue).Int;
3615         revkUInt:
3616           // Note: when FPC compares int64 with qword it converts the qword to an int64
3617           if TResEvalUInt(IndexValue).UInt>HighIntAsUInt then
3618             RaiseRangeCheck(20170711182006,Param0)
3619           else
3620             Int:=TResEvalUInt(IndexValue).UInt;
3621       else
3622         {$IFDEF VerbosePasResolver}
3623         writeln('TResExprEvaluator.EvalParamsExpr string[',IndexValue.AsDebugString,']');
3624         {$ENDIF}
3625         RaiseNotYetImplemented(20170711182100,Expr);
3626       end;
3627       {$ifdef FPC_HAS_CPSTRING}
3628       if ArrayValue.Kind=revkString then
3629         MaxIndex:=length(TResEvalString(ArrayValue).S)
3630       else
3631       {$endif}
3632         MaxIndex:=length(TResEvalUTF16(ArrayValue).S);
3633       if (Int<1) or (Int>MaxIndex) then
3634         EmitRangeCheckConst(20170711183058,IntToStr(Int),'1',IntToStr(MaxIndex),Param0,mtError);
3635       {$ifdef FPC_HAS_CPSTRING}
3636       if ArrayValue.Kind=revkString then
3637         Result:=TResEvalString.CreateValue(TResEvalString(ArrayValue).S[Int])
3638       else
3639       {$endif}
3640         Result:=TResEvalUTF16.CreateValue(TResEvalUTF16(ArrayValue).S[Int]);
3641       exit;
3642       end;
3643     else
3644       {$IFDEF VerbosePasResolver}
3645       writeln('TResExprEvaluator.EvalParamsExpr Array=',ArrayValue.AsDebugString);
3646       {$ENDIF}
3647       RaiseNotYetImplemented(20170711181507,Expr);
3648     end;
3649 
3650     if [refConst,refConstExt]*Flags<>[] then
3651       RaiseConstantExprExp(20170522173150,Expr);
3652   finally
3653     ReleaseEvalValue(ArrayValue);
3654     ReleaseEvalValue(IndexValue);
3655   end;
3656 end;
3657 
EvalSetParamsExprnull3658 function TResExprEvaluator.EvalSetParamsExpr(Expr: TParamsExpr;
3659   Flags: TResEvalFlags): TResEvalSet;
3660 begin
3661   {$IFDEF VerbosePasResEval}
3662   writeln('TResExprEvaluator.EvalSetParamsExpr length(Expr.Params)=',length(Expr.Params));
3663   {$ENDIF}
3664   Result:=EvalSetExpr(Expr,Expr.Params,Flags);
3665 end;
3666 
EvalSetExprnull3667 function TResExprEvaluator.EvalSetExpr(Expr: TPasExpr;
3668   ExprArray: TPasExprArray; Flags: TResEvalFlags): TResEvalSet;
3669 var
3670   i: Integer;
3671   RangeStart, RangeEnd: TMaxPrecInt;
3672   Value: TResEvalValue;
3673   ok, OnlyConstElements: Boolean;
3674   El: TPasExpr;
3675 begin
3676   {$IFDEF VerbosePasResEval}
3677   writeln('TResExprEvaluator.EvalSetExpr Expr=',GetObjName(Expr),' length(ExprArray)=',length(ExprArray));
3678   {$ENDIF}
3679   Result:=TResEvalSet.Create;
3680   if Expr=nil then ;
3681   Value:=nil;
3682   OnlyConstElements:=true;
3683   ok:=false;
3684   try
3685     for i:=0 to length(ExprArray)-1 do
3686       begin
3687       El:=ExprArray[i];
3688       {$IFDEF VerbosePasResEval}
3689       writeln('TResExprEvaluator.EvalSetExpr ',i,' of ',length(ExprArray),' El=',GetObjName(El));
3690       {$ENDIF}
3691       Value:=Eval(El,Flags);
3692       if Value=nil then
3693         begin
3694         // element is not a const -> the set is not a const
3695         OnlyConstElements:=false;
3696         continue;
3697         end;
3698       {$IFDEF VerbosePasResEval}
3699       //writeln('TResExprEvaluator.EvalSetExpr ',i,' of ',length(ExprArray),' Value=',Value.AsDebugString);
3700       {$ENDIF}
3701       case Value.Kind of
3702       revkBool:
3703         begin
3704         if Result.ElKind=revskNone then
3705           Result.ElKind:=revskBool
3706         else if Result.ElKind<>revskBool then
3707           RaiseNotYetImplemented(20170714132843,El);
3708         RangeStart:=ord(TResEvalBool(Value).B);
3709         RangeEnd:=RangeStart;
3710         end;
3711       revkInt:
3712         begin
3713         if Result.ElKind=revskNone then
3714           Result.ElKind:=revskInt
3715         else if Result.ElKind<>revskInt then
3716           RaiseNotYetImplemented(20170713201208,El);
3717         RangeStart:=TResEvalInt(Value).Int;
3718         RangeEnd:=RangeStart;
3719         end;
3720       revkUInt:
3721         begin
3722         if Result.ElKind=revskNone then
3723           Result.ElKind:=revskInt
3724         else if Result.ElKind<>revskInt then
3725           RaiseNotYetImplemented(20170713201230,El)
3726         // Note: when FPC compares int64 with qword it converts the qword to an int64
3727         else if TResEvalUInt(Value).UInt>HighIntAsUInt then
3728           EmitRangeCheckConst(20170713201306,Value.AsString,
3729             '0',IntToStr(High(TMaxPrecInt)),El,mtError);
3730         RangeStart:=TResEvalUInt(Value).UInt;
3731         RangeEnd:=RangeStart;
3732         end;
3733       {$ifdef FPC_HAS_CPSTRING}
3734       revkString:
3735         begin
3736         if Result.ElKind=revskNone then
3737           Result.ElKind:=revskChar
3738         else if Result.ElKind<>revskChar then
3739           RaiseNotYetImplemented(20170713201456,El);
3740         RangeStart:=StringToOrd(Value,nil);
3741         if RangeStart>$ffff then
3742           begin
3743           // set of string (not of char)
3744           ReleaseEvalValue(TResEvalValue(Result));
3745           exit;
3746           end;
3747         RangeEnd:=RangeStart;
3748         end;
3749       {$endif}
3750       revkUnicodeString:
3751         begin
3752         if Result.ElKind=revskNone then
3753           Result.ElKind:=revskChar
3754         else if Result.ElKind<>revskChar then
3755           RaiseNotYetImplemented(20170713201516,El);
3756         if length(TResEvalUTF16(Value).S)<>1 then
3757           begin
3758           // set of string (not of char)
3759           ReleaseEvalValue(TResEvalValue(Result));
3760           exit;
3761           end;
3762         RangeStart:=ord(TResEvalUTF16(Value).S[1]);
3763         RangeEnd:=RangeStart;
3764         end;
3765       revkEnum:
3766         begin
3767         if Result.ElKind=revskNone then
3768           begin
3769           Result.ElKind:=revskEnum;
3770           Result.ElType:=Value.IdentEl.Parent as TPasEnumType;
3771           end
3772         else if Result.ElKind<>revskEnum then
3773           RaiseNotYetImplemented(20170713143559,El)
3774         else if Result.ElType<>TResEvalEnum(Value).ElType then
3775           RaiseNotYetImplemented(20170713201021,El);
3776         RangeStart:=TResEvalEnum(Value).Index;
3777         RangeEnd:=RangeStart;
3778         end;
3779       revkRangeInt:
3780         begin
3781         if Result.ElKind=revskNone then
3782           begin
3783           Result.ElKind:=TResEvalRangeInt(Value).ElKind;
3784           if Result.ElKind=revskEnum then
3785             Result.ElType:=TResEvalRangeInt(Value).ElType;
3786           end
3787         else if Result.ElKind<>TResEvalRangeInt(Value).ElKind then
3788           RaiseNotYetImplemented(20170714101910,El);
3789         RangeStart:=TResEvalRangeInt(Value).RangeStart;
3790         RangeEnd:=TResEvalRangeInt(Value).RangeEnd;
3791         end;
3792       revkRangeUInt:
3793         begin
3794         if Result.ElKind=revskNone then
3795           Result.ElKind:=revskInt
3796         else if Result.ElKind<>revskInt then
3797           RaiseNotYetImplemented(20170713202934,El)
3798         // Note: when FPC compares int64 with qword it converts the qword to an int64
3799         else if TResEvalRangeUInt(Value).RangeEnd>HighIntAsUInt then
3800           EmitRangeCheckConst(20170713203034,Value.AsString,
3801             '0',IntToStr(High(TMaxPrecInt)),El,mtError);
3802         RangeStart:=TResEvalRangeUInt(Value).RangeStart;
3803         RangeEnd:=TResEvalRangeUInt(Value).RangeEnd;
3804         end
3805       else
3806         {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
3807         writeln('TResExprEvaluator.EvalSetExpr Result.ElKind=',Result.ElKind,' Value.Kind=',Value.Kind);
3808         {$ENDIF}
3809         RaiseNotYetImplemented(20170713143422,El);
3810       end;
3811 
3812       if Result.Intersects(RangeStart,RangeEnd)>=0 then
3813         begin
3814         {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
3815         writeln('TResExprEvaluator.EvalSetExpr Value=',Value.AsDebugString,' Range=',RangeStart,'..',RangeEnd,' Result=',Result.AsDebugString);
3816         {$ENDIF}
3817         RaiseMsg(20170714141326,nRangeCheckInSetConstructor,
3818           sRangeCheckInSetConstructor,[],El);
3819         end;
3820       Result.Add(RangeStart,RangeEnd);
3821       ReleaseEvalValue(Value);
3822       end;
3823     ok:=OnlyConstElements;
3824   finally
3825     ReleaseEvalValue(Value);
3826     if not ok then
3827       ReleaseEvalValue(TResEvalValue(Result));
3828   end;
3829 end;
3830 
TResExprEvaluator.EvalArrayValuesExprnull3831 function TResExprEvaluator.EvalArrayValuesExpr(Expr: TArrayValues;
3832   Flags: TResEvalFlags): TResEvalSet;
3833 begin
3834   {$IFDEF VerbosePasResEval}
3835   writeln('TResExprEvaluator.EvalArrayValuesExpr length(Expr.Values)=',length(Expr.Values));
3836   {$ENDIF}
3837   Result:=EvalSetExpr(Expr,Expr.Values,Flags);
3838 end;
3839 
TResExprEvaluator.EvalBinaryPowerExprnull3840 function TResExprEvaluator.EvalBinaryPowerExpr(Expr: TBinaryExpr; LeftValue,
3841   RightValue: TResEvalValue): TResEvalValue;
3842 var
3843   Int: TMaxPrecInt;
3844   Flo: TMaxPrecFloat;
3845   aCurrency: TMaxPrecCurrency;
3846 begin
3847   Result:=nil;
3848   case LeftValue.Kind of
3849   revkInt:
3850     case RightValue.Kind of
3851     revkInt:
3852       // int^^int
3853       try
3854         {$Q+}{$R+}
3855         Int:=trunc(Math.power(TResEvalInt(LeftValue).Int,TResEvalInt(RightValue).Int));
3856         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3857         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3858         Result:=TResEvalInt.CreateValue(Int);
3859       except
3860         RaiseOverflowArithmetic(20170530210533,Expr);
3861       end;
3862     revkUInt:
3863       // int^^uint
3864       try
3865         {$Q+}{$R+}
3866         Int:=trunc(Math.power(TResEvalInt(LeftValue).Int,TResEvalUInt(RightValue).UInt));
3867         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3868         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3869         Result:=TResEvalInt.CreateValue(Int);
3870       except
3871         RaiseOverflowArithmetic(20170530211028,Expr);
3872       end;
3873     revkFloat:
3874       // int^^float
3875       try
3876         {$Q+}{$R+}
3877         Flo:=Math.power(TResEvalInt(LeftValue).Int,TResEvalFloat(RightValue).FloatValue);
3878         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3879         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3880         Result:=TResEvalFloat.CreateValue(Flo);
3881       except
3882         RaiseOverflowArithmetic(20170816154223,Expr);
3883       end;
3884     revkCurrency:
3885       // int^^currency
3886       try
3887         {$Q+}{$R+}
3888         Flo:=Math.power(TResEvalInt(LeftValue).Int,TResEvalCurrency(RightValue).Value);
3889         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3890         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3891         Result:=TResEvalFloat.CreateValue(Flo);
3892       except
3893         RaiseOverflowArithmetic(20180421165906,Expr);
3894       end;
3895     else
3896       {$IFDEF VerbosePasResolver}
3897       writeln('TResExprEvaluator.EvalBinaryPowerExpr int ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3898       {$ENDIF}
3899       RaiseNotYetImplemented(20170530205640,Expr);
3900     end;
3901   revkUInt:
3902     case RightValue.Kind of
3903     revkInt:
3904       // uint^^int
3905       try
3906         {$Q+}{$R+}
3907         Int:=trunc(Math.power(TResEvalUInt(LeftValue).UInt,TResEvalInt(RightValue).Int));
3908         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3909         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3910         Result:=TResEvalInt.CreateValue(Int);
3911       except
3912         RaiseOverflowArithmetic(20170530211102,Expr);
3913       end;
3914     revkUInt:
3915       // uint^^uint
3916       try
3917         {$Q+}{$R+}
3918         Int:=trunc(Math.power(TResEvalUInt(LeftValue).UInt,TResEvalUInt(RightValue).UInt));
3919         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3920         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3921         Result:=TResEvalInt.CreateValue(Int);
3922       except
3923         RaiseOverflowArithmetic(20170530211121,Expr);
3924       end;
3925     revkFloat:
3926       // uint^^float
3927       try
3928         {$Q+}{$R+}
3929         Flo:=Math.power(TResEvalUInt(LeftValue).UInt,TResEvalFloat(RightValue).FloatValue);
3930         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3931         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3932         Result:=TResEvalFloat.CreateValue(Flo);
3933       except
3934         RaiseOverflowArithmetic(20170816154241,Expr);
3935       end;
3936     revkCurrency:
3937       // uint^^currency
3938       try
3939         {$Q+}{$R+}
3940         Flo:=Math.power(TResEvalUInt(LeftValue).UInt,TResEvalCurrency(RightValue).Value);
3941         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3942         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3943         Result:=TResEvalFloat.CreateValue(Flo);
3944       except
3945         RaiseOverflowArithmetic(20180421165948,Expr);
3946       end;
3947     else
3948       {$IFDEF VerbosePasResolver}
3949       writeln('TResExprEvaluator.EvalBinaryPowerExpr uint ^^ ? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
3950       {$ENDIF}
3951       RaiseNotYetImplemented(20170530211140,Expr);
3952     end;
3953   revkFloat:
3954     case RightValue.Kind of
3955     revkInt:
3956       // float ^^ int
3957       try
3958         {$Q+}{$R+}
3959         Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalInt(RightValue).Int);
3960         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3961         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3962         Result:=TResEvalFloat.CreateValue(Flo);
3963       except
3964         RaiseOverflowArithmetic(20170816153950,Expr);
3965       end;
3966     revkUInt:
3967       // float ^^ uint
3968       try
3969         {$Q+}{$R+}
3970         Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalUInt(RightValue).UInt);
3971         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3972         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3973         Result:=TResEvalFloat.CreateValue(Flo);
3974       except
3975         RaiseOverflowArithmetic(20170816154012,Expr);
3976       end;
3977     revkFloat:
3978       // float ^^ float
3979       try
3980         {$Q+}{$R+}
3981         Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalFloat(RightValue).FloatValue);
3982         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3983         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3984         Result:=TResEvalFloat.CreateValue(Flo);
3985       except
3986         RaiseOverflowArithmetic(20170816154012,Expr);
3987       end;
3988     revkCurrency:
3989       // float ^^ currency
3990       try
3991         {$Q+}{$R+}
3992         Flo:=Math.power(TResEvalFloat(LeftValue).FloatValue,TResEvalCurrency(RightValue).Value);
3993         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
3994         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
3995         Result:=TResEvalFloat.CreateValue(Flo);
3996       except
3997         RaiseOverflowArithmetic(20180421170016,Expr);
3998       end;
3999     end;
4000   revkCurrency:
4001     case RightValue.Kind of
4002     revkInt:
4003       // currency ^^ int
4004       try
4005         {$Q+}{$R+}
4006         aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalInt(RightValue).Int);
4007         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
4008         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
4009         Result:=TResEvalCurrency.CreateValue(aCurrency);
4010       except
4011         RaiseOverflowArithmetic(20180421170235,Expr);
4012       end;
4013     revkUInt:
4014       // currency ^^ uint
4015       try
4016         {$Q+}{$R+}
4017         aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalUInt(RightValue).UInt);
4018         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
4019         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
4020         Result:=TResEvalCurrency.CreateValue(aCurrency);
4021       except
4022         RaiseOverflowArithmetic(20180421170240,Expr);
4023       end;
4024     revkFloat:
4025       // currency ^^ float
4026       try
4027         {$Q+}{$R+}
4028         aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalFloat(RightValue).FloatValue);
4029         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
4030         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
4031         Result:=TResEvalCurrency.CreateValue(aCurrency);
4032       except
4033         RaiseOverflowArithmetic(20180421170254,Expr);
4034       end;
4035     revkCurrency:
4036       // currency ^^ currency
4037       try
4038         {$Q+}{$R+}
4039         aCurrency:=Math.power(TResEvalCurrency(LeftValue).Value,TResEvalCurrency(RightValue).Value);
4040         {$IFNDEF OverflowCheckOn}{$Q-}{$ENDIF}
4041         {$IFNDEF RangeCheckOn}{$R-}{$ENDIF}
4042         Result:=TResEvalCurrency.CreateValue(aCurrency);
4043       except
4044         RaiseOverflowArithmetic(20180421170311,Expr);
4045       end;
4046     end;
4047   else
4048     {$IFDEF VerbosePasResolver}
4049     writeln('TResExprEvaluator.EvalBinaryPowerExpr ^^ ?- Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
4050     {$ENDIF}
4051     RaiseNotYetImplemented(20170816153813,Expr);
4052   end;
4053 end;
4054 
StringToOrdnull4055 function TResExprEvaluator.StringToOrd(Value: TResEvalValue;
4056   PosEl: TPasElement): longword;
4057 const
4058   Invalid = $12345678; // bigger than $ffff and smaller than $8000000
4059 var
4060   {$ifdef FPC_HAS_CPSTRING}
4061   S: RawByteString;
4062   {$endif}
4063   U: UnicodeString;
4064 begin
4065   case Value.Kind of
4066   {$ifdef FPC_HAS_CPSTRING}
4067   revkString:
4068     begin
4069     // ord(ansichar)
4070     S:=TResEvalString(Value).S;
4071     if length(S)=1 then
4072       Result:=ord(S[1])
4073     else if (length(S)=0) or (length(S)>4) then
4074       begin
4075       if PosEl<>nil then
4076         RaiseMsg(20170522221143,nXExpectedButYFound,sXExpectedButYFound,
4077           ['char','string'],PosEl)
4078       else
4079         exit(Invalid);
4080       end
4081     else
4082       begin
4083       U:=GetUnicodeStr(S,nil);
4084       if length(U)<>1 then
4085         begin
4086         if PosEl<>nil then
4087           RaiseMsg(20190124180407,nXExpectedButYFound,sXExpectedButYFound,
4088             ['char','string'],PosEl)
4089         else
4090           exit(Invalid);
4091         end;
4092       Result:=ord(U[1]);
4093       end;
4094     end;
4095   {$endif}
4096   revkUnicodeString:
4097     begin
4098     // ord(widechar)
4099     U:=TResEvalUTF16(Value).S;
4100     if length(U)<>1 then
4101       begin
4102       if PosEl<>nil then
4103         RaiseMsg(20170522221358,nXExpectedButYFound,sXExpectedButYFound,
4104           ['char','string'],PosEl)
4105       else
4106         exit(Invalid);
4107       end
4108     else
4109       Result:=ord(U[1]);
4110     end;
4111   else
4112     RaiseNotYetImplemented(20170522220959,PosEl);
4113   end;
4114 end;
4115 
EvalPrimitiveExprStringnull4116 function TResExprEvaluator.EvalPrimitiveExprString(Expr: TPrimitiveExpr
4117   ): TResEvalValue;
4118 { Extracts the value from a Pascal string literal
4119 
4120   S is a Pascal string literal e.g. 'Line'#10
4121     ''  empty string
4122     '''' => "'"
4123     #decimal
4124     #$hex
4125     ^l  l is a letter a-z
4126 }
4127 
4128   procedure RangeError(id: TMaxPrecInt);
4129   begin
4130     Result.Free;
4131     RaiseRangeCheck(id,Expr);
4132   end;
4133 
4134   procedure Add(h: String);
4135   begin
4136     {$ifdef FPC_HAS_CPSTRING}
4137     if Result.Kind=revkString then
4138       TResEvalString(Result).S:=TResEvalString(Result).S+h
4139     else
4140       TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+GetUnicodeStr(h,Expr);
4141     {$else}
4142     TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+h;
4143     {$endif}
4144   end;
4145 
4146   procedure AddHash(u: longword; ForceUTF16: boolean);
4147   {$ifdef FPC_HAS_CPSTRING}
4148   var
4149     h: RawByteString;
4150   begin
4151     if ((u>255) or (ForceUTF16)) and (Result.Kind=revkString) then
4152       begin
4153       // switch to unicodestring
4154       h:=TResEvalString(Result).S;
4155       Result.Free;
4156       Result:=nil; // in case of exception in GetUnicodeStr
4157       Result:=TResEvalUTF16.CreateValue(GetUnicodeStr(h,Expr));
4158       end;
4159     if Result.Kind=revkString then
4160       TResEvalString(Result).S:=TResEvalString(Result).S+Chr(u)
4161     else
4162       TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
4163   end;
4164   {$else}
4165   begin
4166     TResEvalUTF16(Result).S:=TResEvalUTF16(Result).S+WideChar(u);
4167     if ForceUTF16 then ;
4168   end;
4169   {$endif}
4170 
4171 var
4172   p, StartP, l: integer;
4173   c: Char;
4174   u: longword;
4175   S: String;
4176 begin
4177   Result:=nil;
4178   S:=Expr.Value;
4179   {$IFDEF VerbosePasResEval}
4180   //writeln('TResExprEvaluator.EvalPrimitiveExprString (',S,')');
4181   {$ENDIF}
4182   l:=length(S);
4183   if l=0 then
4184     RaiseInternalError(20170523113809);
4185   {$ifdef FPC_HAS_CPSTRING}
4186   Result:=TResEvalString.Create;
4187   {$else}
4188   Result:=TResEvalUTF16.Create;
4189   {$endif}
4190   p:=1;
4191   while p<=l do
4192     case S[p] of
4193     {$ifdef UsePChar}
4194     #0: break;
4195     {$endif}
4196     '''':
4197       begin
4198       inc(p);
4199       StartP:=p;
4200       repeat
4201         if p>l then
4202           RaiseInternalError(20170523113938);
4203         c:=S[p];
4204         case c of
4205         '''':
4206           begin
4207           if p>StartP then
4208             Add(copy(S,StartP,p-StartP));
4209           inc(p);
4210           StartP:=p;
4211           if (p>l) or (S[p]<>'''') then
4212             break;
4213           Add('''');
4214           inc(p);
4215           StartP:=p;
4216           end;
4217         else
4218           inc(p);
4219         end;
4220       until false;
4221       if p>StartP then
4222         Add(copy(S,StartP,p-StartP));
4223       end;
4224     '#':
4225       begin
4226       inc(p);
4227       if p>l then
4228         RaiseInternalError(20181016121354);
4229       if S[p]='$' then
4230         begin
4231         // #$hexnumber
4232         inc(p);
4233         StartP:=p;
4234         u:=0;
4235         while p<=l do
4236           begin
4237           c:=S[p];
4238           case c of
4239           '0'..'9': u:=u*16+longword(ord(c)-ord('0'));
4240           'a'..'f': u:=u*16+longword(ord(c)-ord('a'))+10;
4241           'A'..'F': u:=u*16+longword(ord(c)-ord('A'))+10;
4242           else break;
4243           end;
4244           if u>$10FFFF then
4245             RangeError(20170523115712);
4246           inc(p);
4247           end;
4248         if p=StartP then
4249           RaiseInternalError(20170207164956);
4250         if u>$ffff then
4251           begin
4252           // split into two
4253           dec(u,$10000);
4254           AddHash($D800+(u shr 10),true);
4255           AddHash($DC00+(u and $3ff),true);
4256           end
4257         else
4258           AddHash(u,p-StartP>2);
4259         end
4260       else
4261         begin
4262         // #decimalnumber
4263         StartP:=p;
4264         u:=0;
4265         while p<=l do
4266           begin
4267           c:=S[p];
4268           case c of
4269           '0'..'9': u:=u*10+longword(ord(c)-ord('0'));
4270           else break;
4271           end;
4272           if u>$ffff then
4273             RangeError(20170523123137);
4274           inc(p);
4275           end;
4276         if p=StartP then
4277           RaiseInternalError(20170523123806);
4278         AddHash(u,false);
4279         end;
4280       end;
4281     '^':
4282       begin
4283       // ^A is #1
4284       inc(p);
4285       if p>l then
4286         RaiseInternalError(20181016121520);
4287       c:=S[p];
4288       case c of
4289       'a'..'z': AddHash(ord(c)-ord('a')+1,false);
4290       'A'..'Z': AddHash(ord(c)-ord('A')+1,false);
4291       else RaiseInternalError(20170523123809);
4292       end;
4293       inc(p);
4294       end;
4295     else
4296       RaiseNotYetImplemented(20170523123815,Expr,'ord='+IntToStr(ord(S[p])));
4297     end;
4298   {$IFDEF VerbosePasResEval}
4299   //writeln('TResExprEvaluator.EvalPrimitiveExprString Result=',Result.AsString);
4300   {$ENDIF}
4301 end;
4302 
TResExprEvaluator.CreateResEvalIntnull4303 function TResExprEvaluator.CreateResEvalInt(UInt: TMaxPrecUInt): TResEvalValue;
4304 begin
4305   if UInt<=HighIntAsUInt then
4306     Result:=TResEvalInt.CreateValue(TMaxPrecInt(UInt))
4307   else
4308     Result:=TResEvalUInt.CreateValue(UInt);
4309 end;
4310 
4311 constructor TResExprEvaluator.Create;
4312 begin
4313   inherited Create;
4314   FAllowedInts:=ReitDefaults;
4315   {$ifdef FPC_HAS_CPSTRING}
4316   FDefaultEncoding:=CP_ACP;
4317   {$endif}
4318 end;
4319 
TResExprEvaluator.Evalnull4320 function TResExprEvaluator.Eval(Expr: TPasExpr; Flags: TResEvalFlags
4321   ): TResEvalValue;
4322 var
4323   C: TClass;
4324   Code: integer;
4325   Int: TMaxPrecInt;
4326   UInt: TMaxPrecUInt;
4327   Flo: TMaxPrecFloat;
4328 begin
4329   Result:=nil;
4330   if Expr.CustomData is TResEvalValue then
4331     begin
4332     Result:=TResEvalValue(Expr.CustomData);
4333     exit;
4334     end;
4335   {$IFDEF VerbosePasResEval}
4336   writeln('TResExprEvaluator.Eval Expr=',GetObjName(Expr),' Flags=',dbgs(Flags));
4337   {$ENDIF}
4338   if refAutoConst in Flags then
4339     begin
4340     Exclude(Flags,refAutoConst);
4341     if IsConst(Expr) then
4342       Include(Flags,refConst);
4343     end;
4344   if refAutoConstExt in Flags then
4345     begin
4346     Exclude(Flags,refAutoConstExt);
4347     if IsConst(Expr) then
4348       Include(Flags,refConstExt);
4349     end;
4350 
4351   C:=Expr.ClassType;
4352   if C=TPrimitiveExpr then
4353     begin
4354     case TPrimitiveExpr(Expr).Kind of
4355       pekIdent:
4356         begin
4357         Result:=OnEvalIdentifier(Self,TPrimitiveExpr(Expr),Flags);
4358         //writeln('TResExprEvaluator.Eval primitiv result=',Result<>nil,' ',dbgs(Result));
4359         end;
4360       pekNumber:
4361         begin
4362         // try TMaxPrecInt
4363         val(TPrimitiveExpr(Expr).Value,Int,Code);
4364         if Code=0 then
4365           begin
4366           {$IFDEF VerbosePasResEval}
4367           writeln('TResExprEvaluator.Eval Int=',Int,' Value="',TPrimitiveExpr(Expr).Value,'"');
4368           {$ENDIF}
4369           if (Int<0) and (Pos('-',TPrimitiveExpr(Expr).Value)<1) then
4370             // FPC str() converts $8000000000000000 to a negative int64 -> ignore
4371           else
4372             begin
4373             Result:=TResEvalInt.CreateValue(Int);
4374             exit;
4375             end;
4376           end;
4377         // try TMaxPrecUInt
4378         val(TPrimitiveExpr(Expr).Value,UInt,Code);
4379         if Code=0 then
4380           begin
4381           Result:=TResEvalUInt.CreateValue(UInt);
4382           {$IFDEF VerbosePasResEval}
4383           writeln('TResExprEvaluator.Eval UInt=',UInt,' Value="',TPrimitiveExpr(Expr).Value,'"');
4384           {$ENDIF}
4385           exit;
4386           end;
4387         // try TMaxPrecFloat
4388         val(TPrimitiveExpr(Expr).Value,Flo,Code);
4389         if Code=0 then
4390           begin
4391           Result:=TResEvalFloat.CreateValue(Flo);
4392           {$IFDEF VerbosePasResEval}
4393           writeln('TResExprEvaluator.Eval Float=',Flo,' Value="',TPrimitiveExpr(Expr).Value,'"');
4394           {$ENDIF}
4395           exit;
4396           end;
4397         {$IFDEF VerbosePasResEval}
4398         writeln('TResExprEvaluator.Eval Value="',TPrimitiveExpr(Expr).Value,'"');
4399         {$ENDIF}
4400         RaiseRangeCheck(20170518202252,Expr);
4401         end;
4402       pekString:
4403         begin
4404         Result:=EvalPrimitiveExprString(TPrimitiveExpr(Expr));
4405         exit;
4406         end;
4407     else
4408       RaiseNotYetImplemented(20170518200951,Expr);
4409     end;
4410     {$IFDEF VerbosePasResEval}
4411     writeln('TResExprEvaluator.Eval primitiv end result=',Result<>nil,' ',dbgs(Result));
4412     {$ENDIF}
4413     end
4414   else if C=TNilExpr then
4415     Result:=TResEvalValue.CreateKind(revkNil)
4416   else if C=TBoolConstExpr then
4417     Result:=TResEvalBool.CreateValue(TBoolConstExpr(Expr).Value)
4418   else if C=TUnaryExpr then
4419     Result:=EvalUnaryExpr(TUnaryExpr(Expr),Flags)
4420   else if C=TBinaryExpr then
4421     Result:=EvalBinaryExpr(TBinaryExpr(Expr),Flags)
4422   else if C=TParamsExpr then
4423     Result:=EvalParamsExpr(TParamsExpr(Expr),Flags)
4424   else if C=TArrayValues then
4425     Result:=EvalArrayValuesExpr(TArrayValues(Expr),Flags)
4426   else if [refConst,refConstExt]*Flags<>[] then
4427     RaiseConstantExprExp(20170518213800,Expr);
4428   {$IFDEF VerbosePasResEval}
4429   writeln('TResExprEvaluator.Eval END ',Expr.ClassName,' result=',Result<>nil,' ',dbgs(Result));
4430   {$ENDIF}
4431 end;
4432 
TResExprEvaluator.IsInRangenull4433 function TResExprEvaluator.IsInRange(Expr, RangeExpr: TPasExpr;
4434   EmitHints: boolean): boolean;
4435 var
4436   Value, RangeValue: TResEvalValue;
4437 begin
4438   Value:=Eval(Expr,[refAutoConst]);
4439   if Value=nil then
4440     exit(true); // a variable -> ok
4441   RangeValue:=nil;
4442   try
4443     RangeValue:=Eval(RangeExpr,[]);
4444     if RangeValue=nil then
4445       RaiseNotYetImplemented(20170522171226,RangeExpr);
4446     Result:=IsInRange(Value,Expr,RangeValue,RangeExpr,EmitHints);
4447   finally
4448     ReleaseEvalValue(Value);
4449     ReleaseEvalValue(RangeValue);
4450   end;
4451 end;
4452 
TResExprEvaluator.IsInRangenull4453 function TResExprEvaluator.IsInRange(Value: TResEvalValue; ValueExpr: TPasExpr;
4454   RangeValue: TResEvalValue; RangeExpr: TPasExpr; EmitHints: boolean): boolean;
4455 var
4456   RgInt: TResEvalRangeInt;
4457   RgUInt: TResEvalRangeUInt;
4458   CharIndex: LongWord;
4459 begin
4460   Result:=false;
4461   {$IFDEF VerbosePasResEval}
4462   //writeln('TResExprEvaluator.IsInRange Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
4463   {$ENDIF}
4464   case RangeValue.Kind of
4465   revkRangeInt:
4466     begin
4467     RgInt:=TResEvalRangeInt(RangeValue);
4468     case RgInt.ElKind of
4469       revskBool:
4470         if Value.Kind=revkBool then
4471           exit(true)
4472         else
4473           RaiseNotYetImplemented(20170522220104,ValueExpr);
4474       revskEnum:
4475         begin
4476         if Value.Kind<>revkEnum then
4477           RaiseInternalError(20170522172754)
4478         else if TResEvalEnum(Value).ElType<>RgInt.ElType then
4479           RaiseInternalError(20170522174028)
4480         else if (TResEvalEnum(Value).Index<RgInt.RangeStart)
4481             or (TResEvalEnum(Value).Index>RgInt.RangeEnd) then
4482           begin
4483           if EmitHints then
4484             EmitRangeCheckConst(20170522174406,Value.AsString,
4485               RgInt.ElementAsString(RgInt.RangeStart),
4486               RgInt.ElementAsString(RgInt.RangeEnd),
4487               ValueExpr);
4488           exit(false);
4489           end
4490         else
4491           exit(true);
4492         end;
4493       revskInt: // int..int
4494         if Value.Kind=revkInt then
4495           begin
4496           // int in int..int
4497           if (TResEvalInt(Value).Int<RgInt.RangeStart)
4498               or (TResEvalInt(Value).Int>RgInt.RangeEnd) then
4499             begin
4500             if EmitHints then
4501               EmitRangeCheckConst(20170522174958,Value.AsString,
4502                 RgInt.ElementAsString(RgInt.RangeStart),
4503                 RgInt.ElementAsString(RgInt.RangeEnd),
4504                 ValueExpr);
4505             exit(false);
4506             end
4507           else
4508             exit(true);
4509           end
4510         else if Value.Kind=revkUInt then
4511           begin
4512           // uint in int..int
4513           if (TResEvalUInt(Value).UInt>HighIntAsUInt)
4514               or (TMaxPrecInt(TResEvalUInt(Value).UInt)<RgInt.RangeStart)
4515               or (TMaxPrecInt(TResEvalUInt(Value).UInt)>RgInt.RangeEnd) then
4516             begin
4517             if EmitHints then
4518               EmitRangeCheckConst(20170522215852,Value.AsString,
4519                 RgInt.ElementAsString(RgInt.RangeStart),
4520                 RgInt.ElementAsString(RgInt.RangeEnd),
4521                 ValueExpr);
4522             exit(false);
4523             end
4524           else
4525             exit(true);
4526           end
4527         else
4528           begin
4529           {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
4530           writeln('TResExprEvaluator.IsInRange Kind=',Value.Kind,' ',Value.AsDebugString);
4531           {$ENDIF}
4532           RaiseNotYetImplemented(20170522215906,ValueExpr);
4533           end;
4534       revskChar:
4535         if Value.Kind in revkAllStrings then
4536           begin
4537           // string in char..char
4538           CharIndex:=StringToOrd(Value,ValueExpr);
4539           if (CharIndex<RgInt.RangeStart) or (CharIndex>RgInt.RangeEnd) then
4540             begin
4541             if EmitHints then
4542               EmitRangeCheckConst(20170522221709,Value.AsString,
4543                 RgInt.ElementAsString(RgInt.RangeStart),
4544                 RgInt.ElementAsString(RgInt.RangeEnd),
4545                 ValueExpr);
4546             exit(false);
4547             end
4548           else
4549             exit(true);
4550           end
4551         else
4552           RaiseNotYetImplemented(20170522220210,ValueExpr);
4553     else
4554       RaiseInternalError(20170522172630);
4555     end;
4556     end;
4557   revkRangeUInt:
4558     if Value.Kind=revkInt then
4559       begin
4560       // int in uint..uint
4561       RgUInt:=TResEvalRangeUInt(RangeValue);
4562       if (TResEvalInt(Value).Int<0)
4563           or (TMaxPrecUInt(TResEvalInt(Value).Int)<RgUInt.RangeStart)
4564           or (TMaxPrecUInt(TResEvalInt(Value).Int)>RgUInt.RangeEnd) then
4565         begin
4566         if EmitHints then
4567           EmitRangeCheckConst(20170522172250,Value.AsString,
4568             IntToStr(RgUInt.RangeStart),
4569             IntToStr(RgUInt.RangeEnd),ValueExpr);
4570         exit(false);
4571         end
4572       else
4573         exit(true);
4574       end
4575     else if Value.Kind=revkUInt then
4576       begin
4577       // uint in uint..uint
4578       RgUInt:=TResEvalRangeUInt(RangeValue);
4579       if (TResEvalUInt(Value).UInt<RgUInt.RangeStart)
4580           or (TResEvalUInt(Value).UInt>RgUInt.RangeEnd) then
4581         begin
4582         if EmitHints then
4583           EmitRangeCheckConst(20170522172544,IntToStr(TResEvalUInt(Value).UInt),
4584             IntToStr(RgUInt.RangeStart),
4585             IntToStr(RgUInt.RangeEnd),ValueExpr);
4586         exit(false);
4587         end
4588       else
4589         exit(true);
4590       end
4591     else
4592       begin
4593       {$IFDEF VerbosePasResEval}
4594       writeln('TResExprEvaluator.IsInRange Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
4595       {$ENDIF}
4596       RaiseNotYetImplemented(20170522171551,ValueExpr);
4597       end;
4598   else
4599     {$IFDEF VerbosePasResEval}
4600     writeln('TResExprEvaluator.IsInRange Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
4601     {$ENDIF}
4602     RaiseNotYetImplemented(20170522171307,RangeExpr);
4603   end;
4604 end;
4605 
IsSetCompatiblenull4606 function TResExprEvaluator.IsSetCompatible(Value: TResEvalValue;
4607   ValueExpr: TPasExpr; RangeValue: TResEvalValue; EmitHints: boolean): boolean;
4608 // checks if Value fits into a set of RangeValue
4609 var
4610   RightSet: TResEvalSet;
4611   LeftRange: TResEvalRangeInt;
4612   MinVal, MaxVal: TMaxPrecInt;
4613 begin
4614   Result:=true;
4615   case Value.Kind of
4616   revkSetOfInt:
4617     begin
4618     RightSet:=TResEvalSet(Value);
4619     if RightSet.ElKind=revskNone then
4620       exit(true); // empty set always fits
4621     case RangeValue.Kind of
4622     revkRangeInt:
4623       begin
4624       LeftRange:=TResEvalRangeInt(RangeValue);
4625       if (LeftRange.ElKind<>RightSet.ElKind)
4626           or (LeftRange.ElType<>RightSet.ElType) then
4627         begin
4628         {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
4629         writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
4630         {$ENDIF}
4631         RaiseNotYetImplemented(20170714201425,ValueExpr);
4632         end;
4633       if length(RightSet.Ranges)=0 then
4634         exit(true); // empty typed set fits
4635       MinVal:=RightSet.Ranges[0].RangeStart;
4636       MaxVal:=RightSet.Ranges[length(RightSet.Ranges)-1].RangeEnd;
4637       {$IFDEF VerbosePasResEval}
4638       writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' MinVal=',MinVal,' MaxVal=',MaxVal,' RangeValue=',dbgs(RangeValue));
4639       {$ENDIF}
4640       if (MinVal<LeftRange.RangeStart) then
4641         if EmitHints then
4642           EmitRangeCheckConst(20170714202813,RightSet.ElementAsString(MinVal),
4643             LeftRange.ElementAsString(LeftRange.RangeStart),
4644             LeftRange.ElementAsString(LeftRange.RangeEnd),ValueExpr,mtError)
4645         else
4646           exit(false);
4647       if (MaxVal>LeftRange.RangeEnd) then
4648         if EmitHints then
4649           EmitRangeCheckConst(20170714203134,RightSet.ElementAsString(MaxVal),
4650             LeftRange.ElementAsString(LeftRange.RangeStart),
4651             LeftRange.ElementAsString(LeftRange.RangeEnd),ValueExpr,mtError)
4652         else
4653           exit(false);
4654       end;
4655     else
4656       {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
4657       writeln('TResExprEvaluator.IsSetCompatible Value=',dbgs(Value),' RangeValue=',dbgs(RangeValue));
4658       {$ENDIF}
4659       RaiseNotYetImplemented(20170714201121,ValueExpr);
4660     end;
4661     end
4662   else
4663     {$IF defined(VerbosePasResEval) or defined(VerbosePasResolver)}
4664     writeln('TResExprEvaluator.IsSetCompatible Value=',Value.Kind,' ',dbgs(RangeValue));
4665     {$ENDIF}
4666     RaiseNotYetImplemented(20170714195815,ValueExpr);
4667   end;
4668 end;
4669 
IsConstnull4670 function TResExprEvaluator.IsConst(Expr: TPasExpr): boolean;
4671 var
4672   El: TPasElement;
4673   C: TClass;
4674 begin
4675   El:=Expr;
4676   while El<>nil do
4677     begin
4678     C:=El.ClassType;
4679     if C.InheritsFrom(TPasProcedure) then exit(true);
4680     if C.InheritsFrom(TPasImplBlock) then exit(false);
4681     El:=El.Parent;
4682     end;
4683   Result:=true;
4684 end;
4685 
IsSimpleExprnull4686 function TResExprEvaluator.IsSimpleExpr(Expr: TPasExpr): boolean;
4687 var
4688   C: TClass;
4689 begin
4690   C:=Expr.ClassType;
4691   Result:=(C=TNilExpr)
4692        or (C=TBoolConstExpr)
4693        or (C=TPrimitiveExpr);
4694 end;
4695 
4696 procedure TResExprEvaluator.EmitRangeCheckConst(id: TMaxPrecInt; const aValue,
4697   MinVal, MaxVal: String; PosEl: TPasElement; MsgType: TMessageType);
4698 begin
4699   if Assigned(OnRangeCheckEl) then
4700     OnRangeCheckEl(Self,PosEl,MsgType);
4701   LogMsg(id,MsgType,nRangeCheckEvaluatingConstantsVMinMax,
4702     sRangeCheckEvaluatingConstantsVMinMax,[aValue,MinVal,MaxVal],PosEl);
4703 end;
4704 
4705 procedure TResExprEvaluator.EmitRangeCheckConst(id: TMaxPrecInt;
4706   const aValue: String; MinVal, MaxVal: TMaxPrecInt; PosEl: TPasElement;
4707   MsgType: TMessageType);
4708 begin
4709   EmitRangeCheckConst(id,aValue,IntToStr(MinVal),IntToStr(MaxVal),PosEl,MsgType);
4710 end;
4711 
TResExprEvaluator.ChrValuenull4712 function TResExprEvaluator.ChrValue(Value: TResEvalValue; ErrorEl: TPasElement
4713   ): TResEvalValue;
4714 var
4715   Int: TMaxPrecInt;
4716 begin
4717   Result:=nil;
4718   case Value.Kind of
4719     revkInt,revkUInt:
4720       begin
4721       if Value.Kind=revkUInt then
4722         begin
4723         if TResEvalUInt(Value).UInt>$ffff then
4724           EmitRangeCheckConst(20170711195605,Value.AsString,0,$ffff,ErrorEl,mtError)
4725         else
4726           Int:=TResEvalUInt(Value).UInt;
4727         end
4728       else
4729         Int:=TResEvalInt(Value).Int;
4730       if (Int<0) or (Int>$ffff) then
4731         EmitRangeCheckConst(20170711195747,Value.AsString,0,$ffff,ErrorEl,mtError);
4732       {$ifdef FPC_HAS_CPSTRING}
4733       if Int<=$ff then
4734         Result:=TResEvalString.CreateValue(chr(Int))
4735       else
4736       {$endif}
4737         Result:=TResEvalUTF16.CreateValue(WideChar(Int))
4738       end;
4739   else
4740     {$IFDEF VerbosePasResEval}
4741     writeln('TResExprEvaluator.ChrValue ',Value.AsDebugString);
4742     {$ENDIF}
4743     RaiseNotYetImplemented(20170711195440,ErrorEl);
4744   end;
4745 end;
4746 
OrdValuenull4747 function TResExprEvaluator.OrdValue(Value: TResEvalValue; ErrorEl: TPasElement
4748   ): TResEvalValue;
4749 var
4750   v: longword;
4751 begin
4752   Result:=nil;
4753   v:=0;
4754   case Value.Kind of
4755     revkBool:
4756       if TResEvalBool(Value).B then
4757         v:=1
4758       else
4759         v:=0;
4760     revkInt,revkUInt:
4761       exit(Value);
4762     {$ifdef FPC_HAS_CPSTRING}
4763     revkString,
4764     {$endif}
4765     revkUnicodeString:
4766       v:=StringToOrd(Value,ErrorEl);
4767     revkEnum:
4768       v:=TResEvalEnum(Value).Index;
4769   else
4770     {$IFDEF VerbosePasResEval}
4771     writeln('TResExprEvaluator.OrdValue ',Value.AsDebugString);
4772     {$ENDIF}
4773     RaiseNotYetImplemented(20170624155932,ErrorEl);
4774   end;
4775   if v>$ffff then exit;
4776   Result:=TResEvalInt.CreateValue(v);
4777 end;
4778 
4779 procedure TResExprEvaluator.PredValue(Value: TResEvalValue; ErrorEl: TPasElement
4780   );
4781 begin
4782   case Value.Kind of
4783     revkBool:
4784       PredBool(TResEvalBool(Value),ErrorEl);
4785     revkInt:
4786       PredInt(TResEvalInt(Value),ErrorEl);
4787     revkUInt:
4788       PredUInt(TResEvalUInt(Value),ErrorEl);
4789     {$ifdef FPC_HAS_CPSTRING}
4790     revkString:
4791       PredString(TResEvalString(Value),ErrorEl);
4792     {$endif}
4793     revkUnicodeString:
4794       PredUnicodeString(TResEvalUTF16(Value),ErrorEl);
4795     revkEnum:
4796       PredEnum(TResEvalEnum(Value),ErrorEl);
4797   else
4798     {$IFDEF VerbosePasResEval}
4799     writeln('TResExprEvaluator.PredValue ',Value.AsDebugString);
4800     {$ENDIF}
4801     ReleaseEvalValue(Value);
4802     RaiseNotYetImplemented(20170624135738,ErrorEl);
4803   end;
4804 end;
4805 
4806 procedure TResExprEvaluator.SuccValue(Value: TResEvalValue; ErrorEl: TPasElement
4807   );
4808 begin
4809   case Value.Kind of
4810     revkBool:
4811       SuccBool(TResEvalBool(Value),ErrorEl);
4812     revkInt:
4813       SuccInt(TResEvalInt(Value),ErrorEl);
4814     revkUInt:
4815       SuccUInt(TResEvalUInt(Value),ErrorEl);
4816     {$ifdef FPC_HAS_CPSTRING}
4817     revkString:
4818       SuccString(TResEvalString(Value),ErrorEl);
4819     {$endif}
4820     revkUnicodeString:
4821       SuccUnicodeString(TResEvalUTF16(Value),ErrorEl);
4822     revkEnum:
4823       SuccEnum(TResEvalEnum(Value),ErrorEl);
4824   else
4825     {$IFDEF VerbosePasResEval}
4826     writeln('TResExprEvaluator.SuccValue ',Value.AsDebugString);
4827     {$ENDIF}
4828     ReleaseEvalValue(Value);
4829     RaiseNotYetImplemented(20170624151252,ErrorEl);
4830   end;
4831 end;
4832 
EvalStrFuncnull4833 function TResExprEvaluator.EvalStrFunc(Params: TParamsExpr; Flags: TResEvalFlags
4834   ): TResEvalValue;
4835 var
4836   AllConst: Boolean;
4837 
EvalFormatnull4838   function EvalFormat(Expr: TPasExpr; MinVal, MaxVal: TMaxPrecInt): TMaxPrecInt;
4839   var
4840     Value: TResEvalValue;
4841   begin
4842     Value:=Eval(Expr,Flags);
4843     if Value=nil then
4844       begin
4845       AllConst:=false;
4846       exit(-1);
4847       end;
4848     if Value.Kind<>revkInt then
4849       RaiseNotYetImplemented(20170717144010,Expr);
4850     Result:=TResEvalInt(Value).Int;
4851     if (Result<MinVal) or (Result>MaxVal) then
4852       EmitRangeCheckConst(20170717144609,IntToStr(Result),MinVal,MaxVal,Expr,mtError);
4853   end;
4854 
4855 var
4856   i: Integer;
4857   Param: TPasExpr;
4858   S, ValStr: String;
4859   Value: TResEvalValue;
4860   Format1, Format2: TMaxPrecInt;
4861 begin
4862   Result:=nil;
4863   Value:=nil;
4864   AllConst:=true;
4865   S:='';
4866   for i:=0 to length(Params.Params)-1 do
4867     begin
4868     Param:=Params.Params[i];
4869     {$IFDEF VerbosePasResEval}
4870     writeln('TPasResolver.BI_StrFunc_OnEval i=',i,' of ',length(Params.Params),' Param=',GetObjName(Param));
4871     {$ENDIF}
4872     Value:=Eval(Param,Flags);
4873     if Value=nil then
4874       begin
4875       AllConst:=false;
4876       continue;
4877       end;
4878     Format1:=-1;
4879     Format2:=-1;
4880     try
4881       ValStr:='';
4882       if Param.format1<>nil then
4883         begin
4884         Format1:=EvalFormat(Param.format1,1,255);
4885         if Format1<0 then
4886           continue;
4887         if Param.format2<>nil then
4888           begin
4889           Format2:=EvalFormat(Param.format2,0,255);
4890           if Format2<0 then
4891             continue;
4892           end;
4893         end;
4894       case Value.Kind of
4895       revkBool:
4896         if Format1<0 then
4897           str(TResEvalBool(Value).B,ValStr)
4898         else
4899           str(TResEvalBool(Value).B:Format1,ValStr);
4900       revkInt:
4901         if Format1<0 then
4902           str(TResEvalInt(Value).Int,ValStr)
4903         else
4904           str(TResEvalInt(Value).Int:Format1,ValStr);
4905       revkUInt:
4906         if Format1<0 then
4907           str(TResEvalUInt(Value).UInt,ValStr)
4908         else
4909           str(TResEvalUInt(Value).UInt:Format1,ValStr);
4910       revkFloat:
4911         if Format1<0 then
4912           str(TResEvalFloat(Value).FloatValue,ValStr)
4913         else if Format2<0 then
4914           str(TResEvalFloat(Value).FloatValue:Format1,ValStr)
4915         else
4916           str(TResEvalFloat(Value).FloatValue:Format1:Format2,ValStr);
4917       revkCurrency:
4918         if Format1<0 then
4919           str(TResEvalCurrency(Value).Value,ValStr)
4920         else if Format2<0 then
4921           str(TResEvalCurrency(Value).Value:Format1,ValStr)
4922         else
4923           str(TResEvalCurrency(Value).Value:Format1:Format2,ValStr);
4924       revkEnum:
4925         begin
4926         ValStr:=TResEvalEnum(Value).AsString;
4927         if Format1>0 then
4928           ValStr:=StringOfChar(' ',Format1)+ValStr;
4929         end;
4930       else
4931         AllConst:=false;
4932         continue;
4933       end;
4934     finally
4935       ReleaseEvalValue(Value);
4936       ReleaseEvalValue(Value);
4937       ReleaseEvalValue(Value);
4938     end;
4939     S:=S+ValStr;
4940   end;
4941   if AllConst then
4942     {$ifdef FPC_HAS_CPSTRING}
4943     Result:=TResEvalString.CreateValue(S);
4944     {$else}
4945     Result:=TResEvalUTF16.CreateValue(S);
4946     {$endif}
4947 end;
4948 
EvalStringAddExprnull4949 function TResExprEvaluator.EvalStringAddExpr(Expr, LeftExpr,
4950   RightExpr: TPasExpr; LeftValue, RightValue: TResEvalValue): TResEvalValue;
4951 {$ifdef FPC_HAS_CPSTRING}
4952 var
4953   LeftCP, RightCP: TSystemCodePage;
4954 {$endif}
4955 begin
4956   case LeftValue.Kind of
4957   {$ifdef FPC_HAS_CPSTRING}
4958   revkString:
4959     case RightValue.Kind of
4960     revkString:
4961       begin
4962       LeftCP:=GetCodePage(TResEvalString(LeftValue).S);
4963       RightCP:=GetCodePage(TResEvalString(RightValue).S);
4964       if (LeftCP=RightCP) then
4965         begin
4966         Result:=TResEvalString.Create;
4967         TResEvalString(Result).S:=TResEvalString(LeftValue).S+TResEvalString(RightValue).S;
4968         end
4969       else
4970         begin
4971         Result:=TResEvalUTF16.Create;
4972         TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
4973                                 +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
4974         end;
4975       end;
4976     revkUnicodeString:
4977       begin
4978       Result:=TResEvalUTF16.Create;
4979       TResEvalUTF16(Result).S:=GetUnicodeStr(TResEvalString(LeftValue).S,LeftExpr)
4980                               +TResEvalUTF16(RightValue).S;
4981       end;
4982     else
4983       {$IFDEF VerbosePasResolver}
4984       writeln('TResExprEvaluator.EvalBinaryAddExpr string+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
4985       {$ENDIF}
4986       RaiseNotYetImplemented(20170601141834,Expr);
4987     end;
4988   {$endif}
4989   revkUnicodeString:
4990     case RightValue.Kind of
4991     {$ifdef FPC_HAS_CPSTRING}
4992     revkString:
4993       begin
4994       Result:=TResEvalUTF16.Create;
4995       TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S
4996                               +GetUnicodeStr(TResEvalString(RightValue).S,RightExpr);
4997       end;
4998     {$endif}
4999     revkUnicodeString:
5000       begin
5001       Result:=TResEvalUTF16.Create;
5002       TResEvalUTF16(Result).S:=TResEvalUTF16(LeftValue).S+TResEvalUTF16(RightValue).S;
5003       end;
5004     else
5005       {$IFDEF VerbosePasResolver}
5006       writeln('TResExprEvaluator.EvalBinaryAddExpr utf16+? Left=',LeftValue.AsDebugString,' Right=',RightValue.AsDebugString);
5007       {$ENDIF}
5008       RaiseNotYetImplemented(20170601141811,Expr);
5009     end;
5010   else
5011     {$ifndef FPC_HAS_CPSTRING}
5012     if LeftExpr=nil then ; // no Parameter "LeftExpr" not used
5013     if RightExpr=nil then ; // no Parameter "RightExpr" not used
5014     {$endif}
5015     RaiseNotYetImplemented(20181219233139,Expr);
5016   end;
5017 end;
5018 
TResExprEvaluator.LoHiValuenull5019 function TResExprEvaluator.LoHiValue(Value: TResEvalValue; ShiftSize: Integer;
5020   Mask: LongWord; ErrorEl: TPasElement): TResEvalValue;
5021 var
5022   uint: LongWord;
5023 begin
5024   case Value.Kind of
5025     revkInt:
5026       {$IFDEF Pas2js}
5027       if ShiftSize=32 then
5028         uint := longword(TResEvalInt(Value).Int div $100000000)
5029       else
5030       {$ENDIF}
5031         uint := (TResEvalInt(Value).Int shr ShiftSize) and Mask;
5032     revkUInt:
5033       {$IFDEF Pas2js}
5034       if ShiftSize=32 then
5035         uint := longword(TResEvalUInt(Value).UInt div $100000000)
5036       else
5037       {$ENDIF}
5038         uint := (TResEvalUInt(Value).UInt shr ShiftSize) and Mask;
5039   else
5040     {$IFDEF VerbosePasResEval}
5041     writeln('TResExprEvaluator.LoHiValue ',Value.AsDebugString);
5042     {$ENDIF}
5043     RaiseNotYetImplemented(20190129012100,ErrorEl);
5044   end;
5045   Result := TResEvalInt.CreateValue(uint);
5046 end;
5047 
TResExprEvaluator.EnumTypeCastnull5048 function TResExprEvaluator.EnumTypeCast(EnumType: TPasEnumType; Expr: TPasExpr;
5049   Flags: TResEvalFlags): TResEvalEnum;
5050 var
5051   Value: TResEvalValue;
5052   MaxIndex, Index: Integer;
5053 begin
5054   Result:=nil;
5055   Value:=Eval(Expr,Flags);
5056   if Value=nil then exit;
5057   try
5058     MaxIndex:=EnumType.Values.Count-1;
5059     case Value.Kind of
5060     revkInt:
5061       if TResEvalInt(Value).Int>High(Index) then
5062         EmitRangeCheckConst(20170713105944,
5063           IntToStr(TResEvalInt(Value).Int),'0',IntToStr(MaxIndex),Expr,mtError)
5064       else
5065         Index:=TResEvalInt(Value).Int;
5066     revkUInt:
5067       if TResEvalUInt(Value).UInt>MaxIndex then
5068         EmitRangeCheckConst(20170713105944,
5069           IntToStr(TResEvalUInt(Value).UInt),'0',IntToStr(MaxIndex),Expr,mtError)
5070       else
5071         Index:=TResEvalUInt(Value).UInt;
5072     else
5073       RaiseNotYetImplemented(20170713105625,Expr);
5074     end;
5075     if (Index<0) or (Index>MaxIndex) then
5076       EmitRangeCheckConst(20170713110232,
5077         IntToStr(Index),'0',IntToStr(MaxIndex),Expr,mtError);
5078     Result:=TResEvalEnum.CreateValue(Index,TPasEnumValue(EnumType.Values[Index]));
5079   finally
5080     ReleaseEvalValue(Value);
5081   end;
5082 end;
5083 
5084 {$ifdef FPC_HAS_CPSTRING}
CheckValidUTF8null5085 function TResExprEvaluator.CheckValidUTF8(const s: RawByteString;
5086   ErrorEl: TPasElement): boolean;
5087 var
5088   p, EndP: PChar;
5089   l: SizeInt;
5090 begin
5091   p:=PChar(s);
5092   EndP:=p+length(s);
5093   while p<EndP do
5094     begin
5095     l:=Utf8CodePointLen(p,EndP-p,false);
5096     if l<=0 then
5097       if ErrorEl<>nil then
5098         RaiseMsg(20170711211841,nIllegalChar,sIllegalChar,[],ErrorEl)
5099       else
5100         exit(false);
5101     inc(p,l);
5102     end;
5103   Result:=true;
5104 end;
5105 
GetCodePagenull5106 function TResExprEvaluator.GetCodePage(const s: RawByteString): TSystemCodePage;
5107 begin
5108   if s='' then exit(DefaultStringCodePage);
5109   Result:=StringCodePage(s);
5110   if (Result=CP_ACP) or (Result=CP_NONE) then
5111     begin
5112     Result:=DefaultStringCodePage;
5113     if (Result=CP_ACP) or (Result=CP_NONE) then
5114       begin
5115       Result:=System.DefaultSystemCodePage;
5116       if Result=CP_NONE then
5117         Result:=CP_ACP;
5118       end;
5119     end;
5120 end;
5121 
GetRawByteStringnull5122 function TResExprEvaluator.GetRawByteString(const s: UnicodeString;
5123   CodePage: TSystemCodePage; ErrorEl: TPasElement): RawByteString;
5124 var
5125   ok: Boolean;
5126 begin
5127   Result:=UTF8Encode(s);
5128   if (CodePage=CP_UTF8)
5129       or ((DefaultSystemCodePage=CP_UTF8) and ((CodePage=CP_ACP) or (CodePage=CP_NONE))) then
5130     begin
5131     // to UTF-8
5132     SetCodePage(Result,CodePage,false);
5133     end
5134   else
5135     begin
5136     // to non UTF-8 -> possible loss
5137     ok:=false;
5138     try
5139       SetCodePage(Result,CodePage,true);
5140       ok:=true;
5141     except
5142     end;
5143     if (not ok) or (GetUnicodeStr(Result,ErrorEl)<>s) then
5144       LogMsg(20190204165110,mtWarning,nImplictConversionUnicodeToAnsi,
5145         sImplictConversionUnicodeToAnsi,[],ErrorEl);
5146     end;
5147 end;
5148 
GetUTF8Strnull5149 function TResExprEvaluator.GetUTF8Str(const s: RawByteString;
5150   ErrorEl: TPasElement): String;
5151 var
5152   CP: TSystemCodePage;
5153 begin
5154   if s='' then exit('');
5155   CP:=GetCodePage(s);
5156   if CP=CP_UTF8 then
5157     begin
5158     if ErrorEl<>nil then
5159       CheckValidUTF8(s,ErrorEl);
5160     Result:=s;
5161     end
5162   else
5163     // use default conversion
5164     Result:=UTF8Encode(UnicodeString(s));
5165 end;
5166 
TResExprEvaluator.GetUnicodeStrnull5167 function TResExprEvaluator.GetUnicodeStr(const s: RawByteString;
5168   ErrorEl: TPasElement): UnicodeString;
5169 var
5170   CP: TSystemCodePage;
5171 begin
5172   if s='' then exit('');
5173   CP:=GetCodePage(s);
5174   if CP=CP_UTF8 then
5175     begin
5176     if ErrorEl<>nil then
5177       CheckValidUTF8(s,ErrorEl);
5178     Result:=UTF8Decode(s);
5179     end
5180   else
5181     // use default conversion
5182     Result:=UnicodeString(s);
5183 end;
5184 
TResExprEvaluator.GetWideCharnull5185 function TResExprEvaluator.GetWideChar(const s: RawByteString; out w: WideChar
5186   ): boolean;
5187 var
5188   CP: TSystemCodePage;
5189   u: UnicodeString;
5190 begin
5191   w:=#0;
5192   Result:=false;
5193   if s='' then exit;
5194   CP:=GetCodePage(s);
5195   if CP=CP_UTF8 then
5196     begin
5197     if length(s)>4 then exit;
5198     u:=UTF8Decode(s);
5199     if length(u)<>1 then exit;
5200     w:=u[1];
5201     Result:=true;
5202     end
5203   else if length(s)=1 then
5204     begin
5205     w:=s[1];
5206     Result:=true;
5207     end;
5208 end;
5209 {$endif}
5210 
5211 procedure TResExprEvaluator.PredBool(Value: TResEvalBool; ErrorEl: TPasElement);
5212 begin
5213   if Value.B=false then
5214     EmitRangeCheckConst(20170624140251,Value.AsString,
5215       'true','true',ErrorEl);
5216   Value.B:=not Value.B;
5217 end;
5218 
5219 procedure TResExprEvaluator.SuccBool(Value: TResEvalBool; ErrorEl: TPasElement);
5220 begin
5221   if Value.B=true then
5222     EmitRangeCheckConst(20170624142316,Value.AsString,
5223       'false','false',ErrorEl);
5224   Value.B:=not Value.B;
5225 end;
5226 
5227 procedure TResExprEvaluator.PredInt(Value: TResEvalInt; ErrorEl: TPasElement);
5228 begin
5229   if Value.Int=low(TMaxPrecInt) then
5230     begin
5231     EmitRangeCheckConst(20170624142511,IntToStr(Value.Int),
5232       IntToStr(succ(low(TMaxPrecInt))),IntToStr(high(TMaxPrecInt)),ErrorEl);
5233     Value.Int:=high(Value.Int);
5234     end
5235   else
5236     dec(Value.Int);
5237 end;
5238 
5239 procedure TResExprEvaluator.SuccInt(Value: TResEvalInt; ErrorEl: TPasElement);
5240 begin
5241   if Value.Int=high(TMaxPrecInt) then
5242     begin
5243     EmitRangeCheckConst(20170624142920,IntToStr(Value.Int),
5244       IntToStr(low(TMaxPrecInt)),IntToStr(pred(high(TMaxPrecInt))),ErrorEl);
5245     Value.Int:=low(Value.Int);
5246     end
5247   else
5248     inc(Value.Int);
5249 end;
5250 
5251 procedure TResExprEvaluator.PredUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
5252 begin
5253   if Value.UInt=low(TMaxPrecUInt) then
5254     begin
5255     EmitRangeCheckConst(20170624143122,IntToStr(Value.UInt),
5256       IntToStr(succ(low(TMaxPrecUInt))),IntToStr(high(TMaxPrecUInt)),ErrorEl);
5257     Value.UInt:=high(Value.UInt);
5258     end
5259   else
5260     dec(Value.UInt);
5261 end;
5262 
5263 procedure TResExprEvaluator.SuccUInt(Value: TResEvalUInt; ErrorEl: TPasElement);
5264 begin
5265   // Note: when FPC compares int64 with qword it converts the qword to an int64
5266   if Value.UInt=HighIntAsUInt then
5267     begin
5268     EmitRangeCheckConst(20170624142921,IntToStr(Value.UInt),
5269       IntToStr(low(TMaxPrecUInt)),IntToStr(pred(high(TMaxPrecUInt))),ErrorEl);
5270     Value.UInt:=low(Value.UInt);
5271     end
5272   else
5273     inc(Value.UInt);
5274 end;
5275 
5276 {$ifdef FPC_HAS_CPSTRING}
5277 procedure TResExprEvaluator.PredString(Value: TResEvalString;
5278   ErrorEl: TPasElement);
5279 begin
5280   if length(Value.S)<>1 then
5281     RaiseRangeCheck(20170624150138,ErrorEl);
5282   if Value.S[1]=#0 then
5283     begin
5284     EmitRangeCheckConst(20170624150220,Value.AsString,'#1','#255',ErrorEl);
5285     Value.S:=#255;
5286     end
5287   else
5288     Value.S:=pred(Value.S[1]);
5289 end;
5290 
5291 procedure TResExprEvaluator.SuccString(Value: TResEvalString;
5292   ErrorEl: TPasElement);
5293 begin
5294   if length(Value.S)<>1 then
5295     RaiseRangeCheck(20170624150432,ErrorEl);
5296   if Value.S[1]=#255 then
5297     begin
5298     EmitRangeCheckConst(20170624150441,Value.AsString,'#0','#254',ErrorEl);
5299     Value.S:=#0;
5300     end
5301   else
5302     Value.S:=succ(Value.S[1]);
5303 end;
5304 {$endif}
5305 
5306 procedure TResExprEvaluator.PredUnicodeString(Value: TResEvalUTF16;
5307   ErrorEl: TPasElement);
5308 begin
5309   if length(Value.S)<>1 then
5310     RaiseRangeCheck(20170624150703,ErrorEl);
5311   if Value.S[1]=#0 then
5312     begin
5313     EmitRangeCheckConst(20170624150710,Value.AsString,'#1','#65535',ErrorEl);
5314     Value.S:=WideChar(#65535);
5315     end
5316   else
5317     Value.S:=pred(Value.S[1]);
5318 end;
5319 
5320 procedure TResExprEvaluator.SuccUnicodeString(Value: TResEvalUTF16;
5321   ErrorEl: TPasElement);
5322 begin
5323   if length(Value.S)<>1 then
5324     RaiseRangeCheck(20170624150849,ErrorEl);
5325   if Value.S[1]=#65535 then
5326     begin
5327     EmitRangeCheckConst(20170624150910,Value.AsString,'#0','#65534',ErrorEl);
5328     Value.S:=#0;
5329     end
5330   else
5331     Value.S:=succ(Value.S[1]);
5332 end;
5333 
5334 procedure TResExprEvaluator.PredEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
5335 var
5336   EnumType: TPasEnumType;
5337 begin
5338   EnumType:=Value.ElType as TPasEnumType;
5339   if EnumType=nil then
5340     RaiseInternalError(20170821174038,dbgs(Value));
5341   if Value.Index<=0 then
5342     begin
5343     EmitRangeCheckConst(20170624144332,Value.AsString,
5344       TPasEnumValue(EnumType.Values[Min(1,EnumType.Values.Count-1)]).Name,
5345       TPasEnumValue(EnumType.Values[EnumType.Values.Count-1]).Name,ErrorEl);
5346     Value.Index:=EnumType.Values.Count-1;
5347     end
5348   else
5349     dec(Value.Index);
5350   Value.IdentEl:=TPasEnumValue(EnumType.Values[Value.Index]);
5351 end;
5352 
5353 procedure TResExprEvaluator.SuccEnum(Value: TResEvalEnum; ErrorEl: TPasElement);
5354 var
5355   EnumType: TPasEnumType;
5356 begin
5357   EnumType:=Value.ElType as TPasEnumType;
5358   if EnumType=nil then
5359     RaiseInternalError(20170821174058,dbgs(Value));
5360   if Value.Index>=EnumType.Values.Count-1 then
5361     begin
5362     EmitRangeCheckConst(20170624145013,Value.AsString,
5363       TPasEnumValue(EnumType.Values[0]).Name,
5364       TPasEnumValue(EnumType.Values[Max(0,EnumType.Values.Count-2)]).Name,ErrorEl);
5365     Value.Index:=0;
5366     end
5367   else
5368     inc(Value.Index);
5369   Value.IdentEl:=TPasEnumValue(EnumType.Values[Value.Index]);
5370 end;
5371 
5372 { TResolveData }
5373 
5374 procedure TResolveData.SetElement(AValue: TPasElement);
5375 begin
5376   if FElement=AValue then Exit;
5377   if Element<>nil then
5378     Element.Release{$IFDEF CheckPasTreeRefCount}(ClassName+'.SetElement'){$ENDIF};
5379   FElement:=AValue;
5380   if Element<>nil then
5381     Element.AddRef{$IFDEF CheckPasTreeRefCount}(ClassName+'.SetElement'){$ENDIF};
5382 end;
5383 
5384 constructor TResolveData.Create;
5385 begin
5386 
5387 end;
5388 
5389 destructor TResolveData.Destroy;
5390 begin
5391   {$IFDEF VerbosePasResolverMem}
5392   writeln('TResolveData.Destroy START ',ClassName);
5393   {$ENDIF}
5394   Element:=nil;
5395   Owner:=nil;
5396   Next:=nil;
5397   inherited Destroy;
5398   {$IFDEF VerbosePasResolverMem}
5399   writeln('TResolveData.Destroy END ',ClassName);
5400   {$ENDIF}
5401 end;
5402 
5403 { TResEvalValue }
5404 
5405 constructor TResEvalValue.CreateKind(const aKind: TREVKind);
5406 begin
5407   Create;
5408   Kind:=aKind;
5409 end;
5410 
TResEvalValue.Clonenull5411 function TResEvalValue.Clone: TResEvalValue;
5412 begin
5413   Result:=TResEvalValueClass(ClassType).Create;
5414   Result.Kind:=Kind;
5415   Result.IdentEl:=IdentEl;
5416 end;
5417 
AsDebugStringnull5418 function TResEvalValue.AsDebugString: string;
5419 begin
5420   str(Kind,Result);
5421   Result:=Result+'='+AsString;
5422 end;
5423 
AsStringnull5424 function TResEvalValue.AsString: string;
5425 begin
5426   case Kind of
5427     revkNone: Result:='<None>';
5428     revkNil: Result:='nil';
5429   else
5430     str(Kind,Result);
5431   end;
5432 end;
5433 
5434 { TResEvalUInt }
5435 
5436 constructor TResEvalUInt.Create;
5437 begin
5438   inherited Create;
5439   Kind:=revkUInt;
5440 end;
5441 
5442 constructor TResEvalUInt.CreateValue(const aValue: TMaxPrecUInt);
5443 begin
5444   Create;
5445   UInt:=aValue;
5446 end;
5447 
TResEvalUInt.Clonenull5448 function TResEvalUInt.Clone: TResEvalValue;
5449 begin
5450   Result:=inherited Clone;
5451   TResEvalUInt(Result).UInt:=UInt;
5452 end;
5453 
AsStringnull5454 function TResEvalUInt.AsString: string;
5455 begin
5456   Result:=IntToStr(UInt);
5457 end;
5458 
5459 { TResEvalInt }
5460 
5461 constructor TResEvalInt.Create;
5462 begin
5463   inherited Create;
5464   Kind:=revkInt;
5465 end;
5466 
5467 constructor TResEvalInt.CreateValue(const aValue: TMaxPrecInt);
5468 begin
5469   Create;
5470   Int:=aValue;
5471 end;
5472 
5473 constructor TResEvalInt.CreateValue(const aValue: TMaxPrecInt; aTyped: TResEvalTypedInt
5474   );
5475 begin
5476   Create;
5477   Int:=aValue;
5478   Typed:=aTyped;
5479 end;
5480 
TResEvalInt.Clonenull5481 function TResEvalInt.Clone: TResEvalValue;
5482 begin
5483   Result:=inherited Clone;
5484   TResEvalInt(Result).Int:=Int;
5485   TResEvalInt(Result).Typed:=Typed;
5486 end;
5487 
AsStringnull5488 function TResEvalInt.AsString: string;
5489 begin
5490   Result:=IntToStr(Int);
5491 end;
5492 
AsDebugStringnull5493 function TResEvalInt.AsDebugString: string;
5494 begin
5495   if Typed=reitNone then
5496     Result:=inherited AsDebugString
5497   else
5498     begin
5499     str(Kind,Result);
5500     case Typed of
5501       reitByte: Result:=Result+':byte';
5502       reitShortInt: Result:=Result+':shortint';
5503       reitWord: Result:=Result+':word';
5504       reitSmallInt: Result:=Result+':smallint';
5505       reitUIntSingle: Result:=Result+':uintsingle';
5506       reitIntSingle: Result:=Result+':intsingle';
5507       reitLongWord: Result:=Result+':longword';
5508       reitLongInt: Result:=Result+':longint';
5509       reitUIntDouble: Result:=Result+':uintdouble';
5510       reitIntDouble: Result:=Result+':intdouble';
5511     end;
5512     Result:=Result+'='+AsString;
5513     end;
5514 end;
5515 
5516 { TResEvalFloat }
5517 
5518 constructor TResEvalFloat.Create;
5519 begin
5520   inherited Create;
5521   Kind:=revkFloat;
5522 end;
5523 
5524 constructor TResEvalFloat.CreateValue(const aValue: TMaxPrecFloat);
5525 begin
5526   Create;
5527   FloatValue:=aValue;
5528 end;
5529 
TResEvalFloat.Clonenull5530 function TResEvalFloat.Clone: TResEvalValue;
5531 begin
5532   Result:=inherited Clone;
5533   TResEvalFloat(Result).FloatValue:=FloatValue;
5534 end;
5535 
AsStringnull5536 function TResEvalFloat.AsString: string;
5537 begin
5538   str(FloatValue,Result);
5539 end;
5540 
TResEvalFloat.IsIntnull5541 function TResEvalFloat.IsInt(out Int: TMaxPrecInt): boolean;
5542 begin
5543   Int:=0;
5544   if Frac(FloatValue)<>0 then exit(false);
5545   if FloatValue<TMaxPrecFloat(low(TMaxPrecInt)) then exit(false);
5546   if FloatValue>TMaxPrecFloat(high(TMaxPrecInt)) then exit(false);
5547   Int:=Trunc(FloatValue);
5548   Result:=true;
5549 end;
5550 
5551 {$ifdef FPC_HAS_CPSTRING}
5552 { TResEvalString }
5553 
5554 constructor TResEvalString.Create;
5555 begin
5556   inherited Create;
5557   Kind:=revkString;
5558 end;
5559 
5560 constructor TResEvalString.CreateValue(const aValue: RawByteString);
5561 begin
5562   Create;
5563   S:=aValue;
5564 end;
5565 
TResEvalString.Clonenull5566 function TResEvalString.Clone: TResEvalValue;
5567 begin
5568   Result:=inherited Clone;
5569   TResEvalString(Result).S:=S;
5570 end;
5571 
AsStringnull5572 function TResEvalString.AsString: string;
5573 begin
5574   Result:=RawStrToCaption(S,60);
5575 end;
5576 {$endif}
5577 
5578 { TResEvalUTF16 }
5579 
5580 constructor TResEvalUTF16.Create;
5581 begin
5582   inherited Create;
5583   Kind:=revkUnicodeString;
5584 end;
5585 
5586 constructor TResEvalUTF16.CreateValue(const aValue: UnicodeString);
5587 begin
5588   Create;
5589   S:=aValue;
5590 end;
5591 
TResEvalUTF16.Clonenull5592 function TResEvalUTF16.Clone: TResEvalValue;
5593 begin
5594   Result:=inherited Clone;
5595   TResEvalUTF16(Result).S:=S;
5596 end;
5597 
AsStringnull5598 function TResEvalUTF16.AsString: string;
5599 begin
5600   Result:=String(UnicodeStrToCaption(S,60));
5601 end;
5602 
5603 { TResEvalEnum }
5604 
5605 constructor TResEvalEnum.Create;
5606 begin
5607   inherited Create;
5608   Kind:=revkEnum;
5609 end;
5610 
5611 constructor TResEvalEnum.CreateValue(const aValue: integer;
5612   aIdentEl: TPasEnumValue);
5613 begin
5614   Create;
5615   Index:=aValue;
5616   IdentEl:=aIdentEl;
5617   ElType:=IdentEl.Parent as TPasEnumType;
5618   if ElType=nil then
5619     raise Exception.Create('');
5620 end;
5621 
TResEvalEnum.GetEnumValuenull5622 function TResEvalEnum.GetEnumValue: TPasEnumValue;
5623 begin
5624   Result:=nil;
5625   if ElType<>nil then
5626     if (Index>=0) and (Index<ElType.Values.Count) then
5627       Result:=TObject(ElType.Values[Index]) as TPasEnumValue;
5628 end;
5629 
GetEnumNamenull5630 function TResEvalEnum.GetEnumName: String;
5631 var
5632   V: TPasEnumValue;
5633 begin
5634   V:=GetEnumValue;
5635   if V<>nil then
5636     Result:=V.Name
5637   else
5638     Result:='';
5639 end;
5640 
TResEvalEnum.Clonenull5641 function TResEvalEnum.Clone: TResEvalValue;
5642 begin
5643   Result:=inherited Clone;
5644   TResEvalEnum(Result).Index:=Index;
5645   TResEvalEnum(Result).ElType:=ElType;
5646 end;
5647 
AsDebugStringnull5648 function TResEvalEnum.AsDebugString: string;
5649 begin
5650   str(Kind,Result);
5651   Result:=Result+'='+AsString+'='+IntToStr(Index);
5652 end;
5653 
AsStringnull5654 function TResEvalEnum.AsString: string;
5655 begin
5656   if IdentEl<>nil then
5657     begin
5658     Result:=IdentEl.Name;
5659     if Result<>'' then exit;
5660     end;
5661   Result:=GetEnumName;
5662   if Result<>'' then exit;
5663   Result:=ElType.Name+'('+IntToStr(Index)+')';
5664 end;
5665 
5666 { TResEvalRangeInt }
5667 
5668 constructor TResEvalRangeInt.Create;
5669 begin
5670   inherited Create;
5671   Kind:=revkRangeInt;
5672 end;
5673 
5674 constructor TResEvalRangeInt.CreateValue(const aElKind: TRESetElKind;
5675   aElType: TPasType; const aRangeStart, aRangeEnd: TMaxPrecInt);
5676 begin
5677   Create;
5678   ElKind:=aElKind;
5679   ElType:=aElType;
5680   RangeStart:=aRangeStart;
5681   RangeEnd:=aRangeEnd;
5682 end;
5683 
TResEvalRangeInt.Clonenull5684 function TResEvalRangeInt.Clone: TResEvalValue;
5685 begin
5686   Result:=inherited Clone;
5687   TResEvalRangeInt(Result).ElKind:=ElKind;
5688   TResEvalRangeInt(Result).RangeStart:=RangeStart;
5689   TResEvalRangeInt(Result).RangeEnd:=RangeEnd;
5690 end;
5691 
AsStringnull5692 function TResEvalRangeInt.AsString: string;
5693 begin
5694   Result:=ElementAsString(RangeStart)+'..'+ElementAsString(RangeEnd);
5695 end;
5696 
AsDebugStringnull5697 function TResEvalRangeInt.AsDebugString: string;
5698 var
5699   s: string;
5700 begin
5701   str(Kind,Result);
5702   str(ElKind,s);
5703   Result:=Result+'/'+s+':'+GetObjName(ElType)+'='+AsString;
5704 end;
5705 
ElementAsStringnull5706 function TResEvalRangeInt.ElementAsString(El: TMaxPrecInt): string;
5707 var
5708   EnumValue: TPasEnumValue;
5709   EnumType: TPasEnumType;
5710 begin
5711   case ElKind of
5712     revskBool:
5713       if El=0 then
5714         Result:='false'
5715       else
5716         Result:='true';
5717     revskEnum:
5718       begin
5719       EnumType:=ElType as TPasEnumType;
5720       if (El>=0) and (El<EnumType.Values.Count) then
5721         begin
5722         EnumValue:=TPasEnumValue(EnumType.Values[El]);
5723         Result:=EnumValue.Name;
5724         end
5725       else
5726         Result:=ElType.Name+'('+IntToStr(El)+')';
5727       end;
5728     revskInt: Result:=IntToStr(El);
5729     revskChar:
5730       if ((El>=32) and (El<=38)) or ((El>=40) and (El<=126)) then
5731         Result:=''''+Chr(El)+''''
5732       else
5733         Result:='#'+IntToStr(El);
5734   end;
5735 end;
5736 
5737 { TResEvalSet }
5738 
5739 constructor TResEvalSet.Create;
5740 begin
5741   inherited Create;
5742   Kind:=revkSetOfInt;
5743 end;
5744 
5745 constructor TResEvalSet.CreateEmpty(const aElKind: TRESetElKind;
5746   aElType: TPasType);
5747 begin
5748   Create;
5749   ElKind:=aElKind;
5750   ElType:=aElType;
5751 end;
5752 
5753 constructor TResEvalSet.CreateEmptySameKind(aSet: TResEvalSet);
5754 begin
5755   Create;
5756   IdentEl:=aSet.IdentEl;
5757   ElKind:=aSet.ElKind;
5758   ElType:=aSet.ElType;
5759 end;
5760 
5761 constructor TResEvalSet.CreateValue(const aElKind: TRESetElKind;
5762   aElType: TPasType; const aRangeStart, aRangeEnd: TMaxPrecInt);
5763 begin
5764   inherited CreateValue(aElKind, aElType, aRangeStart, aRangeEnd);
5765   Add(aRangeStart,aRangeEnd);
5766 end;
5767 
TResEvalSet.Clonenull5768 function TResEvalSet.Clone: TResEvalValue;
5769 var
5770   RS: TResEvalSet;
5771   i: Integer;
5772 begin
5773   Result:=inherited Clone;
5774   RS:=TResEvalSet(Result);
5775   RS.ElKind:=ElKind;
5776   RS.ElType:=ElType;
5777   SetLength(RS.Ranges,length(Ranges));
5778   for i:=0 to length(Ranges)-1 do
5779     RS.Ranges[i]:=Ranges[i];
5780 end;
5781 
AsStringnull5782 function TResEvalSet.AsString: string;
5783 var
5784   i: Integer;
5785 begin
5786   Result:='[';
5787   for i:=0 to length(Ranges)-1 do
5788     begin
5789     if i>0 then Result:=Result+',';
5790     Result:=Result+ElementAsString(Ranges[i].RangeStart);
5791     if Ranges[i].RangeStart<>Ranges[i].RangeEnd then
5792       Result:=Result+'..'+ElementAsString(Ranges[i].RangeEnd);
5793     end;
5794   Result:=Result+']';
5795 end;
5796 
Addnull5797 function TResEvalSet.Add(aRangeStart, aRangeEnd: TMaxPrecInt): boolean;
5798 
5799   {$IF FPC_FULLVERSION<30101}
5800   procedure Insert(const Item: TItem; var Items: TItems; Index: integer);
5801   var
5802     i: Integer;
5803   begin
5804     Setlength(Items,length(Items)+1);
5805     for i:=length(Items)-1 downto Index+1 do
5806       Items[i]:=Items[i-1];
5807     Items[Index]:=Item;
5808   end;
5809 
5810   procedure Delete(var Items: TItems; Start, Size: integer);
5811   var
5812     i: Integer;
5813   begin
5814     if Size=0 then exit;
5815     for i:=Start+Size to length(Items)-1 do
5816       Items[i-Size]:=Items[i];
5817     Setlength(Items,length(Items)-Size);
5818   end;
5819   {$ENDIF}
5820 
5821 var
5822   StartIndex, l, EndIndex: Integer;
5823   Item: TItem;
5824 begin
5825   Result:=false;
5826   {$IFDEF VerbosePasResEval}
5827   writeln('TResEvalSetInt.Add ',aRangeStart,'..',aRangeEnd);
5828   {$ENDIF}
5829   if aRangeStart>aRangeEnd then
5830     raise Exception.Create('');
5831   if ElKind=revskNone then
5832     raise Exception.Create('');
5833 
5834   l:=length(Ranges);
5835   if l=0 then
5836     begin
5837     // first range
5838     RangeStart:=aRangeStart;
5839     RangeEnd:=aRangeEnd;
5840     SetLength(Ranges,1);
5841     Ranges[0].RangeStart:=aRangeStart;
5842     Ranges[0].RangeEnd:=aRangeEnd;
5843     exit(true);
5844     end;
5845   if RangeStart>aRangeStart then
5846     RangeStart:=aRangeStart;
5847   if RangeEnd<aRangeEnd then
5848     RangeEnd:=aRangeEnd;
5849 
5850   // find insert position
5851   StartIndex:=IndexOfRange(aRangeStart,true);
5852   if (StartIndex>0) and (Ranges[StartIndex-1].RangeEnd=aRangeStart-1) then
5853     dec(StartIndex);
5854   if StartIndex=l then
5855     begin
5856     // add new range
5857     Item.RangeStart:=aRangeStart;
5858     Item.RangeEnd:=aRangeEnd;
5859     Insert(Item,Ranges,StartIndex);
5860     Result:=true;
5861     end
5862   else
5863     begin
5864     // StartIndex is now the first affected range
5865     EndIndex:=IndexOfRange(aRangeEnd,true);
5866     if (EndIndex>StartIndex) then
5867       if (EndIndex=l) or (Ranges[EndIndex].RangeStart>aRangeEnd+1) then
5868         dec(EndIndex);
5869     // EndIndex is now the last affected range
5870     if StartIndex>EndIndex then
5871       raise Exception.Create('');
5872     if StartIndex=EndIndex then
5873       begin
5874       if (Ranges[StartIndex].RangeStart>aRangeEnd) then
5875         begin
5876         // range in front
5877         if (Ranges[StartIndex].RangeStart>aRangeEnd+1) then
5878           begin
5879           // insert new range
5880           Item.RangeStart:=aRangeStart;
5881           Item.RangeEnd:=aRangeEnd;
5882           Insert(Item,Ranges,StartIndex);
5883           Result:=true;
5884           end
5885         else
5886           begin
5887           // enlarge range at its start
5888           Ranges[StartIndex].RangeStart:=aRangeStart;
5889           Result:=true;
5890           end;
5891         end
5892       else if Ranges[StartIndex].RangeEnd<aRangeStart then
5893         begin
5894         // range behind
5895         if Ranges[StartIndex].RangeEnd+1<aRangeStart then
5896           begin
5897           // insert new range
5898           Item.RangeStart:=aRangeStart;
5899           Item.RangeEnd:=aRangeEnd;
5900           Insert(Item,Ranges,StartIndex+1);
5901           Result:=true;
5902           end
5903         else
5904           begin
5905           // enlarge range at its end
5906           Ranges[StartIndex].RangeEnd:=aRangeEnd;
5907           Result:=true;
5908           end;
5909         end
5910       else
5911         begin
5912         // intersection -> enlarge to union range
5913         Result:=false;
5914         if (Ranges[StartIndex].RangeStart>aRangeStart) then
5915           Ranges[StartIndex].RangeStart:=aRangeStart;
5916         if (Ranges[StartIndex].RangeEnd<aRangeEnd) then
5917           Ranges[StartIndex].RangeEnd:=aRangeEnd;
5918         end;
5919       end
5920     else
5921       begin
5922       // multiple ranges are merged to one
5923       Result:=false;
5924       if Ranges[StartIndex].RangeStart>aRangeStart then
5925         Ranges[StartIndex].RangeStart:=aRangeStart;
5926       if aRangeEnd<Ranges[EndIndex].RangeEnd then
5927         aRangeEnd:=Ranges[EndIndex].RangeEnd;
5928       Ranges[StartIndex].RangeEnd:=aRangeEnd;
5929       Delete(Ranges,StartIndex+1,EndIndex-StartIndex);
5930       end;
5931     end;
5932   {$IFDEF VerbosePasResEval}
5933   writeln('TResEvalSetInt.Add END ',AsDebugString);
5934   ConsistencyCheck;
5935   {$ENDIF}
5936 end;
5937 
IndexOfRangenull5938 function TResEvalSet.IndexOfRange(Index: TMaxPrecInt; FindInsertPos: boolean
5939   ): integer;
5940 var
5941   l, r, m: Integer;
5942 begin
5943   l:=0;
5944   r:=length(Ranges)-1;
5945   while l<=r do
5946     begin
5947     m:=(l+r) div 2;
5948     if Ranges[m].RangeStart>Index then
5949       r:=m-1
5950     else if Ranges[m].RangeEnd<Index then
5951       l:=m+1
5952     else
5953       exit(m);
5954     end;
5955   if not FindInsertPos then
5956     exit(-1);
5957   // find insert position
5958   if length(Ranges)=0 then
5959     exit(0)
5960   else if l>m then
5961     exit(l)
5962   else
5963     exit(m);
5964   Result:=-1;
5965 end;
5966 
TResEvalSet.Intersectsnull5967 function TResEvalSet.Intersects(aRangeStart, aRangeEnd: TMaxPrecInt): integer;
5968 var
5969   Index: Integer;
5970 begin
5971   Index:=IndexOfRange(aRangeStart,true);
5972   if (Index=length(Ranges)) or (Ranges[Index].RangeStart>aRangeEnd) then
5973     Result:=-1
5974   else
5975     Result:=Index;
5976 end;
5977 
5978 procedure TResEvalSet.ConsistencyCheck;
5979 
5980   procedure E(Msg: string);
5981   begin
5982     raise Exception.Create(Msg);
5983   end;
5984 
5985 var
5986   i: Integer;
5987 begin
5988   if (ElKind=revskNone) and (length(Ranges)>0) then
5989     E('');
5990   for i:=0 to length(Ranges)-1 do
5991     begin
5992     if Ranges[i].RangeStart>Ranges[i].RangeEnd then
5993       E('');
5994     if (i>0) and (Ranges[i-1].RangeEnd+1>=Ranges[i].RangeStart) then
5995       E('missing gap');
5996     if RangeStart>Ranges[i].RangeStart then
5997       E('wrong RangeStart='+IntToStr(RangeStart));
5998     if RangeEnd<Ranges[i].RangeEnd then
5999       E('wrong RangeEnd='+IntToStr(RangeEnd));
6000     end;
6001 end;
6002 
6003 end.
6004 
6005