Unity-Technologies
/
curl
зеркало из https://github.com/Unity-Technologies/curl.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

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
This commit is contained in:
Dan Fandrich 2023-04-05 12:28:26 -07:00
Родитель 9eeb7d3ed5
Коммит efbaa612f7
12 изменённых файлов: 145 добавлений и 53 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

4
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
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
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 {

8
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"

82
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);
}

6
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

27
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;
}

3
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";

2
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
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";

11
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
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 {