Browse Source

tests: turn perl modules into full packages

This helps enforce more modularization and encapsulation. Enable and fix
warnings on a few packages.  Also, rename ftp.pm to processhelp.pm since
there's really nothing ftp-specific in it.

Ref: #10818
Dan Fandrich 1 year ago
parent
commit
efbaa612f7
12 changed files with 145 additions and 53 deletions
  1. 2 2
      tests/Makefile.am
  2. 13 0
      tests/appveyor.pm
  3. 14 0
      tests/azure.pm
  4. 5 3
      tests/convsrctest.pl
  5. 50 32
      tests/directories.pm
  6. 3 3
      tests/ftpserver.pl
  7. 22 5
      tests/getpart.pm
  8. 2 1
      tests/keywords.pl
  9. 1 1
      tests/pathhelp.pm
  10. 17 0
      tests/processhelp.pm
  11. 5 6
      tests/runtests.pl
  12. 11 0
      tests/valgrind.pm

+ 2 - 2
tests/Makefile.am

@@ -28,8 +28,8 @@ MANDISTPAGES = runtests.1.dist testcurl.1.dist
 
 EXTRA_DIST = appveyor.pm azure.pm badsymbols.pl check-deprecated.pl CMakeLists.txt \
  dictserver.py directories.pm disable-scan.pl error-codes.pl extern-scan.pl \
- FILEFORMAT.md ftp.pm ftpserver.pl getpart.pm http-server.pl http2-server.pl http3-server.pl \
- manpage-scan.pl manpage-syntax.pl markdown-uppercase.pl mem-include-scan.pl \
+ FILEFORMAT.md processhelp.pm ftpserver.pl getpart.pm http-server.pl http2-server.pl \
+ http3-server.pl manpage-scan.pl manpage-syntax.pl markdown-uppercase.pl mem-include-scan.pl \
  memanalyze.pl negtelnetserver.py nroff-scan.pl option-check.pl options-scan.pl \
  pathhelp.pm README.md rtspserver.pl runtests.1 runtests.pl secureserver.pl \
  serverhelp.pm smbserver.py sshhelp.pm sshserver.pl stunnel.pem symbol-scan.pl \

+ 13 - 0
tests/appveyor.pm

@@ -23,9 +23,22 @@
 #
 ###########################################################################
 
+package appveyor;
+
 use strict;
 use warnings;
 
