+ missing tests from r20427 (forgot to delete them after first failed merge)

git-svn-id: branches/fixes_2_6@20430 -

.gitattributes

@@ -9773,6 +9773,10 @@ tests/test/packages/cocoaint/tobjc33a.pp svneol=native#text/plain
 tests/test/packages/cocoaint/tobjcnh1.pp svneol=native#text/plain
 tests/test/packages/cocoaint/tvarpara.pp svneol=native#text/plain
 tests/test/packages/cocoaint/tw16329.pp svneol=native#text/plain
+tests/test/packages/cocoaint/tw20875.pp svneol=native#text/plain
+tests/test/packages/cocoaint/tw20876.pp svneol=native#text/plain
+tests/test/packages/cocoaint/uw20875a.pp svneol=native#text/plain
+tests/test/packages/cocoaint/uw20875b.pp svneol=native#text/plain
 tests/test/packages/fcl-base/tascii85.pp svneol=native#text/plain
 tests/test/packages/fcl-base/tgettext1.pp svneol=native#text/plain
 tests/test/packages/fcl-db/assertions.pas svneol=native#text/plain
@@ -10312,6 +10316,7 @@ tests/test/tobjc35i.pp svneol=native#text/plain
 tests/test/tobjc36.pp svneol=native#text/plain
 tests/test/tobjc36a.pp svneol=native#text/plain
 tests/test/tobjc37.pp svneol=native#text/plain
+tests/test/tobjc38.pp svneol=native#text/plain
 tests/test/tobjc4.pp svneol=native#text/plain
 tests/test/tobjc4a.pp svneol=native#text/plain
 tests/test/tobjc5.pp svneol=native#text/plain
@@ -10953,10 +10958,13 @@ tests/webtbf/tw2037.pp svneol=native#text/plain
 tests/webtbf/tw2046.pp svneol=native#text/plain
 tests/webtbf/tw2053.pp svneol=native#text/plain
 tests/webtbf/tw2053b.pp svneol=native#text/plain
+tests/webtbf/tw20661.pp svneol=native#text/plain
 tests/webtbf/tw2070.pp svneol=native#text/plain
 tests/webtbf/tw20721a.pp svneol=native#text/pascal
 tests/webtbf/tw20721b.pp svneol=native#text/pascal
 tests/webtbf/tw20721c.pp svneol=native#text/pascal
+tests/webtbf/tw20907.pp svneol=native#text/plain
+tests/webtbf/tw20907a.pp svneol=native#text/plain
 tests/webtbf/tw2128.pp svneol=native#text/plain
 tests/webtbf/tw2129.pp svneol=native#text/plain
 tests/webtbf/tw2154.pp svneol=native#text/plain
@@ -11766,6 +11774,7 @@ tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
 tests/webtbs/tw18702.pp svneol=native#text/pascal
+tests/webtbs/tw18706.pp svneol=native#text/plain
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw18767a.pp svneol=native#text/pascal
 tests/webtbs/tw18767b.pp svneol=native#text/pascal
@@ -11827,8 +11836,12 @@ tests/webtbs/tw2065.pp svneol=native#text/plain
 tests/webtbs/tw2069.pp svneol=native#text/plain
 tests/webtbs/tw20690.pp svneol=native#text/pascal
 tests/webtbs/tw2072.pp svneol=native#text/plain
+tests/webtbs/tw20873.pp svneol=native#text/plain
+tests/webtbs/tw21029.pp svneol=native#text/plain
+tests/webtbs/tw21073.pp svneol=native#text/plain
 tests/webtbs/tw2109.pp svneol=native#text/plain
 tests/webtbs/tw2110.pp svneol=native#text/plain
+tests/webtbs/tw21177.pp svneol=native#text/plain
 tests/webtbs/tw2128.pp svneol=native#text/plain
 tests/webtbs/tw2129.pp svneol=native#text/plain
 tests/webtbs/tw2129b.pp svneol=native#text/plain

tests/test/packages/cocoaint/tw20875.pp

@@ -0,0 +1,13 @@
+{ %target=darwin }
+{ %norun }
+
+program testlink;
+
+{$MODE Delphi}
+{$modeswitch ObjectiveC1}
+
+uses
+  uw20875a,uw20875b;
+  
+begin
+end.

tests/test/packages/cocoaint/tw20876.pp

@@ -0,0 +1,21 @@
+{ %target=darwin }
+{ %norun }
+
+unit tw20876;
+
+{$mode delphi}
+{$modeswitch objectivec1}
+
+interface
+
+uses
+  CocoaAll;
+
+type
+  arecord = record
+    astr: NSString;
+  end;
+
+implementation
+
+end.

tests/test/packages/cocoaint/uw20875a.pp

@@ -0,0 +1,24 @@
+unit uw20875a;
+
+{$MODE Delphi}
+{$modeswitch ObjectiveC1}
+
+interface
+
+uses
+  CocoaAll;
+
+type
+  TController1 = objcclass(NSWindowController, NSWindowDelegateProtocol)
+  public
+    function init : id; override;
+  end;
+
+implementation
+
+function TController1.init : id;
+begin
+  Result := inherited init;
+end;
+
+end.

tests/test/packages/cocoaint/uw20875b.pp

@@ -0,0 +1,24 @@
+unit uw20875b;
+
+{$MODE Delphi}
+{$modeswitch ObjectiveC1}
+
+interface
+
+uses
+  CocoaAll;
+
+type
+  TController2 = objcclass(NSWindowController, NSWindowDelegateProtocol)
+  public
+    function init : id; override;
+  end;
+
+implementation
+
+function TController2.init : id;
+begin
+  Result := inherited init;
+end;
+
+end.

tests/test/tobjc38.pp

