← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fcl/db/dbase/dbf_prscore.pas

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/db/dbase/dbf_prscore.pas
8
8
 
9
9
interface
10
10
 
11
 
{$I Dbf_Common.inc}
 
11
{$I dbf_common.inc}
12
12
 
13
13
uses
14
14
  SysUtils,
15
15
  Classes,
16
 
  Dbf_Common,
17
 
  Dbf_PrsSupp,
18
 
  Dbf_PrsDef;
 
16
  dbf_common,
 
17
  dbf_prssupp,
 
18
  dbf_prsdef;
19
19
 
20
20
{$define ENG_NUMBERS}
21
21
 
58
58
 
59
59
    procedure CompileExpression(AnExpression: string);
60
60
    procedure EvaluateCurrent;
61
 
    procedure ReplaceExprWord(OldExprWord, NewExprWord: TExprWord); virtual;
62
61
    procedure DisposeList(ARec: PExpressionRec);
63
62
    procedure DisposeTree(ExprRec: PExpressionRec);
64
63
    function CurrentExpression: string; virtual; abstract;
73
72
    constructor Create;
74
73
    destructor Destroy; override;
75
74
 
76
 
    procedure AddReplaceExprWord(AExprWord: TExprWord);
77
 
    procedure DefineFloatVariable(AVarName: string; AValue: PDouble);
78
 
    procedure DefineIntegerVariable(AVarName: string; AValue: PInteger);
 
75
    function DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
 
76
    function DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
79
77
//    procedure DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
80
78
{$ifdef SUPPORT_INT64}
81
 
    procedure DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
 
79
    function DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
82
80
{$endif}
83
 
    procedure DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
84
 
    procedure DefineBooleanVariable(AVarName: string; AValue: PBoolean);
85
 
    procedure DefineStringVariable(AVarName: string; AValue: PPChar);
86
 
    procedure DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
87
 
    procedure DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
88
 
        AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
89
 
    procedure ReplaceFunction(OldName: string; AFunction: TObject);
 
81
    function DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
 
82
    function DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
 
83
    function DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
 
84
    function DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer): TExprWord;
 
85
    function DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
 
86
        AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
90
87
    procedure Evaluate(AnExpression: string);
91
88
    function AddExpression(AnExpression: string): Integer;
92
89
    procedure ClearExpressions; virtual;
194
191
        CheckArguments(ArgList[I]);
195
192
 
196
193
        // test if correct type
197
 
        if (ArgList[I].ExprWord.ResultType <> ExprCharToExprType(ExprWord.TypeSpec[I+1])) then
 
194
        if (ArgList[I]^.ExprWord.ResultType <> ExprCharToExprType(ExprWord.TypeSpec[I+1])) then
198
195
          error := 2;
199
196
 
200
197
        // goto next argument
217
214
        // check if not last function
218
215
        if I < FWordsList.Count - 1 then
219
216
        begin
220
 
          TempExprWord := FWordsList.Items[I+1];
 
217
          TempExprWord := TExprWord(FWordsList.Items[I+1]);
221
218
          if FWordsList.Compare(FWordsList.KeyOf(ExprWord), FWordsList.KeyOf(TempExprWord)) = 0 then
222
219
          begin
223
220
            ExprWord := TempExprWord;
328
325
begin
329
326
  if ARec <> nil then
330
327
    repeat
331
 
      TheNext := ARec.Next;
332
 
      if ARec.Res <> nil then
333
 
        ARec.Res.Free;
 
328
      TheNext := ARec^.Next;
 
329
      if ARec^.Res <> nil then
 
330
        ARec^.Res.Free;
334
331
      I := 0;
335
 
      while ARec.ArgList[I] <> nil do
 
332
      while ARec^.ArgList[I] <> nil do
336
333
      begin
337
 
        FreeMem(ARec.Args[I]);
 
334
        FreeMem(ARec^.Args[I]);
338
335
        Inc(I);
339
336
      end;
340
337
      Dispose(ARec);
374
371
    while ExprRec^.ArgList[I] <> nil do
375
372
    begin
376
373
      // save variable type for easy access
377
 
      ExprRec^.ArgsType[I] := ExprRec^.ArgList[I].ExprWord.ResultType;
 
374
      ExprRec^.ArgsType[I] := ExprRec^.ArgList[I]^.ExprWord.ResultType;
378
375
      // check if we need to copy argument, variables in general do not
379
376
      // need copying, except for fixed len strings which are not
380
377
      // null-terminated
408
405
      FCurrentRec := ExprRec;
409
406
      FLastRec := ExprRec;