+BEGIN {
+    use base qw(Exporter);
+
+    our @EXPORT = qw(
+      appveyor_check_environment
+      appveyor_create_test_result
+      appveyor_update_test_result
+    );
+}
+
+
 my %APPVEYOR_TEST_NAMES;
 
 sub appveyor_check_environment {

+ 14 - 0
tests/azure.pm

@@ -23,9 +23,23 @@
 #
 ###########################################################################
 
+package azure;
+
 use strict;
 use warnings;
 
+BEGIN {
+    use base qw(Exporter);
+
+    our @EXPORT = qw(
+        azure_check_environment
+        azure_create_test_run
+        azure_create_test_result
+        azure_update_test_result
+        azure_update_test_run
+    );
+}
+
 use POSIX qw(strftime);
 
 sub azure_check_environment {

+ 5 - 3
tests/convsrctest.pl

@@ -42,7 +42,9 @@
 # - URL as literal string vs. passed as argument
 #=======================================================================
 use strict;
-require "getpart.pm";
+use warnings;
+
+use getpart;
 
 # Boilerplate code for test tool
 my $head =
@@ -165,7 +167,7 @@ sub generate_c {
         }
     }
 
-    print ("/* $comment */\n",
+    print("/* $comment */\n",
            $head,
            @decl,
            $init,
@@ -196,7 +198,7 @@ sub generate_test {
     # Traverse the pseudo-XML transforming as required
     my @new;
     my(@path,$path,$skip);
-    foreach (getall()) {
+    foreach (fulltest()) {
         if(my($end) = /\s*<(\/?)testcase>/) {
             push @new, $_;
             push @new, "# $comment\n"

+ 50 - 32
tests/directories.pm

@@ -21,7 +21,24 @@
 # SPDX-License-Identifier: curl
 #
 ###########################################################################
-%file_chmod1 = (
+
+package directories;
+
+use strict;
+use warnings;
+
+BEGIN {
+    use base qw(Exporter);
+
+    our @EXPORT = qw(
+        ftp_contentlist
+        wildcard_filesize
+        wildcard_getfile
+    );
+}
+
+
+my %file_chmod1 = (
   'name'      => 'chmod1',
   'content'   => "This file should have permissions 444\n",
   'perm'      => 'r--r--r--',
@@ -29,7 +46,7 @@
   'dostime'   => '01-11-10  10:00AM',
 );
 
-%file_chmod2 = (
+my %file_chmod2 = (
   'name'      => 'chmod2',
   'content'   => "This file should have permissions 666\n",
   'perm'      => 'rw-rw-rw-',
@@ -37,7 +54,7 @@
   'dostime'   => '02-01-10  08:00AM',
 );
 
-%file_chmod3 = (
+my %file_chmod3 = (
   'name'      => 'chmod3',
   'content'   => "This file should have permissions 777\n",
   'perm'      => 'rwxrwxrwx',
@@ -45,7 +62,7 @@
   'dostime'   => '02-01-10  08:00AM',
 );
 
-%file_chmod4 = (
+my %file_chmod4 = (
   'type'      => 'd',
   'name'      => 'chmod4',
   'content'   => "This file should have permissions 001\n",
@@ -54,7 +71,7 @@
   'dostime'   => '05-04-10  04:31AM'
 );
 
-%file_chmod5 = (
+my %file_chmod5 = (
   'type'      => 'd',
   'name'      => 'chmod5',
   'content'   => "This file should have permissions 110\n",
@@ -63,7 +80,7 @@
   'dostime'   => '05-04-10  04:31AM'
 );
 
-%link_link = (
+my %link_link = (
   'type'      => 'l',
   'name'      => 'link -> file.txt',
   'size'      => '8',
@@ -71,7 +88,7 @@
   'time'      => 'Jan  6  4:42'
 );
 
-%link_link_absolute = (
+my %link_link_absolute = (
   'type'      => 'l',
   'name'      => 'link_absolute -> /data/ftp/file.txt',
   'size'      => '15',
@@ -79,7 +96,7 @@
   'time'      => 'Jan  6  4:45'
 );
 
-%dir_dot = (
+my %dir_dot = (
   'type'      => "d",
   'name'      => ".",
   'hlink'     => "4",
@@ -89,7 +106,7 @@
   'perm'      => "rwxrwxrwx"
 );
 
-%dir_ddot = (
+my %dir_ddot = (
   'type'      => "d",
   'name'      => "..",
   'hlink'     => "4",
@@ -99,7 +116,7 @@
   'perm'      => "rwxrwxrwx"
 );
 
-%dir_weirddir_txt = (
+my %dir_weirddir_txt = (
   'type'      => "d",
   'name'      => "weirddir.txt",
   'hlink'     => "2",
@@ -109,7 +126,7 @@
   'perm'      => "rwxr-xrwx"
 );
 
-%dir_UNIX = (
+my %dir_UNIX = (
   'type'      => "d",
   'name'      => "UNIX",
   'hlink'     => "11",
@@ -119,7 +136,7 @@
   'perm'      => "rwx--x--x"
 );
 
-%dir_DOS = (
+my %dir_DOS = (
   'type'      => "d",
   'name'      => "DOS",
   'hlink'     => "11",
@@ -129,7 +146,7 @@
   'perm'      => "rwx--x--x"
 );
 
-%dir_dot_NeXT = (
+my %dir_dot_NeXT = (
   'type'      => "d",
   'name'      => ".NeXT",
   'hlink'     => "4",
@@ -139,7 +156,7 @@
   'perm'      => "rwxrwxrwx"
 );
 
-%file_empty_file_dat = (
+my %file_empty_file_dat = (
   'name'      => "empty_file.dat",
   'content'   => "",
   'perm'      => "rw-r--r--",
@@ -147,7 +164,7 @@
   'dostime'   => "04-27-10  11:01AM"
 );
 
-%file_file_txt = (
+my %file_file_txt = (
   'name'      => "file.txt",
   'content'   => "This is content of file \"file.txt\"\n",
   'time'      => "Apr 27 11:01",
@@ -155,7 +172,7 @@
   'perm'      => "rw-r--r--"
 );
 
-%file_someothertext_txt = (
+my %file_someothertext_txt = (
   'name'      => "someothertext.txt",
   'content'   => "Some junk ;-) This file does not really exist.\n",
   'time'      => "Apr 27 11:01",
@@ -163,7 +180,7 @@
   'perm'      => "rw-r--r--"
 );
 
-%lists = (
+my %lists = (
   '/fully_simulated/' => {
     'files'   => [ \%dir_dot, \%dir_ddot, \%dir_DOS, \%dir_UNIX ],
     'eol'     => "\r\n",
@@ -188,12 +205,12 @@
   }
 );
 
-sub ftp_createcontent($) {
-  my (%list) = @_;
+sub ftp_createcontent {
+  my ($list) = $_[0];
 
-  $type = $$list{'type'};
-  $eol  = $$list{'eol'};
-  $list_ref = $$list{'files'};
+  my $type = $$list{'type'};
+  my $eol  = $$list{'eol'};
+  my $list_ref = $$list{'files'};
 
   my @diroutput;
   my @contentlist;
@@ -206,11 +223,11 @@ sub ftp_createcontent($) {
       my $fuser  = $file{'user'}  ? sprintf("%15s", $file{'user'})   : "ftp-default";
       my $fgroup = $file{'group'} ? sprintf("%15s", $file{'group'})  : "ftp-default";
       my $fsize = "";
-      if($file{'type'} eq "d") {
+      if(exists($file{'type'}) && $file{'type'} eq "d") {
         $fsize = $file{'size'} ? sprintf("%7s", $file{'size'}) : sprintf("%7d", 4096);
       }
       else {
-        $fsize = sprintf("%7d", length $file{'content'});
+        $fsize = sprintf("%7d", exists($file{'content'}) ? length $file{'content'} : 0);
       }
       my $fhlink = $file{'hlink'} ? sprintf("%4d",  $file{'hlink'})  : "   1";
       my $ftime  = $file{'time'}  ? sprintf("%10s", $file{'time'})   : "Jan 9  1933";
@@ -225,7 +242,7 @@ sub ftp_createcontent($) {
       my $line = "";
       my $time = $file{'dostime'} ? $file{'dostime'} : "06-25-97  09:12AM";
       my $size_or_dir;
-      if($file{'type'} =~ /^d$/) {
+      if(exists($file{'type'}) && $file{'type'} =~ /^d$/) {
         $size_or_dir = "      <DIR>         ";
       }
       else {
@@ -237,9 +254,9 @@ sub ftp_createcontent($) {
   }
 }
 
-sub wildcard_filesize($$) {
+sub wildcard_filesize {
   my ($list_type, $file) = @_;
-  $list = $lists{$list_type};
+  my $list = $lists{$list_type};
   if($list) {
     my $files = $list->{'files'};
     for(@$files) {
@@ -259,9 +276,10 @@ sub wildcard_filesize($$) {
   }
   return -1;
 }
-sub wildcard_getfile($$) {
+
+sub wildcard_getfile {
   my ($list_type, $file) = @_;
-  $list = $lists{$list_type};
+  my $list = $lists{$list_type};
   if($list) {
     my $files = $list->{'files'};
     for(@$files) {
@@ -270,7 +288,7 @@ sub wildcard_getfile($$) {
         if($f{'content'}) {
           return (length $f{'content'}, $f{'content'});
         }
-        elsif ($f{'type'} ne "d"){
+        elsif (!exists($f{'type'}) or $f{'type'} ne "d"){
           return (0, "");
         }
         else {
@@ -284,6 +302,6 @@ sub wildcard_getfile($$) {
 
 sub ftp_contentlist {
   my $listname = $_[0];
-  $list = $lists{$listname};
-  return ftp_createcontent(\$list);
+  my $list = $lists{$listname};
+  return ftp_createcontent($list);
 }

+ 3 - 3
tests/ftpserver.pl

@@ -58,9 +58,9 @@ use IPC::Open2;
 use Digest::MD5;
 use File::Basename;
 
-require "getpart.pm";
-require "ftp.pm";
-require "directories.pm";
+use directories;
+use getpart;
+use processhelp;
 
 use serverhelp qw(
     servername_str

+ 22 - 5
tests/getpart.pm

@@ -22,8 +22,28 @@
 #
 ###########################################################################
 
+package getpart;
+
 use strict;
 use warnings;
+
+BEGIN {
+    use base qw(Exporter);
+
+    our @EXPORT = qw(
+        getpartattr
+        getpart
+        partexists
+        loadtest
+        fulltest
+        striparray
+        compareparts
+        writearray
+        loadarray
+        showdiff
+    );
+}
+
 use Memoize;
 use MIME::Base64;
 
@@ -209,11 +229,6 @@ sub partexists {
 # caching a result that will never be used again just slows things down.
 # memoize('partexists', NORMALIZER => 'normalize_part');  # cache each result
 
-# Return entire document as list of lines
-sub getall {
-    return @xml;
-}
-
 sub loadtest {
     my ($file)=@_;
 
@@ -238,6 +253,8 @@ sub loadtest {
     return 0;
 }
 
+
+# Return entire document as list of lines
 sub fulltest {
     return @xml;
 }

+ 2 - 1
tests/keywords.pl

@@ -24,11 +24,12 @@
 ###########################################################################
 
 use strict;
+use warnings;
 
 push(@INC, $ENV{'srcdir'}) if(defined $ENV{'srcdir'});
 push(@INC, ".");
 
-require "getpart.pm"; # array functions
+use getpart; # array functions
 
 my $srcdir = $ENV{'srcdir'} || '.';
 my $TESTDIR="$srcdir/data";

+ 1 - 1
tests/pathhelp.pm

@@ -49,8 +49,8 @@
 #     interpreted incorrectly in Perl and Msys/Cygwin environment have low
 #     control on Win32 current drive and Win32 current path on specific drive.
 
-
 package pathhelp;
+
 use strict;
 use warnings;
 use Cwd 'abs_path';

+ 17 - 0
tests/ftp.pm → tests/processhelp.pm

@@ -22,10 +22,27 @@
 #
 ###########################################################################
 
+package processhelp;
+
 use strict;
 use warnings;
 
 BEGIN {
+    use base qw(Exporter);
+
+    our @EXPORT = qw(
+        portable_sleep
+        pidfromfile
+        pidexists
+        pidwait
+        processexists
+        killpid
+        killsockfilters
+        killallsockfilters
+        set_advisor_read_lock
+        clear_advisor_read_lock
+    );
+
     # portable sleeping needs Time::HiRes
     eval {
         no warnings "all";

+ 5 - 6
tests/runtests.pl

@@ -121,13 +121,12 @@ use sshhelp qw(
     sshversioninfo
     );
 
+use appveyor;
+use azure;
+use getpart;   # array functions
 use pathhelp;
-
-require getpart;   # array functions
-require valgrind;  # valgrind report parser
-require ftp;
-require azure;
-require appveyor;
+use processhelp;
+use valgrind;  # valgrind report parser
 
 my $HOSTIP="127.0.0.1";   # address on which the test server listens
 my $HOST6IP="[::1]";      # address on which the test server listens

+ 11 - 0
tests/valgrind.pm

@@ -22,9 +22,20 @@
 #
 ###########################################################################
 
+package valgrind;
+
 use strict;
 use warnings;
 
+BEGIN {
+    use base qw(Exporter);
+
+    our @EXPORT = qw(
+        valgrindparse
+    );
+}
+
+
 use File::Basename;
 
 sub valgrindparse {