mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 10:39:40 +01:00 
			
		
		
		
	Test from Giulio Bernardi for bug #10791 (which was fixed in rev 10535)
git-svn-id: trunk@10569 -
This commit is contained in:
		
							parent
							
								
									cb849fd87e
								
							
						
					
					
						commit
						e464a24c47
					
				
							
								
								
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								.gitattributes
									
									
									
									
										vendored
									
									
								
							@ -8088,6 +8088,7 @@ tests/webtbs/tw10753a.pp svneol=native#text/plain
 | 
			
		||||
tests/webtbs/tw10757.pp svneol=native#text/plain
 | 
			
		||||
tests/webtbs/tw10768.pp svneol=native#text/plain
 | 
			
		||||
tests/webtbs/tw10790.pp svneol=native#text/plain
 | 
			
		||||
tests/webtbs/tw10791.pp svneol=native#text/plain
 | 
			
		||||
tests/webtbs/tw10800.pp svneol=native#text/plain
 | 
			
		||||
tests/webtbs/tw10807.pp svneol=native#text/plain
 | 
			
		||||
tests/webtbs/tw1081.pp svneol=native#text/plain
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										54
									
								
								tests/webtbs/tw10791.pp
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										54
									
								
								tests/webtbs/tw10791.pp
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,54 @@
 | 
			
		||||
{$ifdef FPC}{$mode objfpc}{$h+}{$endif}
 | 
			
		||||
{$ifdef mswindows}{$apptype console}{$endif}
 | 
			
		||||
uses
 | 
			
		||||
 sysutils,classes;
 | 
			
		||||
type
 | 
			
		||||
 ttestclass = class(tcomponent)
 | 
			
		||||
  private
 | 
			
		||||
   frealprop: real;
 | 
			
		||||
  published
 | 
			
		||||
   property realprop: real read frealprop write frealprop;
 | 
			
		||||
 end;
 | 
			
		||||
var
 | 
			
		||||
 instance1,instance2: ttestclass;
 | 
			
		||||
 stream1,stream2: tmemorystream;
 | 
			
		||||
begin
 | 
			
		||||
 instance1:= ttestclass.create(nil);
 | 
			
		||||
 instance2:= ttestclass.create(nil);
 | 
			
		||||
 stream1:= tmemorystream.create;
 | 
			
		||||
 stream2:= tmemorystream.create;
 | 
			
		||||
 try
 | 
			
		||||
  instance1.realprop:= 1e100;
 | 
			
		||||
  stream1.writecomponent(instance1);
 | 
			
		||||
  stream1.position:= 0;
 | 
			
		||||
  objectbinarytotext(stream1,stream2);
 | 
			
		||||
  stream2.position:= 0;
 | 
			
		||||
  stream1.clear;
 | 
			
		||||
  objecttexttobinary(stream2,stream1);
 | 
			
		||||
  stream1.position:= 0;
 | 
			
		||||
  stream1.readcomponent(instance2);
 | 
			
		||||
  writeln('instance1: ',instance1.realprop,' instance2: ',instance2.realprop);
 | 
			
		||||
  if instance1.realprop<>instance2.realprop then
 | 
			
		||||
    halt(1);
 | 
			
		||||
 | 
			
		||||
  stream1.clear;
 | 
			
		||||
  stream2.clear;
 | 
			
		||||
  instance1.realprop:= 1;
 | 
			
		||||
  stream1.writecomponent(instance1);
 | 
			
		||||
  stream1.position:= 0;
 | 
			
		||||
  objectbinarytotext(stream1,stream2);
 | 
			
		||||
  stream2.position:= 0;
 | 
			
		||||
  stream1.clear;
 | 
			
		||||
  objecttexttobinary(stream2,stream1);
 | 
			
		||||
  stream1.position:= 0;
 | 
			
		||||
  stream1.readcomponent(instance2);
 | 
			
		||||
  writeln('instance1: ',instance1.realprop,' instance2: ',instance2.realprop);
 | 
			
		||||
  if instance1.realprop<>instance2.realprop then
 | 
			
		||||
    halt(1);
 | 
			
		||||
finally
 | 
			
		||||
  instance1.free;
 | 
			
		||||
  instance2.free;
 | 
			
		||||
  stream1.free;
 | 
			
		||||
  stream2.free;
 | 
			
		||||
 end;
 | 
			
		||||
end.
 | 
			
		||||
		Loading…
	
		Reference in New Issue
	
	Block a user