Ver código fonte

- remove unused copy of tw17904 (wrong extension)

git-svn-id: trunk@49482 -
svenbarth 4 anos atrás
pai
commit
be1461654f
2 arquivos alterados com 0 adições e 199 exclusões
  1. 0 1
      .gitattributes
  2. 0 198
      tests/webtbs/tw17904.pas

+ 0 - 1
.gitattributes

@@ -17600,7 +17600,6 @@ tests/webtbs/tw17836.pp svneol=native#text/plain
 tests/webtbs/tw17838.pp svneol=native#text/pascal
 tests/webtbs/tw17846.pp svneol=native#text/plain
 tests/webtbs/tw17862.pp svneol=native#text/plain
-tests/webtbs/tw17904.pas svneol=native#text/plain
 tests/webtbs/tw17904.pp svneol=native#text/plain
 tests/webtbs/tw17907/main/main.pas svneol=native#text/plain
 tests/webtbs/tw17907/test.bat svneol=native#text/plain

+ 0 - 198
tests/webtbs/tw17904.pas

@@ -1,198 +0,0 @@
-
-{$ifdef fpc}{$mode objfpc}{$h+}{$endif}
-{$apptype console}
-
-uses Variants, SysUtils;
-
-type
-  TTest = class(TCustomVariantType)
-    procedure Clear(var V: TVarData); override;
-    procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
-    procedure DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
-  end;
-
-procedure TTest.Clear(var V: TVarData);
-begin
-end;
-
-procedure TTest.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
-begin
-end;
-
-procedure TTest.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
-var
-  tmp: Word;
-begin
-  if (CallDesc^.ArgCount =2) and Assigned(Dest) then
-  begin
-    //writeln(HexStr(PPointer(Params)^), ' ', HexStr(PPointer(Params)[1]));
-    WordRec(tmp).Lo := CallDesc^.ArgTypes[0];
-    WordRec(tmp).Hi := CallDesc^.ArgTypes[1];
-    // !! FPC passes args right-to-left, Delphi does same left-to-right
-    // Moreover, IDispatch needs args right-to-left, and Variant Dispatch needs left-to-right. Nice, huh?
-    {$ifdef fpc}
-    tmp := Swap(tmp);
-    {$endif}
-    Variant(Dest^) := tmp;
-  end;  
-end;
-
-type
-  TTestClass=class
-    u8: byte;
-    u16: word;
-    u32: longword;
-{$ifdef fpc}
-    u64: qword;
-{$endif}
-    s8: shortint;
-    s16: smallint;
-    s32: longint;
-    s64: int64;
-
-    cy: currency;
-
-    b: boolean;
-    bb: bytebool;
-    wb: wordbool;
-    lb: longbool;
-
-    sgl: single;
-    dbl: double;
-    ext: extended;
-    dt: TDateTime;
-
-    fsstr: shortstring;
-    fastr: ansistring;
-    fwstr: widestring;
-{$ifdef fpc}
-    fustr: unicodestring;
-{$endif}
-
-    fvar: Variant;
-    fintf: IInterface;
-    fdisp: IDispatch;
-
-    property u8prop: Byte read u8;
-    property u16prop: Word read u16;
-    property u32prop: LongWord read u32;
-{$ifdef fpc}
-    property u64prop: QWord read u64;
-{$endif}
-    property s8prop: ShortInt read s8;
-    property s16prop: SmallInt read s16;
-    property s32prop: LongInt read s32;
-    property s64prop: Int64 read s64;
-
-    property cyprop: currency read cy;
-    property bprop: boolean read b;
-    property bbprop: bytebool read bb;
-    property wbprop: wordbool read wb;
-    property lbprop: longbool read lb;
-
-    property sglprop: single read sgl;
-    property dblprop: double read dbl;
-    property extprop: extended read ext;
-    property dtprop: TDateTime read dt;
-
-    property varprop: Variant read fvar;
-    property intfprop: IInterface read fintf;
-    property dispprop: IDispatch read fdisp;
-
-    property sstr: shortstring read fsstr;
-    property astr: ansistring read fastr;
-    property wstr: widestring read fwstr;
-{$ifdef fpc}
-    property ustr: unicodestring read fustr;
-{$endif}
-  end;
-
-var
-  cv: TCustomVariantType;
-  code: Integer;
-  cl: TTestClass;
-  v: Variant;
-
-// using negative values of Expected to check that arg is passed by-value only
-procedure test(const id: string; const act: Variant; expected: Integer);
-var
-  tmp: word;
-  absexp: Integer;
-begin
-  tmp := act;
-  absexp := abs(expected);
-  write(id, WordRec(tmp).Lo,', ', WordRec(tmp).Hi);
-  if (expected >= 0) and (WordRec(tmp).Lo <> (expected or $80)) then
-  begin
-    write(' BYREF failed');
-    Code := Code or 1;
-  end;  
-  if WordRec(tmp).Hi <> absexp then
-  begin
-    write(' BYVAL failed');
-    Code := Code or 2;
-  end;
-  writeln;
-end;
-
-begin
-  Code := 0;
-  cv := TTest.Create;
-  cl := TTestClass.Create;
-  TVarData(v).vType := cv.VarType;
-
-  test('u8:    ', v.foo(cl.u8, cl.u8prop), varbyte);
-  
-  test('u16:    ', v.foo(cl.u16, cl.u16prop), varword);       // (Uncertain) D7: treated as Integer
-  test('u32:    ', v.foo(cl.u32, cl.u32prop), varlongword);   // (Uncertain) D7: treated as Integer ByRef
-  test('s8:     ', v.foo(cl.s8, cl.s8prop), varshortint);     // (Uncertain) D7: treated as Integer
-
-  test('s16:    ', v.foo(cl.s16, cl.s16prop), varsmallint);
-  test('s32:    ', v.foo(cl.s32, cl.s32prop), varinteger);
-  test('s64:    ', v.foo(cl.s64, cl.s64prop), varint64);
-{$ifdef fpc}
-  test('u64:    ', v.foo(cl.u64, cl.u64prop), varword64);
-{$endif}
-  
-  test('wordbool:', v.foo(cl.wb, cl.wbprop), varBoolean);
-  test('curncy:  ', v.foo(cl.cy, cl.cyprop), varCurrency);
-  
-  test('single:  ', v.foo(cl.sgl, cl.sglprop), varSingle);
-  test('double:  ', v.foo(cl.dbl, cl.dblprop), varDouble);
-  test('extended:', v.foo(cl.ext, cl.extprop), -varDouble);  // not a COM type, passed by value
-  
-  test('date:    ', v.foo(cl.dt, cl.dtprop), varDate);
-
-  test('ansistr: ', v.foo(cl.fastr, cl.astr), varStrArg);
-  test('widestr: ', v.foo(cl.fwstr, cl.wstr), varOleStr);
-{$ifdef fpc}
-  test('unistr:  ', v.foo(cl.fustr, cl.ustr), varUStrArg);
-{$endif}
-  test('variant: ', v.foo(cl.fvar, cl.varprop), varVariant);
-  
-  test('IUnknown:', v.foo(cl.fintf, cl.intfprop), varUnknown);
-  test('IDispatch:', v.foo(cl.fdisp, cl.dispprop), varDispatch);
-  
-  // not an COM type, passed by value; Delphi uses varStrArg
-  test('shortstr:', v.foo(cl.fsstr, cl.sstr), -varOleStr);
-  // not an COM type, passed by value
-  test('longbool:', v.foo(cl.lb, cl.lbprop), -varBoolean);
-
-  // typecasted ordinals (only one arg is actually used)
-  test('u8+cast: ', v.foo(byte(55), byte(55)), -varByte);
-  test('u16+cast:', v.foo(word(55), word(55)), -varWord);
-  test('u32+cast:', v.foo(longword(55), longword(55)), -varLongWord);
-{$ifdef fpc}
-  test('u64+cast:', v.foo(qword(55), qword(55)), -varQWord);
-{$endif}
-  test('s8+cast:', v.foo(shortint(55), shortint(55)), -varShortInt);
-  test('s16+cast:', v.foo(smallint(55), smallint(55)), -varSmallInt);
-  test('s32+cast:', v.foo(longint(55), longint(55)), -varInteger);
-  test('s64+cast:', v.foo(int64(55), int64(55)), -varInt64);
-
-  cl.Free;
-  if Code <> 0 then
-    writeln('Errors: ', Code);
-  Halt(Code);
-
-end.