several modifications

tests/makefile

@@ -13,7 +13,8 @@ ifdef DJGPP
 EXEEXT=.exe
 
 getreturncode : 
-	redir -e $(FILE).log -o $(FILE).log getret $(COMMAND)
+	pcs > $(FILE).log
+	redir -ea $(FILE).log -oa $(FILE).log getret $(COMMAND)
 	cp retcode $(FILE).$(RESEXT)
 
 else
@@ -220,7 +221,10 @@ info :
 	@echo run \'make tesiexec\' to test executables 
 	@echo that require interactive mode
 # $Log$
-# Revision 1.10  1999-01-15 17:41:58  pierre
+# Revision 1.11  1999-01-19 17:34:01  pierre
+#  several modifications
+#
+# Revision 1.10  1999/01/15 17:41:58  pierre
 #  + new bugs converted
 #
 # Revision 1.9  1998/11/10 11:13:07  pierre

tests/tbs0075.pp

@@ -1,31 +0,0 @@
-Unit tbs0075;
-
-Interface
-
-
-Procedure MyTest;Far;         { IMPLEMENTATION expected error. }
-
-{ Further information: NEAR IS NOT ALLOWED IN BORLAND PASCAL  }
-{ Therefore the bugfix should only be for the FAR keyword.    }
- Procedure MySecondTest;
-
-Implementation
-
-{ near and far are not allowed here, but maybe we don't care since they are ignored by }
-{ FPC.                                                                                 }
-Procedure MyTest;
-Begin
-end;
-
-Procedure MySecondTest;Far;Forward;
-
-
-Procedure MySecondTest;Far;
-Begin
-end;
-
-
-
-
-
-end.

tests/tbs0150.pp

@@ -1,4 +1,4 @@
-programs bug0150;
+program bug0150;
 {
  bug to show that there is no assert() macro and directive
 }

tests/tbs0155.pp

@@ -1,11 +0,0 @@
-
-function asmstr:string;assembler;
-asm
-	movl	__RESULT,%edi
-	movl	$0x4101,%al
-	stosw
-end;
-
-begin
-  writeln(asmstr);
-end;

tests/tbs0161.pp

@@ -1,11 +0,0 @@
-Program tbs0161;
-
-{the following program should give a syntax error, but causes an internal error}
-
-const s = [1,2,3,4,5];
-
-var b: Byte;
-
-Begin
-  If b in [s] then;
-End.

tests/tbs0191.pp

@@ -6,7 +6,6 @@ type
 
 const
   s  : string = 'test';
-  pc : pchar = @s[1];
 
   cfg : array[1..2] of trec=(
    (a:1;b:2),
@@ -16,5 +15,12 @@ const
 
   l : ^longint = @cfg[1].b; { l^ should be 2 }
 
+  pc : pchar = @s[1];
+
 begin
+  if (l^<>2) or (pc[1]<>'t') then
+    Begin
+       Writeln('Wrong code genrated');
+       RunError(1);
+    End;
 end.

tests/tbs0196.pp

@@ -0,0 +1,13 @@
+{$OPT= -So}
+Unit tbs0196;
+interface
+
+  function a : integer;
+
+implementation
+  function a;
+begin
+  a:=1;
+end;
+
+end.

tests/tbs0199.pp

@@ -0,0 +1,24 @@
+PROGRAM PRTest;
+
+TYPE
+  ptRec = ^tRec;
+  tRec = Record
+           D : DWORD;
+         END;
+
+VAR
+  pR1, pR2 : ptRec;
+BEGIN
+  GetMem(pR1, SizeOf(tRec));
+  GetMem(pR2, SizeOf(tRec));
+
+  pR1^.D := 10;
+  Move(pR1^,pR2^,SizeOf(tRec));
+  WriteLn(pR1^.D:16,pR2^.D:16);
+
+  pR1^.D := 1;
+  pR2^.D := pR1^.D*2;			{ THE BUG IS HERE }
+  WriteLn(pR1^.D:16,pR2^.D:16);
+  if (pR1^.D<>1) or (pR2^.D<>2) then
+    Halt(1);
+END.

tests/tbs0201.pp

@@ -0,0 +1,36 @@
+{ $OPT= -Ratt }
+
+program bug0201;
+
+type rec = record
+         a : DWord;
+         b : Word;
+     end;
+
+function x(r1 : rec; r2 : rec; var r3 : rec); assembler;
+asm
+   movl r3, %edi
+   
+   movl r1.a, %eax
+   addl r2.a, %eax
+   movl %eax, rec.a(%edi)
+
+   movw r1.b, %cx
+   addw r2.b, %cx
+   movw %cx, rec.b(%edi)
+end;
+
+var r1, r2, r3 : rec;
+
+begin
+     r1.a := 100; r1.b := 200;
+     r2.a := 300; r2.b := 400;
+     x(r1, r2, r3);
+     Writeln(r3.a, ' ', r3.b);
+     if (r3.a<>400) or (r3.b<>600) then
+       begin
+          Writeln('Error in assembler code');
+          Halt(1);
+       end;
+end.
+