410
407
    end else begin
411
 
      FLastRec.Next := ExprRec;
 
408
      FLastRec^.Next := ExprRec;
412
409
      FLastRec := ExprRec;
413
410
    end;
414
411
  end;
415
412
end;
416
413
 
417
 
function TCustomExpressionParser.MakeTree(Expr: TExprCollection;
 
414
function TCustomExpressionParser.MakeTree(Expr: TExprCollection; 
418
415
  FirstItem, LastItem: Integer): PExpressionRec;
419
416
 
420
417
{
447
444
  begin
448
445
    case TExprWord(Expr.Items[I]).ResultType of
449
446
      etLeftBracket: Inc(brCount);
450
 
      etRightBracket:
 
447
      etRightBracket: 
451
448
        begin
452
449
          Dec(brCount);
453
450
          if brCount < IArg then
478
475
  // simple constant, variable or function?
479
476
  if LastItem = FirstItem then
480
477
  begin
481
 
    Result.ExprWord := TExprWord(Expr.Items[FirstItem]);
482
 
    Result.Oper := @Result.ExprWord.ExprFunc;
483
 
    if Result.ExprWord.IsVariable then
 
478
    Result^.ExprWord := TExprWord(Expr.Items[FirstItem]);
 
479
    Result^.Oper := Result^.ExprWord.ExprFunc;
 
480
    if Result^.ExprWord.IsVariable then
484
481
    begin
485
482
      // copy pointer to variable
486
 
      Result.Args[0] := Result.ExprWord.AsPointer;
 
483
      Result^.Args[0] := Result^.ExprWord.AsPointer;
487
484
      // is this a fixed length string variable?
488
 
      if Result.ExprWord.FixedLen >= 0 then
 
485
      if Result^.ExprWord.FixedLen >= 0 then
489
486
      begin
490
487
        // store length as second parameter
491
 
        Result.Args[1] := PChar(Result.ExprWord.LenAsPointer);
 
488
        Result^.Args[1] := PChar(Result^.ExprWord.LenAsPointer);
492
489
      end;
493
490
    end;
494
491
    exit;
517
514
  if IEnd >= FirstItem then
518
515
  begin
519
516
    // save operator
520
 
    Result.ExprWord := TExprWord(Expr.Items[IEnd]);
521
 
    Result.Oper := Result.ExprWord.ExprFunc;
 
517
    Result^.ExprWord := TExprWord(Expr.Items[IEnd]);
 
518
    Result^.Oper := Result^.ExprWord.ExprFunc;
522
519
    // recurse into left part if present
523
520
    if IEnd > FirstItem then
524
521
    begin
525
 
      Result.ArgList[IArg] := MakeTree(Expr, FirstItem, IEnd-1);
 
522
      Result^.ArgList[IArg] := MakeTree(Expr, FirstItem, IEnd-1);
526
523
      Inc(IArg);
527
524
    end;
528
525
    // recurse into right part if present
529
526
    if IEnd < LastItem then
530
 
      Result.ArgList[IArg] := MakeTree(Expr, IEnd+1, LastItem);
531
 
  end else
532
 
  if TExprWord(Expr.Items[FirstItem]).IsFunction then
 
527
      Result^.ArgList[IArg] := MakeTree(Expr, IEnd+1, LastItem);
 
528
  end else 
 
529
  if TExprWord(Expr.Items[FirstItem]).IsFunction then 
533
530
  begin
534
531
    // save function
535
 
    Result.ExprWord := TExprWord(Expr.Items[FirstItem]);
536
 
    Result.Oper := Result.ExprWord.ExprFunc;
 
532
    Result^.ExprWord := TExprWord(Expr.Items[FirstItem]);
 
533
    Result^.Oper := Result^.ExprWord.ExprFunc;
537
534
    // parse function arguments
538
535
    IEnd := FirstItem + 1;
539
536
    IStart := IEnd;
552
549
            if brCount = 1 then
553
550
            begin
554
551
              // argument separation found, build tree of argument expression
555
 
              Result.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
 
552
              Result^.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
556
553
              Inc(IArg);
557
554
              IStart := IEnd + 1;
558
555
            end;
561
558
      end;
562
559
 
563
560
      // parse last argument
564
 
      Result.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
 
561
      Result^.ArgList[IArg] := MakeTree(Expr, IStart, IEnd-1);
565
562
    end;
566
563
  end else
567
564
    raise EParserException.Create('Operator/function missing');
897
894
  end;
898
895
end;
899
896
 
900
 
procedure TCustomExpressionParser.DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
901
 
  AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc);
902
 
begin
903
 
  AddReplaceExprWord(TFunction.Create(AFunctName, AShortName, ATypeSpec, AMinFunctionArg, AResultType, AFuncAddress, ADescription));
904
 
end;
905
 
 
906
 
procedure TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger);
907
 
