Commit 7bb7550e authored by Daniel Stenberg's avatar Daniel Stenberg
Browse files

fixes

parent adf00f5b

tests/Makefile.am

+4 −2
Original line number Diff line number Diff line
@@ -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

tests/getpart.pm

+41 −1
Original line number Diff line number Diff line
@@ -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/)) {

tests/httpserver.pl

+10 −5
Original line number Diff line number Diff line
@@ -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) {