@@ -0,0 +1,14 @@
+{ %target=darwin }
+{ %cpu=powerpc,powerpc64,i386,x86_64,arm }
+{ %norun }
+{$modeswitch objectivec1}
+
+type
+ MyClass = objcclass (NSObject)
+   _rec: record
+     mask: MyClass;
+   end;
+ end;
+
+begin
+end.

tests/webtbf/tw20661.pp

@@ -0,0 +1,40 @@
+{ %fail }
+
+unit tw20661;
+
+{$mode objfpc}{$H+}
+
+interface
+
+const
+  PrescriptionStorageIntfId = '{C2F3C9F6-657C-4974-841A-4EBFF33B2180}';//'blik.prescriptionstorage';
+  DatasetProviderIntfId = '{B0B1501A-9266-48EA-B2E0-7EF23511D799}';
+
+type
+  IDatasetPool = interface
+    ['{F866EB5B-5B32-438E-918E-A56B031C73DA}']
+    procedure ReleaseDataset(Instance: pointer);
+  end;
+
+  { TBlikServices }
+
+  TBlikServices = class
+  public
+    procedure ReleaseDataset(Instance: pointer);
+  end;
+
+var
+  Services: TBlikServices;
+
+implementation
+
+{ TBlikServices }
+
+procedure TBlikServices.ReleaseDataset(Instance: pointer);
+begin
+  IDatasetPool.ReleaseDataset(Instance);
+end;
+
+end.
+
+

tests/webtbf/tw20907.pp

@@ -0,0 +1,16 @@
+{ %opt=-vew -Sew }
+{ %fail }
+
+type
+  trec = record
+    s: set of byte;
+  end;
+
+function f: trec;
+begin
+  if f.s <>[] then ;
+end;
+
+begin
+  f;
+end.

tests/webtbf/tw20907a.pp

@@ -0,0 +1,11 @@
+{ %opt=-vw -Sew }
+{ %fail }
+
+function f: ansistring;
+begin
+  if f <> '' then;
+end;
+
+begin
+  f;
+end.

tests/webtbs/tw18706.pp

@@ -0,0 +1,49 @@
+{$MODE DELPHI}
+
+type
+
+  TExecProc = procedure of object;
+
+  TA = class
+  public
+    procedure P1; overload; virtual;
+    procedure P1(const param: boolean); overload; virtual;
+  end;
+
+  TB = class(TA)
+  public
+    procedure P1(const param: boolean); override;
+  end;
+
+procedure ShowProc(p: TExecProc);
+begin
+  p;
+end;
+
+procedure TA.P1;
+begin
+  writeln('1');
+end;
+
+procedure TA.P1(const param: boolean);
+begin
+  writeln('2');
+  halt(1);
+end;
+
+procedure TB.P1(const param: boolean);
+begin
+  writeln('3');
+  halt(2);
+end;
+
+var
+  a: TA;
+  b: TB;
+begin
+  a := TA.Create;
+  b := TB.Create;
+
+  ShowProc(a.P1); // compile and execute correctly
+  ShowProc(b.P1); // error on compile !!! but here should be call TA.P1 !!!
+end.

tests/webtbs/tw20873.pp

@@ -0,0 +1,17 @@
+{$MODE OBJFPC}
+program variant_bug;
+uses variants;
+
+var SomeArray : array[1..10] of DWord;
+    v         : Variant;
+    y: longint;
+begin
+  for y := 1 to 10 do SomeArray[y] := 0;
+  v := 7;
+  SomeArray[ v ] := 1;
+  for y := 1 to 10 do Write( SomeArray[y] );
+  writeln;
+  if somearray[v]<>1 then
+    halt(1);
+end.
+

tests/webtbs/tw21029.pp

@@ -0,0 +1,12 @@
+{$r+}
+{$inline on}
+
+function F(y : byte) : byte; inline;
+begin
+  f:=byte(not y);
+end;
+
+BEGIN
+  if F(1)<>254 then
+    halt(1);
+END.

tests/webtbs/tw21073.pp

@@ -0,0 +1,26 @@
+{ %norun }
+
+{$mode delphi}
+
+program gpabugtest;
+
+TYPE TGetCurrentProcess = function : THandle; stdcall;
+     TGetProcAddress = function(const hModule : THandle; const lpProcName : PAnsiChar) : Pointer; stdcall;
+
+function GetProcAddress(const hModule : THandle;const lpProcName : PAnsiChar) : Pointer; stdcall;
+begin
+  result:=nil;
+end;
+
+function GetModuleHandle(const lpModuleName : PWideChar) : THandle; stdcall;
+begin
+  result:=thandle(-1);
+end;
+
+var proc_GetCurrentProcess : TGetCurrentProcess;
+    proc_GetProcAddress : TGetProcAddress;
+
+begin
+ {no error} proc_GetCurrentProcess:=GetProcAddress(GetModuleHandle('Kernel32'),'GetCurrentProcess');
+ {error ??} proc_GetProcAddress:=   GetProcAddress(GetModuleHandle('Kernel32'),'GetProcAddress');
+end.

tests/webtbs/tw21177.pp

@@ -0,0 +1,29 @@
+{$modeswitch ADVANCEDRECORDS}
+{$OPTIMIZATION REGVAR}
+program record_bug;
+
+type
+TColor = object
+  R : Byte;
+  function toDWord : DWord;
+end;
+
+function TColor.toDWord : DWord;
+begin
+  r:=4;
+  toDWord:=5;
+end;
+
+procedure Fill(Color: TColor);
+begin
+  Color.toDWord;
+  if color.r<>4 then
+    halt(1);
+end;
+
+var
+  c: TColor;
+begin
+  c.r:=1;
+  Fill(c);
+end.