begin
908
 
  AddReplaceExprWord(TIntegerVariable.Create(AVarName, AValue));
909
 
end;
910
 
 
911
 
{
912
 
procedure TCustomExpressionParser.DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
913
 
begin
914
 
  AddReplaceExprWord(TSmallIntVariable.Create(AVarName, AValue));
915
 
end;
916
 
}
 
897
function TCustomExpressionParser.DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
 
898
  AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
 
899
begin
 
900
  Result := TFunction.Create(AFunctName, AShortName, ATypeSpec, AMinFunctionArg, AResultType, AFuncAddress, ADescription);
 
901
  FWordsList.Add(Result);
 
902
end;
 
903
 
 
904
function TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
 
905
begin
 
906
  Result := TIntegerVariable.Create(AVarName, AValue);
 
907
  FWordsList.Add(Result);
 
908
end;
917
909
 
918
910
{$ifdef SUPPORT_INT64}
919
911
 
920
 
procedure TCustomExpressionParser.DefineLargeIntVariable(AVarName: string; AValue: PLargeInt);
 
912
function TCustomExpressionParser.DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
921
913
begin
922
 
  AddReplaceExprWord(TLargeIntVariable.Create(AVarName, AValue));
 
914
  Result := TLargeIntVariable.Create(AVarName, AValue);
 
915
  FWordsList.Add(Result);
923
916
end;
924
917
 
925
918
{$endif}
926
919
 
927
 
procedure TCustomExpressionParser.DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec);
928
 
begin
929
 
  AddReplaceExprWord(TDateTimeVariable.Create(AVarName, AValue));
930
 
end;
931
 
 
932
 
procedure TCustomExpressionParser.DefineBooleanVariable(AVarName: string; AValue: PBoolean);
933
 
begin
934
 
  AddReplaceExprWord(TBooleanVariable.Create(AVarName, AValue));
935
 
end;
936
 
 
937
 
procedure TCustomExpressionParser.DefineFloatVariable(AVarName: string; AValue: PDouble);
938
 
begin
939
 
  AddReplaceExprWord(TFloatVariable.Create(AVarName, AValue));
940
 
end;
941
 
 
942
 
procedure TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar);
943
 
begin
944
 
  DefineStringVariableFixedLen(AVarName, AValue, -1);
945
 
end;
946
 
 
947
 
procedure TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer);
948
 
begin
949
 
  AddReplaceExprWord(TStringVariable.Create(AVarName, AValue, ALength));
 
920
function TCustomExpressionParser.DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
 
921
begin
 
922
  Result := TDateTimeVariable.Create(AVarName, AValue);
 
923
  FWordsList.Add(Result);
 
924
end;
 
925
 
 
926
function TCustomExpressionParser.DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
 
927
begin
 
928
  Result := TBooleanVariable.Create(AVarName, AValue);
 
929
  FWordsList.Add(Result);
 
930
end;
 
931
 
 
932
function TCustomExpressionParser.DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
 
933
begin
 
934
  Result := TFloatVariable.Create(AVarName, AValue);
 
935
  FWordsList.Add(Result);
 
936
end;
 
937
 
 
938
function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
 
939
begin
 
940
  Result := DefineStringVariableFixedLen(AVarName, AValue, -1);
 
941
end;
 
942
 
 
943
function TCustomExpressionParser.DefineStringVariableFixedLen(AVarName: string; AValue: PPChar; ALength: Integer): TExprWord;
 
944
begin
 
945
  Result := TStringVariable.Create(AVarName, AValue, ALength);
 
946
  FWordsList.Add(Result);
950
947
end;
951
948
 
