lib/Stem/Test/Flow.pm

   1 #  File: Stem/Test/Flow.pm
   2
   3 #  This file is part of Stem.
   4 #  Copyright (C) 1999, 2000, 2001 Stem Systems, Inc.
   5
   6 #  Stem is free software; you can redistribute it and/or modify
   7 #  it under the terms of the GNU General Public License as published by
   8 #  the Free Software Foundation; either version 2 of the License, or
   9 #  (at your option) any later version.
  10
  11 #  Stem is distributed in the hope that it will be useful,
  12 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #  GNU General Public License for more details.
  15
  16 #  You should have received a copy of the GNU General Public License
  17 #  along with Stem; if not, write to the Free Software
  18 #  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19
  20 #  For a license to use the Stem under conditions other than those
  21 #  described here, to purchase support for this software, or to purchase a
  22 #  commercial warranty contract, please contact Stem Systems at:
  23
  24 #       Stem Systems, Inc.              781-643-7504
  25 #       79 Everett St.                  info@stemsystems.com
  26 #       Arlington, MA 02474
  27 #       USA
  28
  29 package Stem::Test::Flow ;
  30
  31 use Test::More tests => 30 ;
  32
  33 use base 'Stem::Cell' ;
  34
  35 my $attr_spec = [
  36
  37         {
  38                 'name'          => 'reg_name',
  39                 'help'          => <<HELP,
  40 This is the name under which this Cell was registered.
  41 HELP
  42         },
  43
  44         {
  45                 'class'         => 'Stem::Cell',
  46                 'name'          => 'cell_attr',
  47                 'help'          => <<HELP,
  48 This value is the attributes for the included Stem::Cell which handles
  49 cloning, async I/O and pipes.
  50 HELP
  51         },
  52
  53 ] ;
  54
  55 sub new {
  56
  57         my( $class ) = shift ;
  58
  59         my $self = Stem::Class::parse_args( $attr_spec, @_ ) ;
  60         return $self unless ref $self ;
  61
  62         my $flow_text = <<FLOW ;
  63
  64                 meth1 ;
  65                 meth2( 1, a ) ;
  66                 if if1 {
  67                         meth3 ;
  68                 }
  69
  70                 unless if1 {
  71                         meth_bad ;
  72                 }
  73
  74                 while while1 {
  75                         meth4 ;
  76                 }
  77
  78                 until until1 {
  79
  80                         unless unless1 {
  81
  82                                 meth5 ;
  83                         }
  84                         else {
  85
  86                                 meth6 ;
  87                         }
  88                 }
  89
  90                 while while2 {
  91                         next ;
  92                 }
  93
  94                 next_ok ;
  95
  96                 LABEL1 :
  97                 while while3 {
  98
  99                         while while4 {
 100
 101                                 next LABEL1 ;
 102                         }
 103                 }
 104
 105                 LABEL2 :
 106                 until until2 {
 107
 108                         if if2 {
 109
 110                                 last LABEL2 ;
 111                         }
 112                 }
 113
 114                 last_ok ;
 115
 116                 delay_time ;
 117                 delay 1 ;
 118                 delay_done( 1 ) ;
 119
 120                 delay delay_set( 2 ) ;
 121                 delay_done( 2 ) ;
 122
 123                 msg1 ;
 124                 get_msg1 ;
 125
 126
 127                 exit_meth ;
 128 FLOW
 129
 130         $self->cell_flow_init( 'test', $flow_text ) ;
 131
 132         $self->cell_flow_go_in() ;
 133
 134         return $self ;
 135 }
 136
 137 sub meth1 {
 138         ok(1, 'plain method') ;
 139         return ;
 140 }
 141
 142 sub meth2 {
 143         my( $self, $arg1, $arg2 ) = @_ ;
 144         ok( $arg1 ==1 && $arg2 eq 'a', 'methods with args' ) ;
 145         return ;
 146 }
 147
 148 sub if1 {
 149         ok(1, 'if condition') ;
 150         return 1 ;
 151 }
 152
 153 sub meth3 {
 154         ok(1, 'method in block' ) ;
 155         return ;
 156 }
 157
 158 sub meth_bad {
 159         ok(0, 'then block was called' ) ;
 160         return ;
 161 }
 162
 163 my $w1 ;
 164
 165 sub while1 {
 166         ok(1, 'while condition') ;
 167         return 1 if $w1++ < 2 ;
 168
 169         return ;
 170 }
 171
 172 sub meth4 {
 173         ok(1, 'method in while' ) ;
 174         return ;
 175 }
 176
 177 my $u1 ;
 178 my $u2 ;
 179
 180 sub until1 {
 181         ok(1, 'until condition') ;
 182         return $u1 ;
 183 }
 184
 185 sub unless1 {
 186         ok(1, 'unless condition') ;
 187         return $u2 ;
 188 }
 189
 190 sub meth5 {
 191         ok(1, 'method in unless' ) ;
 192
 193         $u2++ ;
 194         return ;
 195 }
 196
 197 sub meth6 {
 198         ok(1, 'method in else' ) ;
 199
 200         $u1++ ;
 201 }
 202
 203 my $w3 ;
 204
 205 sub while3 {
 206         ok(1, 'outer while condition') ;
 207         return 1 if $w3++ < 1 ;
 208
 209         return ;
 210 }
 211
 212 my $w4 ;
 213
 214 sub while4 {
 215         ok(1, 'inner while condition') ;
 216         return 1 if $w4++ < 1 ;
 217
 218         return ;
 219 }
 220
 221 sub next_ok {
 222
 223         ok( 1, 'next' ) ;
 224
 225         return ;
 226 }
 227
 228
 229 my $w2 ;
 230
 231 sub while2 {
 232         ok(1, 'while condition') ;
 233         return 1 if $w1++ < 1 ;
 234
 235         return ;
 236 }
 237
 238 sub until2 {
 239
 240         return ;
 241 }
 242
 243 sub if2 {
 244         return 1 ;
 245 }
 246
 247 sub last_ok {
 248
 249         ok( 1, 'last' ) ;
 250
 251         return ;
 252 }
 253
 254
 255 my $delay_time ;
 256
 257 sub delay_time {
 258
 259         $delay_time = time ;
 260
 261         return ;
 262 }
 263
 264 sub delay_done {
 265
 266         my( $self, $delta ) = @_ ;
 267
 268         my $time = time ;
 269
 270         $delta ||= 1 ;
 271
 272 #print "$time $delay_time\n" ;
 273
 274         ok( $time - $delay_time >= $delta, 'delay done' ) ;
 275
 276         return ;
 277 }
 278
 279
 280 sub delay_set {
 281
 282         my( $self, $delay ) = @_ ;
 283
 284         ok( 1, 'delay set method' ) ;
 285
 286         return $delay || 1 ;
 287 }
 288
 289 sub msg1 {
 290
 291         my ( $self ) = @_ ;
 292
 293         ok(1, 'message method' ) ;
 294
 295         my $msg = Stem::Msg->new( to => $self->{'reg_name'},
 296                                from => $self->{'reg_name'},
 297                                type => 'flow_msg'
 298         ) ;
 299
 300 #print $msg->dump( 'MSG1' ) ;
 301
 302         return $msg ;
 303
 304 }
 305
 306 sub flow_msg_in {
 307
 308         my ( $self, $msg ) = @_ ;
 309
 310 #print $msg->dump( 'FLOW' ) ;
 311         ok(1, 'flow message in' ) ;
 312
 313         my $reply = $msg->reply() ;
 314
 315 #print $reply->dump( 'reply' ) ;
 316
 317         $reply->dispatch() ;
 318
 319         return ;
 320 }
 321
 322 sub get_msg1 {
 323
 324         my ( $self, $msg ) = @_ ;
 325
 326         ok(1, 'message received' ) ;
 327
 328 #print $msg->dump( 'GET' ) ;
 329
 330         return ;
 331 }
 332
 333 sub exit_meth {
 334         ok(1, 'exit method' ) ;
 335
 336         exit ;
 337 }
 338
 339 1 ;