+ added a makefile for tests

  + uses getref  for extracting error code
  + required command lines args can be place in the first line of
    source code
    following $OPT=

tests/getret.pp

@@ -0,0 +1,51 @@
+
+{ return the error code of the compiled file }
+{ checks also if first line of source contains
+  $OPT= command line options needed }
+program getret;
+
+ uses dos;
+
+  var com,args : string;
+      filename,firstline : string;
+      i : byte;	
+      ppfile, retfile : text;	
+
+begin
+  assign(retfile,'retcode');
+  rewrite(retfile);
+  args:='';
+  if paramcount>1 then
+    begin
+       filename:=paramstr(paramcount);
+       if pos('.',filename)=0 then
+         filename:=filename+'.pp';
+       assign(ppfile,filename);
+       reset(ppfile);
+       readln(ppfile,firstline);
+       if pos('$OPT=',firstline)>0 then
+         args:=copy(Firstline,pos('=',Firstline)+1,255);
+       if pos('}',args)>0 then
+         args:=copy(args,1,pos('}',args)-1);	
+       close(ppfile);
+    end;			
+  for i:=2 to paramcount do
+    args:=args+' '+paramstr(i);
+  com:=paramstr(1);
+{$ifndef linux}
+  if pos('.',com)=0 then
+    com:=com+'.exe';
+{$endif not linux}
+
+  com:=fsearch(com,getenv('PATH'));
+  Writeln('Executing "',com,' ',args,'"');
+  Flush(output);
+  swapvectors;
+  exec(com,args);
+  swapvectors;
+  if doserror<>0 then
+    write(retfile,512+doserror)
+  else
+    write(retfile,dosexitcode);
+  close(retfile);
+end.

tests/makefile

@@ -0,0 +1,102 @@
+
+# make all test
+# and printout errors
+
+all : clean allts alltf allto
+	grep -n -i fails log
+
+# returns the error code 
+# of the command line
+# in file retcode
+
+ifdef DJGPP
+getreturncode : 
+	redir -e $(FILE).log -o $(FILE).log getret $(COMMAND)
+else
+getreturncode : 
+	getret $(COMMAND) !> $(FILE).log !2>$(FILE).log
+endif
+	
+
+RETCODE=$(wildcard retcode*)
+
+# retcode should be between 0 and 255
+# 256 is for halt
+# 512+doserror if doserror<>0
+ifdef RESFILE
+RETVAL=$(shell cat $(RESFILE))
+else
+ifdef RETCODE
+RETVAL=$(shell cat retcode)
+else
+RETVAL=1024
+endif
+endif
+
+printretcode:
+	echo Return code of $(FILE) is $(RETVAL)
+
+ifeq ($(RETVAL),0)
+testsuccess:
+	echo Test for $(FILE) success (compiles)
+	echo Test for $(FILE) success (compiles) >>log
+else
+testsuccess:
+	echo Test for $(FILE) fails (does not compile) error $(RETVAL)
+	echo Test for $(FILE) fails (does not compile) error $(RETVAL)>>log
+	echo $(FILE) >> faillist
+endif
+	
+ifneq ($(RETVAL),0)
+testfail:
+	echo Test for $(FILE) success (does not compile) error $(RETVAL)
+	echo Test for $(FILE) success (does not compile) error $(RETVAL)>> log
+else
+testfail:
+	echo Test for $(FILE) fails (does compile and should not)
+	echo Test for $(FILE) fails (does compile and should not) >> log
+	echo $(FILE) >> faillist
+endif
+	
+ifndef PP
+PP=ppc386
+endif
+
+ifndef OPT
+OPT=
+endif
+
+ifdef FILE
+OPTFILE=$(wildcard $(FILE).opt)
+endif
+
+ifdef OPTFILE
+override OPT+=$(OPTFILE)
+endif
+
+ifndef FILE
+FILE=ts00001.pp
+endif
+
+testone :
+	make getreturncode 'COMMAND=$(PP) $(OPT) $(FILE).pp'
+	make printretcode 'FILE=$(FILE)'
+
+%.res : %.pp
+	make testone 'FILE=$*'
+	cat retcode > $*.res
+	make testsuccess 'FILE=$*' 'RESFILE=$*.res'
+
+%.ref : %.pp
+	make testone 'FILE=$*'
+	cat retcode > $*.ref
+	make testfail 'FILE=$*' 'RESFILE=$*.ref'
+
+allts : $(patsubst %.pp,%.res,$(wildcard ts*.pp))
+
+alltf : $(patsubst %.pp,%.ref,$(wildcard tf*.pp))
+
+allto : $(patsubst %.pp,%.res,$(wildcard to*.pp))
+
+clean :
+	-rm *.re* log faillist

tests/tf000001.pp

@@ -0,0 +1,11 @@
+
+type
+  r=record
+    a :longint;
+  end;
+var
+  w : ^r;
+begin
+  if w^<>$1111 then
+   writeln;
+end.

tests/ts010000.pp

@@ -2,18 +2,18 @@ type
    tobject1 = class
       readl : longint;
       function readl2 : longint;
-      procedure writel(l : longint);
-      procedure writel2(l : longint);
+      procedure writel(ll : longint);
+      procedure writel2(ll : longint);
       property l : longint read readl write writel;
       property l2 : longint read readl2 write writel2;
    end;
 
-procedure tobject1.writel(l : longint);
+procedure tobject1.writel(ll : longint);
 
   begin
   end;
 
-procedure tobject1.writel2(l : longint);
+procedure tobject1.writel2(ll : longint);
 
   begin
   end;

tests/ts010001.pp

@@ -1,3 +1,5 @@
+{ $OPT=-S2
+}
 type
    tclass = class of tobject;
 

tests/ts010002.pp

@@ -1,4 +1,4 @@
-
+{ $OPT=-S2 }
 
 {
     $Id$
@@ -22,6 +22,8 @@
 
 Unit Classes;
 
+{$M+}
+
 Interface 
 
 Type

tests/ts010006.pp

@@ -1,3 +1,4 @@
+{ $OPT=-S2 }
 library test;
 
   procedure exporttest;export;

tests/ts010008.pp

@@ -1,3 +1,5 @@
+{ $OPT=-S2 }
+
 type
    tobject2 = class
       constructor create;

tests/ts010100.pp

@@ -1,3 +1,5 @@
+{ $OPT= -S2
+}
 var
    o : tobject;
 

tests/ts010101.pp

@@ -1,3 +1,5 @@
+{ $OPT=-S2
+}
 { tests assignements and compare }
 
 var