Initial revision

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.
+
+
+

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.

tests/TS010006.PP

@@ -0,0 +1,11 @@
+library test;
+
+  procedure exporttest;export;
+
+    begin
+    end;
+
+  exports exporttest;
+
+begin
+end.

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.

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.

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
+
+
+

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
+
+
+

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
+
+
+
+
+  

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.

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.

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.

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.

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.