File: testcastlelevels.pas

package info (click to toggle)
castle-game-engine 7.0~alpha.3%2Bdfsg2-4
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 969,476 kB
  • sloc: pascal: 911,523; javascript: 28,186; cpp: 14,157; xml: 9,939; ansic: 9,229; java: 3,653; objc: 2,737; sh: 1,214; makefile: 657; php: 65; lisp: 21; ruby: 8
file content (91 lines) | stat: -rw-r--r-- 2,338 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
// -*- compile-command: "./test_single_testcase.sh TTestCastleLevels" -*-
{
  Copyright 2020-2022 Michalis Kamburelis.

  This file is part of "Castle Game Engine".

  "Castle Game Engine" is free software; see the file COPYING.txt,
  included in this distribution, for details about the copyright.

  "Castle Game Engine" 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.

  ----------------------------------------------------------------------------
}

{ Test CastleLevels. }
unit TestCastleLevels;

interface

uses Classes, SysUtils, CastleTester;

type
  TTestCastleLevels = class(TCastleTestCase)
  published
    { Test that TLevel.Load works even when GL context is not ready yet }
    procedure TestLoadLevelWithoutGLContext;
    { Test setting/destroying Player after TLevel.Load }
    procedure TestSetDestroyPlayerAfterLevelLoad;
  end;

implementation

uses CastleApplicationProperties, CastleViewport, CastleLevels, CastlePlayer;

procedure TTestCastleLevels.TestLoadLevelWithoutGLContext;
var
  Viewport: TCastleViewport;
  Level: TLevel;
begin
  { This test should pass both with and without OpenGL context. }
  //AssertFalse(ApplicationProperties.IsGLContextOpen);

  Viewport := TCastleViewport.Create(nil);

  Levels.Clear;
  Levels.LoadFromFiles('castle-data:/game/level_without_loading_image');

  Level := TLevel.Create(nil);
  Level.Viewport := Viewport;
  Level.Load('level_without_loading_image');

  Level.Free;
  Viewport.Free;
end;

procedure TTestCastleLevels.TestSetDestroyPlayerAfterLevelLoad;
var
  Level: TLevel;
  Viewport: TCastleViewport;
  Player: TPlayer;
begin
  Player := TPlayer.Create(nil);
  Viewport := TCastleViewport.Create(nil);

  Levels.Clear;
  Levels.LoadFromFiles('castle-data:/game/level_without_loading_image');

  Level := TLevel.Create(nil);
  Level.Viewport := Viewport;
  Level.Load('level_without_loading_image');

  Level.Player := Player;
  FreeAndNil(Player);

  Player := TPlayer.Create(nil);
  Level.Player := Player;

  //Level.Load('level_without_loading_image');
  FreeAndNil(Player);
  Player := TPlayer.Create(nil);
  Level.Player := Player;
  Level.Free;
  Player.Free;
  Viewport.Free;
end;

initialization
  RegisterTest(TTestCastleLevels);
end.