952
949
{
972
969
    //LAST operand should be boolean -otherwise If(,,) doesn't work
973
970
    while (FLastRec^.Next <> nil) do
974
971
      FLastRec := FLastRec^.Next;
975
 
    if FLastRec.ExprWord <> nil then
976
 
      Result := FLastRec.ExprWord.ResultType;
 
972
    if FLastRec^.ExprWord <> nil then
 
973
      Result := FLastRec^.ExprWord.ResultType;
977
974
  end;
978
975
end;
979
976
 
980
 
procedure TCustomExpressionParser.ReplaceExprWord(OldExprWord, NewExprWord: TExprWord);
981
 
var
982
 
  J: Integer;
983
 
  Rec: PExpressionRec;
984
 
  p, pnew: pointer;
985
 
begin
986
 
  if OldExprWord.MaxFunctionArg <> NewExprWord.MaxFunctionArg then
987
 
    raise Exception.Create('Cannot replace variable/function MaxFunctionArg doesn''t match');
988
 
 
989
 
  p := OldExprWord.AsPointer;
990
 
  pnew := NewExprWord.AsPointer;
991
 
  Rec := FCurrentRec;
992
 
  repeat
993
 
    if (Rec.ExprWord = OldExprWord) then
994
 
    begin
995
 
      Rec.ExprWord := NewExprWord;
996
 
      Rec.Oper := NewExprWord.ExprFunc;
997
 
    end;
998
 
    if p <> nil then
999
 
      for J := 0 to Rec.ExprWord.MaxFunctionArg - 1 do
1000
 
        if Rec.Args[J] = p then
1001
 
          Rec.Args[J] := pnew;
1002
 
    Rec := Rec.Next;
1003
 
  until Rec = nil;
1004
 
end;
1005
 
 
1006
977
function TCustomExpressionParser.MakeRec: PExpressionRec;
1007
978
var
1008
979
  I: Integer;
1009
980
begin
1010
981
  New(Result);
1011
 
  Result.Oper := nil;
1012
 
  Result.AuxData := nil;
 
982
  Result^.Oper := nil;
 
983
  Result^.AuxData := nil;
1013
984
  for I := 0 to MaxArg - 1 do
1014
985
  begin
1015
 
    Result.Args[I] := nil;
1016
 
    Result.ArgsPos[I] := nil;
1017
 
    Result.ArgsSize[I] := 0;
1018
 
    Result.ArgsType[I] := etUnknown;
1019
 
    Result.ArgList[I] := nil;
 
986
    Result^.Args[I] := nil;
 
987
    Result^.ArgsPos[I] := nil;
 
988
    Result^.ArgsSize[I] := 0;
 
989
    Result^.ArgsType[I] := etUnknown;
 
990
    Result^.ArgList[I] := nil;
1020
991
  end;
1021
 
  Result.Res := nil;
1022
 
  Result.Next := nil;
1023
 
  Result.ExprWord := nil;
1024
 
  Result.ResetDest := false;
 
992
  Result^.Res := nil;
 
993
  Result^.Next := nil;
 
994
  Result^.ExprWord := nil;
 
995
  Result^.ResetDest := false;
1025
996
end;
1026
997
 
1027
998
procedure TCustomExpressionParser.Evaluate(AnExpression: string);
1044
1015
  //CurrentIndex := Result;
1045
1016
end;
1046
1017
 
1047
 
procedure TCustomExpressionParser.ReplaceFunction(OldName: string; AFunction:
1048
 
  TObject);
1049
 
var
1050
 
  I: Integer;
1051
 
begin
1052
 
  // clearing only allowed when expression is not present
1053
 
  if (AFunction = nil) and (FCurrentRec <> nil) then
1054
 
    raise Exception.Create('Cannot undefine function/variable while expression present');
1055
 
 
1056
 
  if FWordsList.Search(PChar(OldName), I) then
1057
 
  begin
1058
 
    // if no function specified, then no need to replace!
1059
 
    if AFunction <> nil then
1060
 
      ReplaceExprWord(FWordsList.Items[I], TExprWord(AFunction));
1061
 
    FWordsList.AtFree(I);
1062
 
  end;
1063
 
  if AFunction <> nil then
1064
 
    FWordsList.Add(AFunction);
1065
 
end;
1066
 
 
1067
1018
procedure TCustomExpressionParser.ClearExpressions;
1068
1019
begin
1069
1020
  DisposeList(FCurrentRec);
1071
1022
  FLastRec := nil;
1072
1023
end;
1073
1024
 
1074
 
procedure TCustomExpressionParser.AddReplaceExprWord(AExprWord: TExprWord);
1075
 
var
1076
 
  IOldVar: Integer;
1077
 
begin
1078
 
  if FWordsList.Search(PChar(AExprWord.Name), IOldVar) then
1079
 
  begin
1080
 
    ReplaceExprWord(FWordsList.Items[IOldVar], AExprWord);
1081
 
    FWordsList.AtFree(IOldVar);
1082
 
    FWordsList.Add(AExprWord);
1083
 
  end
1084
 
  else
1085
 
    FWordsList.Add(AExprWord);
1086
 
end;
1087
 
 
1088
1025
function TCustomExpressionParser.GetFunctionDescription(AFunction: string):
1089
1026
  string;
1090
1027
var