소스 검색

*** empty log message ***

pierre 25 년 전
부모
커밋
f0ae56bc9c
2개의 변경된 파일182개의 추가작업 그리고 0개의 파일을 삭제
  1. 52 0
      tests/webtbf/tbug807.pp
  2. 130 0
      tests/webtbs/tbug736.pp

+ 52 - 0
tests/webtbf/tbug807.pp

@@ -0,0 +1,52 @@
+{$mode objfpc}
+
+Program test;
+
+uses crt;
+
+type
+  TMatrix = class
+              Constructor Create;
+            private
+              Elements : array [1..10,1..10] of real;
+            end;
+
+Constructor TMatrix.Create;
+
+begin
+end;
+
+OPERATOR :=(r:Real):TMatrix;
+  BEGIN
+    WITH RESULT DO
+      BEGIN
+{ Do something }
+      END;
+    writeln ('Call to overloaded operator :=, real operand');
+  END;
+operator :=(m : TMatrix):TMatrix;
+  BEGIN
+    WITH RESULT DO
+      BEGIN
+{ Do something }
+      END;
+    writeln ('Call to overloaded operator :=, matrix operand');
+  END;
+
+var
+  m : TMatrix;
+  m2 : TMatrix;
+
+begin
+  clrscr;
+  writeln ('Performing calculations...');
+  m:=TMatrix.Create;
+  m2:=TMatrix.Create;
+  writeln ('Assigning real to matrix...');
+{ This one works }
+  m:=1;
+  writeln ('Assigning matrix to matrix...');
+{ This one does not work }
+  m:=m2;
+  writeln ('Done.');
+end.

+ 130 - 0
tests/webtbs/tbug736.pp

@@ -0,0 +1,130 @@
+{$ifdef FPC}
+{$ASMMODE INTEL}
+{$INLINE ON}
+{$endif FPC}
+
+program test;
+
+type
+   tobj = object
+     x : word;
+     constructor init;
+     procedure test;virtual;
+     procedure testx;
+     end;
+
+constructor tobj.init;
+begin
+  x:=1;
+end;
+
+procedure tobj.testx;
+begin
+  asm
+    mov ax,3
+    mov word ptr[x],ax
+  end;
+end;
+
+procedure tobj.test;
+var
+  pattern: word;
+  dummyval : word;
+
+  function rotate: boolean; assembler; {$ifdef FPC}inline;{$endif FPC}
+  asm
+    mov al,0
+    rol word ptr [pattern],1
+    rcl al,1
+  end;
+
+{ this does still not work because
+  it can only work as inline not as normal sub function
+  because dummyval and pattern are not reachable !! PM
+  function rotateb(dummy : byte) : boolean; assembler; inline;
+  asm
+    movzx byte ptr [dummy],ax
+    mov ax,word ptr [dummyval]
+    mov al,0
+    rol word ptr [pattern],1
+    rcl al,1
+  end; }
+
+var
+  i : byte;
+
+begin
+  pattern:= $a0a0;
+  for i:=1 to 16 do
+   begin
+     Write('obj pattern = ',
+       {$ifdef FPC}
+       hexstr(pattern,4),' ');
+       {$else}
+       pattern,' ');
+       {$endif}
+     if rotate then
+       Writeln('bit found')
+     else
+       Writeln('no bit found');
+   end;
+end;
+
+procedure changepattern;
+var
+  pattern: word;
+  dummyval : word;
+
+  function rotate: boolean; assembler; {$ifdef FPC}inline;{$endif FPC}
+  asm
+    mov al,0
+    rol word ptr [pattern],1
+    rcl al,1
+  end;
+
+{ this does still not work because
+  it can only work as inline not as normal sub function
+  because dummyval and pattern are not reachable !! PM
+  function rotateb(dummy : byte) : boolean; assembler; inline;
+  asm
+    movzx byte ptr [dummy],ax
+    mov ax,word ptr [dummyval]
+    mov al,0
+    rol word ptr [pattern],1
+    rcl al,1
+  end; }
+
+var
+  i : byte;
+
+begin
+  pattern:= $a0a0;
+  for i:=1 to 16 do
+   begin
+     Write('pattern = ',
+       {$ifdef FPC}
+       hexstr(pattern,4),' ');
+       {$else}
+       pattern,' ');
+       {$endif}
+     if rotate then
+       Writeln('bit found')
+     else
+       Writeln('no bit found');
+   end;
+end;
+
+var
+
+  t : tobj;
+begin
+  changepattern;
+  t.init;
+  t.test;
+  t.testx;
+  if t.x<>3 then
+    begin
+      Writeln('Unable to access object fields in assembler');
+      Halt(1);
+    end;
+end.