Browse Source

* more tests

peter 24 years ago
parent
commit
3b7b4ab99c
5 changed files with 176 additions and 71 deletions
  1. 19 14
      tests/Makefile
  2. 32 0
      tests/tbs/tb0340.pp
  3. 30 0
      tests/tbs/tb0341.pp
  4. 19 57
      tests/units/Makefile
  5. 76 0
      tests/webtbf/tw1397.pp

+ 19 - 14
tests/Makefile

@@ -1,22 +1,29 @@
 #
-# Don't edit, this file is generated by fpcmake v1.99.0 [2001/02/02]
+# Don't edit, this file is generated by fpcmake v1.99.0 [2001/02/20]
 #
 default: allexectests
 override PATH:=$(subst \,/,$(PATH))
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH=$(subst :, ,$(PATH))
+else
+SEARCHPATH=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
 ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
 ifeq ($(PWD),)
 nopwd:
 	@echo You need the GNU utils package to use this Makefile!
 	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
 	@exit
 else
-inUnix=1
 PWD:=$(firstword $(PWD))
+SRCEXEEXT=
 endif
 else
 PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
 endif
 ifndef inUnix
 ifeq ($(OS),Windows_NT)
@@ -26,11 +33,10 @@ ifdef OS2_SHELL
 inOS2=1
 endif
 endif
-endif
-ifdef inUnix
-SRCEXEEXT=
 else
-SRCEXEEXT=.exe
+ifneq ($(findstring cygwin,$(MACH_TYPE)),)
+inCygWin=1
+endif
 endif
 ifdef inUnix
 BATCHEXT=.sh
@@ -46,11 +52,6 @@ PATHSEP=/
 else
 PATHSEP=$(subst /,\,/)
 endif
-ifdef inUnix
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
 ifdef PWD
 BASEDIR:=$(shell $(PWD))
 else
@@ -178,7 +179,7 @@ endif
 ifndef LD
 LD=ld
 endif
-PPAS=$(BATCHEXT)
+PPAS=ppas$(BATCHEXT)
 ifdef inUnix
 LDCONFIG=ldconfig
 else
@@ -321,6 +322,7 @@ ifeq ($(OS_TARGET),os2)
 PPUEXT=.ppo
 ASMEXT=.so2
 OEXT=.oo2
+AOUTEXT=.out
 SMARTEXT=.so
 STATICLIBEXT=.ao2
 SHAREDLIBEXT=.dll
@@ -644,6 +646,9 @@ endif
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 	-$(DELTREE) *$(SMARTEXT)
 	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
 .PHONY: fpc_info
 fpc_info:
 	@$(ECHO)

+ 32 - 0
tests/tbs/tb0340.pp

@@ -0,0 +1,32 @@
+{$mode objfpc}
+var
+  v : tvarrec;
+  error : boolean;
+procedure p(a:array of const);
+var
+  i : integer;
+begin
+  for i:=low(a) to high(a) do
+   with a[i] do
+    begin
+      case vtype of
+        vtInteger :
+          begin
+            writeln('Integer: ',VInteger);
+            if VInteger=1000 then
+             Error:=false;
+          end;
+        else
+          writeln('Error!');
+      end;
+    end;
+end;
+
+begin
+  error:=true;
+  v.vtype:=vtInteger;
+  v.VInteger:=1000;
+  p(v);
+  if Error then
+   Halt(1);
+end.

+ 30 - 0
tests/tbs/tb0341.pp

@@ -0,0 +1,30 @@
+{ %cpu=i386 }
+program test_assembler;
+
+procedure test_att;
+begin
+{$asmmode att}
+ asm
+   ret
+   lret
+   iret
+   iretw
+ end;
+end;
+
+procedure test_intel;
+begin
+{$asmmode intel}
+ asm
+   ret
+   retf
+   retn
+   iret
+   iretd
+   iretw
+ end;
+end;
+
+begin
+  Writeln('This is just to test special assembler instructions');
+end.

+ 19 - 57
tests/units/Makefile

@@ -1,22 +1,29 @@
 #
-# Don't edit, this file is generated by fpcmake v1.99.0 [2001/02/02]
+# Don't edit, this file is generated by fpcmake v1.99.0 [2001/02/20]
 #
 default: all
 override PATH:=$(subst \,/,$(PATH))
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH=$(subst :, ,$(PATH))
+else
+SEARCHPATH=$(subst ;, ,$(PATH))
+endif
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
 ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
 ifeq ($(PWD),)
 nopwd:
 	@echo You need the GNU utils package to use this Makefile!
 	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
 	@exit
 else
-inUnix=1
 PWD:=$(firstword $(PWD))
+SRCEXEEXT=
 endif
 else
 PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
 endif
 ifndef inUnix
 ifeq ($(OS),Windows_NT)
@@ -26,11 +33,10 @@ ifdef OS2_SHELL
 inOS2=1
 endif
 endif
-endif
-ifdef inUnix
-SRCEXEEXT=
 else
-SRCEXEEXT=.exe
+ifneq ($(findstring cygwin,$(MACH_TYPE)),)
+inCygWin=1
+endif
 endif
 ifdef inUnix
 BATCHEXT=.sh
