mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 07:43:04 +01:00 
			
		
		
		
	* some small fixes
+ added several new tests
This commit is contained in:
		
							parent
							
								
									a06d35ef82
								
							
						
					
					
						commit
						f274f1baad
					
				@ -1,4 +1,5 @@
 | 
			
		||||
{ %version=1.1 }
 | 
			
		||||
{ %fail }
 | 
			
		||||
{ Interfaces only supported in v1.1 }
 | 
			
		||||
{ Should give the same error as /tbf/tb0125.pp }
 | 
			
		||||
{$ifdef fpc}
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										24
									
								
								tests/tbf/tb0144.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										24
									
								
								tests/tbf/tb0144.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,24 @@
 | 
			
		||||
{ %FAIL }
 | 
			
		||||
 | 
			
		||||
{ OpenString with high should not be allowed }
 | 
			
		||||
program tb0144;
 | 
			
		||||
 | 
			
		||||
procedure TestOpen(var s: OpenString); cdecl;
 | 
			
		||||
var
 | 
			
		||||
 b: byte;
 | 
			
		||||
begin
 | 
			
		||||
 b:=high(s); 
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
Begin
 | 
			
		||||
end.
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
   $Log$
 | 
			
		||||
   Revision 1.1  2002-11-26 19:24:30  carl
 | 
			
		||||
     * some small fixes
 | 
			
		||||
     + added several new tests
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
							
								
								
									
										25
									
								
								tests/tbf/tb0145.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										25
									
								
								tests/tbf/tb0145.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,25 @@
 | 
			
		||||
{ %FAIL }
 | 
			
		||||
 | 
			
		||||
{ This should fail compilation because open parameters are not 
 | 
			
		||||
  allowed with cdecl'ed routines.
 | 
			
		||||
}
 | 
			
		||||
 | 
			
		||||
procedure TestOpen(var s: array of byte); cdecl;
 | 
			
		||||
var
 | 
			
		||||
 b: byte;
 | 
			
		||||
begin
 | 
			
		||||
 b:=high(s); 
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
Begin
 | 
			
		||||
end.
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
   $Log$
 | 
			
		||||
   Revision 1.1  2002-11-26 19:24:30  carl
 | 
			
		||||
     * some small fixes
 | 
			
		||||
     + added several new tests
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
							
								
								
									
										31
									
								
								tests/tbf/tb0146.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										31
									
								
								tests/tbf/tb0146.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,31 @@
 | 
			
		||||
{ %VERSION=1.1 }
 | 
			
		||||
{ %FAIL }
 | 
			
		||||
{ %OPT=-Sew -vw }
 | 
			
		||||
{$MODE OBJFPC}
 | 
			
		||||
type
 | 
			
		||||
  tmyclass = class
 | 
			
		||||
   procedure myabstract; virtual; abstract;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
  tmyclass2 = class(tmyclass)
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
  tmyclassnode = class of tmyclass;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
 cla : tmyclass2;
 | 
			
		||||
 cla1 : tmyclass;
 | 
			
		||||
 classnode : tmyclassnode;
 | 
			
		||||
Begin
 | 
			
		||||
 cla := tmyclass2.create;
 | 
			
		||||
 classnode := tmyclass2;
 | 
			
		||||
 cla1 := classnode.create;
 | 
			
		||||
end.
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
  $Log$
 | 
			
		||||
  Revision 1.1  2002-11-26 19:24:30  carl
 | 
			
		||||
    * some small fixes
 | 
			
		||||
    + added several new tests
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
							
								
								
									
										31
									
								
								tests/tbf/tb0147.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										31
									
								
								tests/tbf/tb0147.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,31 @@
 | 
			
		||||
{ %VERSION=1.1 }
 | 
			
		||||
{ %FAIL }
 | 
			
		||||
{ %OPT=-Sew -vw }
 | 
			
		||||
{$MODE OBJFPC}
 | 
			
		||||
