Browse Source

* testss for class overload and virtual

peter 24 năm trước cách đây
mục cha
commit
8bbd570d12

+ 32 - 0
tests/tbf/tb0114.pp

@@ -0,0 +1,32 @@
+{ %FAIL }
+
+{$ifdef fpc}{$mode objfpc}{$endif}
+type
+  tobj = class
+      procedure proc1 (a: integer);virtual;
+  end;
+
+  tobj1 = class (tobj)
+      procedure proc1 (a: char);
+  end;
+
+  tobj2 = class (tobj1)
+      { this will try to override tobj1.proc1 which is not
+        allowed and therefor needs an error }
+      procedure proc1 (a: integer);override;
+  end;
+
+procedure tobj.proc1 (a: integer);
+begin
+end;
+
+procedure tobj1.proc1 (a: char);
+begin
+end;
+
+procedure tobj2.proc1 (a: integer);
+begin
+end;
+
+begin
+end.

+ 17 - 0
tests/tbf/tb0115.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+{$ifdef fpc}{$mode objfpc}{$endif}
+uses ub0115;
+type
+  tobj2 = class (tobj)
+      { this will try to override tobj.proc1 which is private
+        and can not be seen. This needs an error }
+      procedure proc1 (a: integer);override;
+  end;
+
+procedure tobj2.proc1 (a: integer);
+begin
+end;
+
+begin
+end.

+ 32 - 0
tests/tbf/tb0116.pp

@@ -0,0 +1,32 @@
+{ %FAIL }
+{$ifdef fpc}{$mode objfpc}{$endif}
+type
+  tobj1 = class
+      procedure proc1 (a: char);
+  end;
+
+  tobj2 = class (tobj1)
+      procedure proc1 (a: integer);
+  end;
+
+procedure tobj1.proc1 (a: char);
+begin
+  write('tobj1.proc1(a:char) called: ');
+  writeln (a);
+end;
+
+procedure tobj2.proc1 (a: integer);
+begin
+  write('tobj2.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+var
+    obj1: tobj1;
+    obj2: tobj2;
+begin
+  obj1:=tobj1.create;
+  obj2:=tobj2.create;
+
+  obj2.proc1 ('a');
+end.

+ 17 - 0
tests/tbf/ub0115.pp

@@ -0,0 +1,17 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+unit ub0115;
+interface
+
+type
+  tobj = class
+  private
+      procedure proc1 (a: integer);overload; virtual;
+  end;
+
+implementation
+
+procedure tobj.proc1 (a: integer);
+begin
+end;
+
+end.

+ 15 - 0
tests/tbs/tb0386.pp

@@ -0,0 +1,15 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+uses ub0386;
+type
+  tobj2 = class (tobj1)
+      { this will try to override tobj.proc1, it should not
+        see tobj1.proc1 }
+      procedure proc1 (a: integer);override;
+  end;
+
+procedure tobj2.proc1 (a: integer);
+begin
+end;
+
+begin
+end.

+ 33 - 0
tests/tbs/tb0387.pp

@@ -0,0 +1,33 @@
+{ %VERSION=1.1 }
+
+{$ifdef fpc}{$mode objfpc}{$endif}
+type
+  tobj1 = class
+      procedure proc1 (a: char);
+  end;
+
+  tobj2 = class (tobj1)
+      procedure proc1 (a: integer);overload;
+  end;
+
+procedure tobj1.proc1 (a: char);
+begin
+  write('tobj1.proc1(a:char) called: ');
+  writeln (a);
+end;
+
+procedure tobj2.proc1 (a: integer);
+begin
+  write('tobj2.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+var
+    obj1: tobj1;
+    obj2: tobj2;
+begin
+  obj1:=tobj1.create;
+  obj2:=tobj2.create;
+
+  obj2.proc1 ('a');
+end.

+ 51 - 0
tests/tbs/tb0388.pp

@@ -0,0 +1,51 @@
+{ %VERSION=1.1 }
+
+{$ifdef fpc}{$mode objfpc}{$endif}
+type
+  tobj = class
+      procedure proc1 (a: integer);virtual;
+  end;
+
+  tobj1 = class(tobj)
+      procedure proc1 (a: integer);overload;override;
+      procedure proc1 (a: char);overload;
+  end;
+
+  tobj2 = class (tobj1)
+      procedure proc1 (a: integer);override;
+  end;
+
+procedure tobj.proc1 (a: integer);
+begin
+  write('tobj.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+procedure tobj1.proc1 (a: integer);
+begin
+  write('tobj1.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+procedure tobj1.proc1 (a: char);
+begin
+  write('tobj1.proc1(a:char) called: ');
+  writeln (a);
+end;
+
+procedure tobj2.proc1 (a: integer);
+begin
+  write('tobj2.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+var
+    obj1: tobj1;
+    obj2: tobj2;
+begin
+  obj1:=tobj1.create;
+  obj2:=tobj2.create;
+
+  obj2.proc1 (100);
+  obj2.proc1 ('a');
+end.

+ 59 - 0
tests/tbs/tb0389.pp

@@ -0,0 +1,59 @@
+{ %VERSION=1.1 }
+
+{$ifdef fpc}{$mode objfpc}{$endif}
+type
+  tobj = class
+      procedure proc1 (a: integer);overload;virtual;
+      procedure proc1 (a: extended);overload;
+  end;
+
+  tobj1 = class(tobj)
+      procedure proc1 (a: integer);overload;override;
+      procedure proc1 (a: char);overload;
+  end;
+
+  tobj2 = class (tobj1)
+      procedure proc1 (a: integer);override;
+  end;
+
+procedure tobj.proc1 (a: integer);
+begin
+  write('tobj.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+procedure tobj.proc1 (a: extended);
+begin
+  write('tobj.proc1(a:extended) called: ');
+  writeln (a);
+end;
+
+procedure tobj1.proc1 (a: integer);
+begin
+  write('tobj1.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+procedure tobj1.proc1 (a: char);
+begin
+  write('tobj1.proc1(a:char) called: ');
+  writeln (a);
+end;
+
+procedure tobj2.proc1 (a: integer);
+begin
+  write('tobj2.proc1(a:integer) called: ');
+  writeln (a);
+end;
+
+var
+    obj1: tobj1;
+    obj2: tobj2;
+begin
+  obj1:=tobj1.create;
+  obj2:=tobj2.create;
+
+  obj2.proc1 (100);
+  obj2.proc1 ('a');
+  obj2.proc1 (123.456);
+end.

+ 26 - 0
tests/tbs/ub0386.pp

@@ -0,0 +1,26 @@
+{$ifdef fpc}{$mode objfpc}{$endif}
+unit ub0386;
+interface
+
+type
+  tobj = class
+      procedure proc1 (a: integer);overload; virtual;
+  end;
+
+  tobj1 = class(tobj)
+  { this proc1 definition should not been seen by tobj2 }
+  private
+      procedure proc1 (a: char);
+  end;
+
+implementation
+
+procedure tobj.proc1 (a: integer);
+begin
+end;
+
+procedure tobj1.proc1 (a: char);
+begin
+end;
+
+end.