@@ -46,11 +52,6 @@ PATHSEP=/
 else
 PATHSEP=$(subst /,\,/)
 endif
-ifdef inUnix
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
 ifdef PWD
 BASEDIR:=$(shell $(PWD))
 else
@@ -179,7 +180,7 @@ endif
 ifndef LD
 LD=ld
 endif
-PPAS=$(BATCHEXT)
+PPAS=ppas$(BATCHEXT)
 ifdef inUnix
 LDCONFIG=ldconfig
 else
@@ -322,6 +323,7 @@ ifeq ($(OS_TARGET),os2)
 PPUEXT=.ppo
 ASMEXT=.so2
 OEXT=.oo2
+AOUTEXT=.out
 SMARTEXT=.so
 STATICLIBEXT=.ao2
 SHAREDLIBEXT=.dll
@@ -418,49 +420,6 @@ endif
 ifndef INSTALL_DATADIR
 INSTALL_DATADIR=$(INSTALL_BASEDIR)
 endif
-ifeq ($(OS_TARGET),linux)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),go32v2)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),win32)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),os2)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifeq ($(OS_TARGET),freebsd)
-REQUIRE_PACKAGES_RTL=1
-endif
-ifdef REQUIRE_PACKAGES_RTL
-PACKAGEDIR_RTL:=$(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))
-ifneq ($(PACKAGEDIR_RTL),)
-PACKAGEDIR_RTL:=$(firstword $(PACKAGEDIR_RTL))
-ifeq ($(wildcard $(PACKAGEDIR_RTL)/$(FPCMADE)),)
-override COMPILEPACKAGES+=package_rtl
-package_rtl:
-	$(MAKE) -C $(PACKAGEDIR_RTL) all
-endif
-ifneq ($(wildcard $(PACKAGEDIR_RTL)/$(OS_TARGET)),)
-UNITDIR_RTL=$(PACKAGEDIR_RTL)/$(OS_TARGET)
-else
-UNITDIR_RTL=$(PACKAGEDIR_RTL)
-endif
-else
-PACKAGEDIR_RTL=
-UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
-ifneq ($(UNITDIR_RTL),)
-UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
-else
-UNITDIR_RTL=
-endif
-endif
-ifdef UNITDIR_RTL
-override COMPILER_UNITDIR+=$(UNITDIR_RTL)
-endif
-endif
-.PHONY: package_rtl
 override FPCOPTDEF=$(CPU_TARGET)
 ifneq ($(OS_TARGET),$(OS_SOURCE))
 override FPCOPT+=-T$(OS_TARGET)
@@ -696,6 +655,9 @@ endif
 	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
 	-$(DELTREE) *$(SMARTEXT)
 	-$(DEL) $(FPCMADE) $(PPAS) link.res $(FPCEXTFILE) $(REDIRFILE)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
 .PHONY: fpc_info
 fpc_info:
 	@$(ECHO)

+ 76 - 0
tests/webtbf/tw1397.pp

@@ -0,0 +1,76 @@
+{ %fail% }
+
+uses
+  Objects;
+
+var
+  Coll  : PCollection;
+  Thing : PObject;
+
+  Line1 : String;                            {*** This is a global variable ***}
+
+
+procedure Zero;
+
+  var
+    Line2 : String;                           {*** This is a local variable ***}
+
+  procedure Two (Thing: PObject);
+  begin
+    Line1 := 'BBB';
+    Line2 := 'BBB';
+
+    WriteLn('2: ', Line1, ' * ', Line2);                 {*** Output line 2 ***}
+    if Line2<>'BBB' then
+     begin
+       writeln('ERROR!');
+       halt(1);
+     end;
+  end;
+
+  procedure One (Thing: PObject);
+
+    procedure LocalTwo (Thing: PObject);
+    begin
+      Line1 := 'BBB';
+      Line2 := 'BBB';
+
+      WriteLn('2: ', Line1, ' * ', Line2);                 {*** Output line 2 ***}
+      if Line2<>'BBB' then
+       begin
+         writeln('ERROR!');
+         halt(1);
+       end;
+    end;
+
+  begin
+    Line1 := 'AAA';
+    Line2 := 'AAA';
+
+    WriteLn('1: ', Line1, ' * ', Line2);                 {*** Output line 1 ***}
+
+    Coll^.ForEach(@LocalTwo);
+
+    WriteLn('3: ', Line1, ' * ', Line2);                 {*** Output line 3 ***}
+    if Line2<>'BBB' then
+     begin
+       writeln('ERROR!');
+       halt(1);
+     end;
+  end;
+                                         {*** I expected that output line 3 ***}
+begin                                    {*** would be the same as output   ***}
+  Coll^.ForEach(@One);                   {*** line 2. It is not.            ***}
+end;
+
+
+begin
+  New(Coll, Init(1, 1));
+
+  New(Thing, Init);
+  Coll^.Insert(Thing);
+
+  Zero;
+
+  Dispose(Coll, Done);
+end.