mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 03:11:39 +01:00 
			
		
		
		
	+ 266-269
This commit is contained in:
		
							parent
							
								
									4e6bcf9ed7
								
							
						
					
					
						commit
						b37b9853ec
					
				
							
								
								
									
										16
									
								
								bugs/bug0266.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										16
									
								
								bugs/bug0266.pp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,16 @@ | |||||||
|  | PROGRAM t10; | ||||||
|  | 
 | ||||||
|  | USES CRT; | ||||||
|  | 
 | ||||||
|  | VAR S: STRING; | ||||||
|  |     X: BYTE; | ||||||
|  |      | ||||||
|  |      | ||||||
|  |     BEGIN | ||||||
|  |        S := ''; | ||||||
|  |           FOR X := 1 TO 253 DO S:=S+'-'; | ||||||
|  | 	     S := S+'_!'; | ||||||
|  | 	        WRITE(S); | ||||||
|  | 		   WRITE('*',S); | ||||||
|  | 		   END. | ||||||
|  | 		    | ||||||
							
								
								
									
										26
									
								
								bugs/bug0267.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										26
									
								
								bugs/bug0267.pp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,26 @@ | |||||||
|  | {$MODE objfpc} | ||||||
|  | 
 | ||||||
|  | program procofobject_arg; | ||||||
|  | type | ||||||
|  |   TProcOfObject = procedure of object; | ||||||
|  |   TTestClass = class | ||||||
|  |     procedure SomeMethod; | ||||||
|  |   end; | ||||||
|  | 
 | ||||||
|  | procedure TTestClass.SomeMethod; begin end; | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | // the following proc won't print i2 correctly | ||||||
|  | 
 | ||||||
|  | procedure CrashProc(i1: Integer;method: TProcOfObject; i2: Integer); | ||||||
|  | begin | ||||||
|  |   WriteLn('i1 is :', i1); | ||||||
|  |   WriteLn('i2 is :', i2); | ||||||
|  | end; | ||||||
|  | 
 | ||||||
|  | var | ||||||
|  |   instance: TTestClass; | ||||||
|  | begin | ||||||
|  |   instance := TTestClass.Create; | ||||||
|  |   CrashProc(123, @instance.SomeMethod, 456); | ||||||
|  | end. | ||||||
							
								
								
									
										28
									
								
								bugs/bug0268.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										28
									
								
								bugs/bug0268.pp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,28 @@ | |||||||
|  | PROGRAM Test2; {$MODE DELPHI} | ||||||
|  | 
 | ||||||
|  | USES SysUtils;  // Dos for DosError because FindFirst is not a Function? | ||||||
|  | 
 | ||||||
|  | PROCEDURE DirList; | ||||||
|  | (* Show all Files, gives me "unhandled exception occurred at xxx, access | ||||||
|  |    violation" after inserting Try Except it worked but i got a "forever | ||||||
|  |    scrolling screen", then i inserted raise and got a correct "Exception | ||||||
|  |    in FindFirst" and "At end of ExceptionAddressStack" | ||||||
|  |    Next i inserted the ON E:EXCEPTION and ,E.Message an got 9999 *) | ||||||
|  | VAR SR : TSearchRec; | ||||||
|  | BEGIN | ||||||
|  |   TRY | ||||||
|  |     FindFirst ('*',faAnyFile,SR);  // why not a function ? | ||||||
|  |   EXCEPT | ||||||
|  |     ON E:EXCEPTION DO | ||||||
|  |       WriteLn ('Exception in FindFirst !-', E.Message); | ||||||
|  |   END; | ||||||
|  |   repeat | ||||||
|  |     Write (SR.Name,' '); | ||||||
|  |   until FindNext (SR)<>0; | ||||||
|  |   FindClose (SR);                  // and this is Delphi ? | ||||||
|  | END; | ||||||
|  | 
 | ||||||
|  | BEGIN | ||||||
|  |   WriteLn ('Hello, this is my first FPC-Program'); | ||||||
|  |   DirList; | ||||||
|  | END. | ||||||
							
								
								
									
										6
									
								
								bugs/bug0269.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										6
									
								
								bugs/bug0269.pp
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,6 @@ | |||||||
|  | { Wrong line number for error message } | ||||||
|  | begin | ||||||
|  |   repeat | ||||||
|  |    writeln('test'); | ||||||
|  |   until sptr; | ||||||
|  | end. | ||||||
| @ -355,4 +355,7 @@ bug0262.pp   problems with virtual and overloaded methods | |||||||
| bug0263.pp   export directive is not necessary in delphi anymore | bug0263.pp   export directive is not necessary in delphi anymore | ||||||
| bug0264.pp   methodpointer bugs | bug0264.pp   methodpointer bugs | ||||||
| bug0265.pp   nested proc with for-counter in other lex level | bug0265.pp   nested proc with for-counter in other lex level | ||||||
|   | bug0266.pp   write cuts 256 char | ||||||
|  | bug0267.pp   parameters after methodpointer are wrong | ||||||
|  | bug0268.pp   crash with exceptions | ||||||
|  | bug0269.pp   wrong linenumber for repeat until when type mismatch | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 peter
						peter