From ee840b1d9f42bd34c9825b8895a33956d5f080bd Mon Sep 17 00:00:00 2001 From: root Date: Wed, 25 Mar 1998 11:33:02 +0000 Subject: [PATCH] Initial revision --- tests/README | 17 ++++ tests/TS010005.PP | 41 +++++++++ tests/TS010006.PP | 11 +++ tests/TS010007.PP | 43 +++++++++ tests/TS010008.PP | 38 ++++++++ tests/template1.bat | 20 +++++ tests/template2.bat | 15 ++++ tests/testall.bat | 11 +++ tests/ts010000.pp | 34 +++++++ tests/ts010001.pp | 32 +++++++ tests/ts010002.pp | 215 ++++++++++++++++++++++++++++++++++++++++++++ tests/ts010003.pp | 55 ++++++++++++ tests/ts010004.pp | 20 +++++ 13 files changed, 552 insertions(+) create mode 100644 tests/README create mode 100644 tests/TS010005.PP create mode 100644 tests/TS010006.PP create mode 100644 tests/TS010007.PP create mode 100644 tests/TS010008.PP create mode 100644 tests/template1.bat create mode 100644 tests/template2.bat create mode 100644 tests/testall.bat create mode 100644 tests/ts010000.pp create mode 100644 tests/ts010001.pp create mode 100644 tests/ts010002.pp create mode 100644 tests/ts010003.pp create mode 100644 tests/ts010004.pp diff --git a/tests/README b/tests/README new file mode 100644 index 0000000000..e5de32fd7c --- /dev/null +++ b/tests/README @@ -0,0 +1,17 @@ +This directory contains a testsuite for the Free Pascal Compiler. + +Tests starting with 'ts' have to compile and execute. +Tests starting with 'tf' will crash the compiler. + +You can use the batch files to do all tests. testall.bat will compile all +tests. + +template1.bat is a template for compiling tests that have to run and +execute. + +template2.bat is a template for compiling tests that should crash the +compiler. The test is considered passed if the compiler crashes or reports +an error. + + + diff --git a/tests/TS010005.PP b/tests/TS010005.PP new file mode 100644 index 0000000000..1adecfba24 --- /dev/null +++ b/tests/TS010005.PP @@ -0,0 +1,41 @@ +type + tclass1 = class + procedure a;virtual; + procedure b;virtual; + end; + + tclass2 = class(tclass1) + procedure a;override; + procedure b;override; + procedure c;virtual; + end; + + + procedure tclass1.a; + + begin + end; + + procedure tclass1.b; + + begin + end; + + procedure tclass2.a; + + begin + end; + + procedure tclass2.b; + + begin + end; + + + procedure tclass2.c; + + begin + end; + +begin +end. \ No newline at end of file diff --git a/tests/TS010006.PP b/tests/TS010006.PP new file mode 100644 index 0000000000..b5adc2b112 --- /dev/null +++ b/tests/TS010006.PP @@ -0,0 +1,11 @@ +library test; + + procedure exporttest;export; + + begin + end; + + exports exporttest; + +begin +end. diff --git a/tests/TS010007.PP b/tests/TS010007.PP new file mode 100644 index 0000000000..9ee2ffb162 --- /dev/null +++ b/tests/TS010007.PP @@ -0,0 +1,43 @@ +type + tobject2 = class + i : longint; + procedure y; + constructor create; + class procedure x; + class procedure v;virtual; + end; + + procedure tobject2.y; + + begin + end; + + class procedure tobject2.v; + + begin + end; + + class procedure tobject2.x; + + begin + v; + end; + + constructor tobject2.create; + + begin + end; + + type + tclass2 = class of tobject2; + + var + a : class of tobject2; + object2 : tobject2; + +begin + a.x; + tobject2.x; + object2:=tobject2.create; + object2:=a.create; +end. \ No newline at end of file diff --git a/tests/TS010008.PP b/tests/TS010008.PP new file mode 100644 index 0000000000..431cbfb4f9 --- /dev/null +++ b/tests/TS010008.PP @@ -0,0 +1,38 @@ +type + tobject2 = class + constructor create; + function rname : string; + procedure wname(const s : string); + property name : string read rname write wname; + end; + + tclass2 = class of tobject2; + +var + o2 : tobject2; + c2 : tclass2; + +constructor tobject2.create; + + begin + inherited create; + end; + +procedure tobject2.wname(const s : string); + + begin + end; + +function tobject2.rname : string; + + begin + end; + +begin + o2:=tobject2.create; + o2.name:='1234'; + writeln(o2.name); + o2.destroy; + o2:=c2.create; + c2.destroy; +end. \ No newline at end of file diff --git a/tests/template1.bat b/tests/template1.bat new file mode 100644 index 0000000000..88d9ce627d --- /dev/null +++ b/tests/template1.bat @@ -0,0 +1,20 @@ +@echo off +rem +rem Batch file to compile and run NAME +rem +echo Compiling NAME... +ppc386 NAME >nul +if errorlevel 1 goto comfailed +echo compilation of NAME : PASSED +name >nul +if errorlevel 1 goto runfailed +echo execution of NAME : PASSED +goto end +:runfailed +echo execution of NAME : FAILED +:comfailed +echo Compilation of NAME : FAILED +:end + + + diff --git a/tests/template2.bat b/tests/template2.bat new file mode 100644 index 0000000000..9f5ad53d29 --- /dev/null +++ b/tests/template2.bat @@ -0,0 +1,15 @@ +@echo off +rem +rem Batch file to compile NAME. If compilation fails, the test passed. +rem +echo Compiling NAME... +ppc386 NAME >nul +if errorlevel 1 goto compassed +echo Error compilation of NAME : FAILED +goto end +:compassed +echo Error compilation of NAME : PASSED +:end + + + diff --git a/tests/testall.bat b/tests/testall.bat new file mode 100644 index 0000000000..c96b396eca --- /dev/null +++ b/tests/testall.bat @@ -0,0 +1,11 @@ +@echo off +rem This batch script should compile all tests. +rem All tests which should run and be ok. +for %%f in ( ts*.bat ) do command /c %%f +rem All tests which crash the compiler. +for %%f in ( tf*.bat ) do command /c %%f + + + + + \ No newline at end of file diff --git a/tests/ts010000.pp b/tests/ts010000.pp new file mode 100644 index 0000000000..b240c6ba6a --- /dev/null +++ b/tests/ts010000.pp @@ -0,0 +1,34 @@ +type + tobject1 = class + readl : longint; + function readl2 : longint; + procedure writel(l : longint); + procedure writel2(l : longint); + property l : longint read readl write writel; + property l2 : longint read readl2 write writel2; + end; + +procedure tobject1.writel(l : longint); + + begin + end; + +procedure tobject1.writel2(l : longint); + + begin + end; + +function tobject1.readl2 : longint; + + begin + end; + +var + object1 : tobject1; + i : longint; + +begin + i:=object1.l; + i:=object1.l2; + object1.l:=123; +end. \ No newline at end of file diff --git a/tests/ts010001.pp b/tests/ts010001.pp new file mode 100644 index 0000000000..9c5501d3fc --- /dev/null +++ b/tests/ts010001.pp @@ -0,0 +1,32 @@ +type + tclass = class of tobject; + + tmyclass = class of tmyobject; + + tmyobject = class + end; + +{ only a stupid test routine } +function getanchestor(c : tclass) : tclass; + + var + l : longint; + + begin + getanchestor:=tobject; + l:=l+1; + end; + +var + classref : tclass; + myclassref : tmyclass; + +begin + { simple test } + classref:=classref; + { more difficult } + classref:=myclassref; + classref:=tobject; + + classref:=getanchestor(myclassref); +end. \ No newline at end of file diff --git a/tests/ts010002.pp b/tests/ts010002.pp new file mode 100644 index 0000000000..d951911c11 --- /dev/null +++ b/tests/ts010002.pp @@ -0,0 +1,215 @@ + + +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1993,97 by the Free Pascal development team. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} +{ + This unit introduces some basic classes as they are defined in Delphi. + These classes should be source compatible to their Delphi counterparts: + TPersistent + TComponent +} + +Unit Classes; + +Interface + +Type + +{ --------------------------------------------------------------------- + Forward Declarations. + ---------------------------------------------------------------------} + + TComponent = Class; + TFiler = Class; + TPersistent = Class; + +{ --------------------------------------------------------------------- + TFiler + ---------------------------------------------------------------------} + + TFiler = Class (TObject) + Protected + FAncestor : TComponent; + FIgnoreChildren : Boolean; + FRoot : TComponent; + Private + Public + Published + { Methods } + Constructor Create {(Stream : TStream; BufSize : Longint) }; + Destructor Destroy; override; + Procedure FlushBuffer; virtual; abstract; + { Properties } + Property Root : TComponent Read FRoot Write FRoot; + Property Ancestor : TComponent Read FAncestor Write FAncestor; + Property IgnoreChildren : Boolean Read FIgnoreChildren Write FIgnoreChildren; + end; + +{ --------------------------------------------------------------------- + TPersistent + ---------------------------------------------------------------------} + + TPersistent = Class (TObject) + Private + Procedure AssignError (Source : TPersistent); + Protected + Procedure AssignTo (Dest : TPersistent); + Procedure DefineProperties (Filer : TFiler); Virtual; + Public + { Methods } + Destructor Destroy; Override; + Procedure Assign (Source : TPersistent); virtual; + Published + end; + +{ --------------------------------------------------------------------- + TComponent + ---------------------------------------------------------------------} + + TComponentState = Set of ( csLoading, csReading, CsWriting, csDestroying, + csDesigning, csAncestor, csUpdating, csFixups ); + TComponentStyle = set of ( csInheritable,csCheckPropAvail ); + TComponentName = String; + + TComponent = Class (TPersistent) + Protected + FComponentState : TComponentState; + FComponentStyle : TComponentStyle; + FName : TComponentName; + + FOwner : TComponent; + Function GetComponent (Index : Longint) : TComponent; + Function GetComponentCount : Longint; + Function GetComponentIndex : Longint; + Procedure SetComponentIndex (Value : Longint); + Procedure Setname (Value : TComponentName); + Private + Public + { Methods } + { Properties } + Property ComponentCount : Longint Read GetComponentCount; { RO } + Property ComponentIndex : Longint Read GetComponentIndex write SetComponentIndex; { R/W } + // Property Components [Index : LongInt] : TComponent Read GetComponent; { R0 } + Property ComponentState : TComponentState Read FComponentState; { RO } + Property ComponentStyle : TcomponentStyle Read FComponentStyle; { RO } + Property Owner : TComponent Read Fowner; { RO } + Published + Property Name : TComponentName Read FName Write Setname; + end; + + + + +Implementation + +{ --------------------------------------------------------------------- + TComponent + ---------------------------------------------------------------------} + +Function TComponent.GetComponent (Index : Longint) : TComponent; + +begin +end; + + + +Function TComponent.GetComponentCount : Longint; + +begin +end; + + + +Function TComponent.GetComponentIndex : Longint; + +begin +end; + + + +Procedure TComponent.SetComponentIndex (Value : Longint); + +begin +end; + + + + +Procedure TComponent.Setname (Value : TComponentName); + +begin +end; + + + +{ --------------------------------------------------------------------- + TFiler + ---------------------------------------------------------------------} + +Constructor TFiler.Create {(Stream : TStream; BufSize : Longint) }; + +begin +end; + + + + +Destructor TFiler.Destroy; + +begin +end; + + + + +{ --------------------------------------------------------------------- + TPersistent + ---------------------------------------------------------------------} + +Procedure TPersistent.AssignError (Source : TPersistent); + +begin +end; + + + +Procedure TPersistent.AssignTo (Dest : TPersistent); + +begin +end; + + + +Procedure TPersistent.DefineProperties (Filer : TFiler); + +begin +end; + + + +Destructor TPersistent.Destroy; + +begin +end; + + + +Procedure TPersistent.Assign (Source : TPersistent); + +begin +end; + + + +end. \ No newline at end of file diff --git a/tests/ts010003.pp b/tests/ts010003.pp new file mode 100644 index 0000000000..71cc383e20 --- /dev/null +++ b/tests/ts010003.pp @@ -0,0 +1,55 @@ +uses + crt; + +begin + textcolor(blue); + writeln('blue'); + + textcolor(green); + writeln('green'); + + textcolor(cyan); + writeln('cyan'); + + textcolor(red); + writeln('red'); + + textcolor(magenta); + writeln('magenta'); + + textcolor(brown); + writeln('brown'); + + textcolor(lightgray); + writeln('lightgray'); + + textcolor(darkgray); + writeln('darkgray'); + + textcolor(lightblue); + writeln('lightblue'); + + textcolor(lightgreen); + writeln('lightgreen'); + + textcolor(lightcyan); + writeln('lightcyan'); + + textcolor(lightred); + writeln('lightred'); + + textcolor(lightmagenta); + writeln('lightmagenta'); + + textcolor(yellow); + writeln('yellow'); + + textcolor(white); + writeln('white'); + + textcolor(white+blink); + writeln('white blinking'); + + textcolor(lightgray); + writeln; +end. diff --git a/tests/ts010004.pp b/tests/ts010004.pp new file mode 100644 index 0000000000..2d8060b056 --- /dev/null +++ b/tests/ts010004.pp @@ -0,0 +1,20 @@ +{ tests forward class types } + +type + tclass1 = class; + + tclass2 = class + class1 : tclass1; + end; + +var + c : tclass1; + +type + tclass1 = class(tclass2) + i : longint; + end; + +begin + c.i:=12; +end.