diff options
| author | Daniel Stenberg <daniel@haxx.se> | 2001-05-28 21:49:45 +0000 | 
|---|---|---|
| committer | Daniel Stenberg <daniel@haxx.se> | 2001-05-28 21:49:45 +0000 | 
| commit | 7bb7550e23e70528f8c138d7e65275ac970a0351 (patch) | |
| tree | 33b9529790820840843ed896f982177baae59a6f | |
| parent | adf00f5b2e662241316fca8428c560a778974dbe (diff) | |
fixes
| -rw-r--r-- | tests/Makefile.am | 6 | ||||
| -rw-r--r-- | tests/getpart.pm | 42 | ||||
| -rwxr-xr-x | tests/httpserver.pl | 15 | 
3 files changed, 55 insertions, 8 deletions
diff --git a/tests/Makefile.am b/tests/Makefile.am index e59b70805..6888c1239 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -3,6 +3,8 @@ EXTRA_DIST = ftpserver.pl httpserver.pl runtests.pl ftpsserver.pl stunnel.pm \  SUBDIRS = data +PERLFLAGS = -I$(srcdir) +  all:  install: @@ -11,11 +13,11 @@ curl:  test:  	$(MAKE) -C data test -	srcdir=$(srcdir) $(PERL) $(srcdir)/runtests.pl +	srcdir=$(srcdir) $(PERL) $(PERLFLAGS) $(srcdir)/runtests.pl  quiet-test:  	$(MAKE) -C data test -	srcdir=$(srcdir) $(PERL) $(srcdir)/runtests.pl -s -a +	srcdir=$(srcdir) $(PERL) $(PERLFLAGS) $(srcdir)/runtests.pl -s -a  clean:  	rm -rf log diff --git a/tests/getpart.pm b/tests/getpart.pm index 1012ced5d..0edb6c9b5 100644 --- a/tests/getpart.pm +++ b/tests/getpart.pm @@ -3,6 +3,46 @@ use strict;  my @xml; +sub getpartattr { +    my ($section, $part)=@_; + +    my %hash; +    my $inside=0; + + #   print "Section: $section, part: $part\n"; + +    for(@xml) { + #       print "$inside: $_"; +        if(!$inside && ($_ =~ /^ *\<$section/)) { +            $inside++; +        } +        elsif((1 ==$inside) && ($_ =~ /^ *\<$part([^>]*)/)) { +            $inside++; +            my $attr=$1; +            my @p=split("[ \t]", $attr); +            my $assign; + +            foreach $assign (@p) { +                # $assign is a 'name="contents"' pair + +                if($assign =~ / *([^=]*)=\"([^\"]*)\"/) { +                    # *with* quotes +                    $hash{$1}=$2; +                } +                elsif($assign =~ / *([^=]*)=([^\"]*)/) { +                    # *without* quotes +                    $hash{$1}=$2; +                } +            } +            last; +        } +        elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) { +            $inside--; +        } +    } +    return %hash; +} +  sub getpart {      my ($section, $part)=@_; @@ -16,7 +56,7 @@ sub getpart {          if(!$inside && ($_ =~ /^ *\<$section/)) {              $inside++;          } -        elsif((1 ==$inside) && ($_ =~ /^ *\<$part/)) { +        elsif((1 ==$inside) && ($_ =~ /^ *\<$part[ \>]/)) {              $inside++;          }          elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) { diff --git a/tests/httpserver.pl b/tests/httpserver.pl index 59a52fd18..64d9d2100 100755 --- a/tests/httpserver.pl +++ b/tests/httpserver.pl @@ -121,10 +121,6 @@ for ( $waitedpid = 0;              my $testnum;              if($path =~ /.*\/(\d*)/) {                  $testnum=$1; - -                if($verbose) { -                    print STDERR "OUT: sending reply $testnum\n"; -                }              }              else {                  $testnum=0; @@ -142,9 +138,18 @@ for ( $waitedpid = 0;                  "You must enter a test number to get good data back\r\n";              }              else { +                my $part=""; +                if($testnum > 10000) { +                    $part = $testnum % 10000; +                    $testnum = sprintf("%d", $testnum/10000); +                } +                if($verbose) { +                    print STDERR "OUT: sending reply $testnum (part $part)\n"; +                } +                  loadtest("data/test$testnum");                  # send a custom reply to the client -                my @data = getpart("reply", "data"); +                my @data = getpart("reply", "data$part");                  for(@data) {                      print $_;                      if($verbose) {  | 