type
 | 
			
		||||
  tmyclass = class
 | 
			
		||||
   procedure myabstract; virtual; abstract;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
  tmyclass2 = class(tmyclass)
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
  tmyclassnode = class of tmyclass;
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
 cla : tmyclass2;
 | 
			
		||||
 cla1 : tmyclass;
 | 
			
		||||
 classnode : tmyclassnode;
 | 
			
		||||
Begin
 | 
			
		||||
 cla := tmyclass2.create;
 | 
			
		||||
 classnode := tmyclass2;
 | 
			
		||||
 cla1 := classnode.create;
 | 
			
		||||
end.
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
  $Log$
 | 
			
		||||
  Revision 1.1  2002-11-26 19:24:30  carl
 | 
			
		||||
    * some small fixes
 | 
			
		||||
    + added several new tests
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
							
								
								
									
										39
									
								
								tests/tbf/tb0148.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										39
									
								
								tests/tbf/tb0148.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,39 @@
 | 
			
		||||
{ %VERSION=1.1 }
 | 
			
		||||
{ %FAIL }
 | 
			
		||||
{ %OPT=-Sew -vw }
 | 
			
		||||
 | 
			
		||||
{$MODE OBJFPC}
 | 
			
		||||
 | 
			
		||||
{ This tests that non-implemented abstract methods which are
 | 
			
		||||
  overloaded (but not in all cases) will still give out a 
 | 
			
		||||
  warning
 | 
			
		||||
 }
 | 
			
		||||
type
 | 
			
		||||
  tmyclass = class
 | 
			
		||||
   procedure myabstract(x: integer); virtual; abstract;
 | 
			
		||||
   procedure myabstract(z: byte); virtual; abstract;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
  tmyclass2 = class(tmyclass)
 | 
			
		||||
   procedure myabstract(x: integer) ; override;
 | 
			
		||||
  end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
  procedure tmyclass2.myabstract(x: integer); 
 | 
			
		||||
   begin
 | 
			
		||||
   end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
var
 | 
			
		||||
 cla : tmyclass2;
 | 
			
		||||
Begin
 | 
			
		||||
 cla := tmyclass2.create;
 | 
			
		||||
end.
 | 
			
		||||
 | 
			
		||||
{
 | 
			
		||||
  $Log$
 | 
			
		||||
  Revision 1.1  2002-11-26 19:24:30  carl
 | 
			
		||||
    * some small fixes
 | 
			
		||||
    + added several new tests
 | 
			
		||||
 | 
			
		||||
}
 | 
			
		||||
							
								
								
									
										27
									
								
								tests/tbf/tb0149.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										27
									
								
								tests/tbf/tb0149.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,27 @@
 | 
			
		||||
{ %VERSION=1.1 }
 | 
			
		||||
{ %FAIL }
 | 
			
		||||
{ %OPT=-Sew -vw }
 | 
			
		||||
 | 
			
		||||
uses ub0149;
 | 
			
		||||
 | 
			
		||||
  
 | 
			
		||||
  
 | 
			
		||||
procedure testdef1(b: tdefinition);
 | 
			
		||||
begin
 | 
			
		||||
  b:=12;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
type
 | 
			
		||||
  tdefinition = 1..10;
 | 
			
		||||
  
 | 
			
		||||
procedure testdef2(b : tdefinition);
 | 
			
		||||
begin
 | 
			
		||||
  b:=10;
 | 
			
		||||
end;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
Begin
 | 
			
		||||
  testdef1(0);
 | 
			
		||||
  testdef2(0);
 | 
			
		||||
end.
 | 
			
		||||
							
								
								
									
										12
									
								
								tests/tbf/ub0149.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										12
									
								
								tests/tbf/ub0149.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,12 @@
 | 
			
		||||
unit ub0149;
 | 
			
		||||
 | 
			
		||||
interface
 | 
			
		||||
 | 
			
		||||
type
 | 
			
		||||
  tdefinition = 1..10;
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
implementation
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
end.
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user