From 95a924f4f300e60255f3fd24f4e80b6456c4223b Mon Sep 17 00:00:00 2001 From: Don HO Date: Thu, 27 Aug 2020 21:17:08 +0200 Subject: [PATCH] Make valid perl unit tests for function list --- PowerEditor/Test/FunctionList/perl/unitTest | 381 ++++++++++++++---- .../perl/unitTest.expected.result | 2 +- 2 files changed, 297 insertions(+), 86 deletions(-) diff --git a/PowerEditor/Test/FunctionList/perl/unitTest b/PowerEditor/Test/FunctionList/perl/unitTest index 6fe49bbc..7a74682b 100644 --- a/PowerEditor/Test/FunctionList/perl/unitTest +++ b/PowerEditor/Test/FunctionList/perl/unitTest @@ -1,89 +1,300 @@ -, latest version always available +# at +# +# Version 2.3, 28 February 2002 +# +# Written by Michael Schaap . Suggestions for improvement +# are very welcome! +# +# This script will not work with Perl 4 or below! +# +# Revision history: +# 1.0 1997? Original version, quickly hacked together +# 2.0 1999? Completely rewritten, better structured and documented, +# support for variables, packages, Exuberant Ctags extensions +# 2.1 Jun 2000 Fixed critical bug (typo in comment) ;-) +# Support multiple level packages (e.g. Archive::Zip::Member) +# 2.2 Jul 2001 'Glob' wildcards - especially useful under Windows +# (thanks to Serge Sivkov and Jason King) +# Bug fix: reset package name for each file +# 2.21 Jul 2001 Oops... bug in variable detection (/local../ -> /^local.../) +# 2.3 Feb 2002 Support variables declared with "our" +# (thanks to Lutz Mende) + +# Complain about undeclared variables +use strict; + +# Used modules +use Getopt::Long; + +# Options with their defaults +my $do_subs = 1; # --subs, --nosubs include subs in tags file? +my $do_vars = 1; # --vars, --novars include variables in tags file? +my $do_pkgs = 1; # --pkgs, --nopkgs include packages in tags file? +my $do_exts = 1; # --extensions, --noextensions + # include Exuberant Ctags extensions + +# Global variables +my $VERSION = "2.21"; # pltags version +my $status = 0; # GetOptions return value +my $file = ""; # File being processed +my @tags = (); # List of produced tags +my $is_pkg = 0; # Are we tagging a package? +my $has_subs = 0; # Has this file any subs yet? +my $package_name = ""; # Name of current package +my $var_continues = 0; # Variable declaration continues on last line +my $line = ""; # Current line in file +my $stmt = ""; # Current Perl statement +my @vars = (); # List of variables in declaration +my $var = ""; # Variable in declaration +my $tagline = ""; # Tag file line + +# Create a tag file line and push it on the list of found tags +sub MakeTag($$$$$) { - public static function main() + my ($tag, # Tag name + $type, # Type of tag + $is_static, # Is this a static tag? + $file, # File in which tag appears + $line) = @_; # Line in which tag appears + + my $tagline = ""; # Created tag line + + # Only process tag if not empty + if ($tag) { - $code = (isset($_POST['notificationCode']) && trim($_POST['notificationCode']) !== "" ? - trim($_POST['notificationCode']) : null); - $type = (isset($_POST['notificationType']) && trim($_POST['notificationType']) !== "" ? - trim($_POST['notificationType']) : null); - if ($code && $type) { - $notificationType = new PagSeguroNotificationType($type); - $strType = $notificationType->getTypeFromValue(); - switch ($strType) { - case 'TRANSACTION': - self::transactionNotification($code); - break; - case 'APPLICATION_AUTHORIZATION': - self::authorizationNotification($code); - break; - case 'PRE_APPROVAL': - self::preApprovalNotification($code); - break; - default: - LogPagSeguro::error("Unknown notification type [" . $notificationType->getValue() . "]"); - } - self::printLog($strType); - } else { - LogPagSeguro::error("Invalid notification parameters."); - self::printLog(); - } - } - private static function transactionNotification($notificationCode) - { - $credentials = PagSeguroConfig::getAccountCredentials(); - try { - $transaction = PagSeguroNotificationService::checkTransaction($credentials, $notificationCode); - // Do something with $transaction - } catch (PagSeguroServiceException $e) { - die($e->getMessage()); - } - } - private static function authorizationNotification($notificationCode) - { - $credentials = PagSeguroConfig::getApplicationCredentials(); - try { - $authorization = PagSeguroNotificationService::checkAuthorization($credentials, $notificationCode); - // Do something with $authorization - } catch (PagSeguroServiceException $e) { - die($e->getMessage()); - } - } - private static function preApprovalNotification($preApprovalCode) - { - $credentials = PagSeguroConfig::getAccountCredentials(); - try { - $preApproval = PagSeguroNotificationService::checkPreApproval($credentials, $preApprovalCode); - // Do something with $preApproval - - } catch (PagSeguroServiceException $e) { - die($e->getMessage()); - } - } - private static function printLog($strType = null) - { - $count = 4; - echo "

Receive notifications

"; - if ($strType) { - echo "

notifcationType: $strType

"; - } - echo "

Last $count items in log file:

"; - echo LogPagSeguro::getHtml($count); + # Get rid of \n, and escape / and \ in line + chomp $line; + $line =~ s/\\/\\\\/g; + $line =~ s/\//\\\//g; + + # Create a tag line + $tagline = "$tag\t$file\t/^$line\$/"; + + # If we're told to do so, add extensions + if ($do_exts) + { + $tagline .= ";\"\t$type" + . ($is_static ? "\tfile:" : "") + . ($package_name ? "\tclass:$package_name" : ""); + } + + # Push it on the stack + push (@tags, $tagline); } } -NotificationListener::main(); \ No newline at end of file + +# Parse package name from statement +sub PackageName($) +{ + my ($stmt) = @_; # Statement + + # Look for the argument to "package". Return it if found, else return "" + if ($stmt =~ /^package\s+([\w:]+)/) + { + my $pkgname = $1; + + # Remove any parent package name(s) + $pkgname =~ s/.*://; + return $pkgname; + } + else + { + return ""; + } +} + +# Parse sub name from statement +sub SubName($) +{ + my ($stmt) = @_; # Statement + + # Look for the argument to "sub". Return it if found, else return "" + if ($stmt =~ /^sub\s+([\w:]+)/) + { + my $subname = $1; + + # Remove any parent package name(s) + $subname =~ s/.*://; + return $subname; + } + else + { + return ""; + } +} + +# Parse all variable names from statement +sub VarNames($) +{ + my ($stmt) = @_; + + # Remove my or local from statement, if present + $stmt =~ s/^(my|our|local)\s+//; + + # Remove any assignment piece + $stmt =~ s/\s*=.*//; + + # Now find all variable names, i.e. "words" preceded by $, @ or % + @vars = ($stmt =~ /[\$\@\%]([\w:]+)\b/g); + + # Remove any parent package name(s) + map(s/.*://, @vars); + + return (@vars); +} + +############### Start ############### + +print "\npltags $VERSION by Michael Schaap \n\n"; + +# Get options +$status = GetOptions("subs!" => \$do_subs, + "vars!" => \$do_vars, + "pkgs!" => \$do_pkgs, + "extensions!" => \$do_exts); + +# Usage if error in options or no arguments given +unless ($status && @ARGV) +{ + print "\n" unless ($status); + print " Usage: $0 [options] filename ...\n\n"; + print " Where options can be:\n"; + print " --subs (--nosubs) (don't) include sub declarations in tag file\n"; + print " --vars (--novars) (don't) include variable declarations in tag file\n"; + print " --pkgs (--nopkgs) (don't) include package declarations in tag file\n"; + print " --extensions (--noextensions)\n"; + print " (don't) include Exuberant Ctags / Vim style\n"; + print " extensions in tag file\n\n"; + print " Default options: "; + print ($do_subs ? "--subs " : "--nosubs "); + print ($do_vars ? "--vars " : "--novars "); + print ($do_pkgs ? "--pkgs " : "--nopkgs "); + print ($do_exts ? "--extensions\n\n" : "--noextensions\n\n"); + print " Example: $0 *.pl *.pm ../shared/*.pm\n\n"; + exit; +} + +# Loop through files on command line - 'glob' any wildcards, since Windows +# doesn't do this for us +foreach $file (map { glob } @ARGV) +{ + # Skip if this is not a file we can open. Also skip tags files and backup + # files + next unless ((-f $file) && (-r $file) && ($file !~ /tags$/) + && ($file !~ /~$/)); + + print "Tagging file $file...\n"; + + $is_pkg = 0; + $package_name = ""; + $has_subs = 0; + $var_continues = 0; + + open (IN, $file) or die "Can't open file '$file': $!"; + + # Loop through file + foreach $line () + { + # Statement is line with comments and whitespace trimmed + ($stmt = $line) =~ s/#.*//; + $stmt =~ s/^\s*//; + $stmt =~ s/\s*$//; + + # Nothing left? Never mind. + next unless ($stmt); + + # This is a variable declaration if one was started on the previous + # line, or if this line starts with my or local + if ($var_continues or ($stmt =~/^my\b/) + or ($stmt =~/^our\b/) or ($stmt =~/^local\b/)) + { + # The declaration continues if the line does not end with ; + $var_continues = ($stmt !~ /;$/); + + # Loop through all variable names in the declaration + foreach $var (VarNames($stmt)) + { + # Make a tag for this variable unless we're told not to. We + # assume that a variable is always static, unless it appears + # in a package before any sub. (Not necessarily true, but + # it's ok for most purposes and Vim works fine even if it is + # incorrect) + if ($do_vars) + { + MakeTag($var, "v", (!$is_pkg or $has_subs), $file, $line); + } + } + } + + # This is a package declaration if the line starts with package + elsif ($stmt =~/^package\b/) + { + # Get name of the package + $package_name = PackageName($stmt); + + if ($package_name) + { + # Remember that we're doing a package + $is_pkg = 1; + + # Make a tag for this package unless we're told not to. A + # package is never static. + if ($do_pkgs) + { + MakeTag($package_name, "p", 0, $file, $line); + } + } + } + + # This is a sub declaration if the line starts with sub + elsif ($stmt =~/^sub\b/) + { + # Remember that this file has subs + $has_subs = 1; + + # Make a tag for this sub unless we're told not to. We assume + # that a sub is static, unless it appears in a package. (Not + # necessarily true, but it's ok for most purposes and Vim works + # fine even if it is incorrect) + if ($do_subs) + { + MakeTag(SubName($stmt), "s", (!$is_pkg), $file, $line); + } + } + } + close (IN); +} + +# Do we have any tags? If so, write them to the tags file +if (@tags) +{ + # Add some tag file extensions if we're told to + if ($do_exts) + { + push (@tags, "!_TAG_FILE_FORMAT\t2\t/extended format/"); + push (@tags, "!_TAG_FILE_SORTED\t1\t/0=unsorted, 1=sorted/"); + push (@tags, "!_TAG_PROGRAM_AUTHOR\tMichael Schaap\t/mscha\@mscha.com/"); + push (@tags, "!_TAG_PROGRAM_NAME\tpltags\t//"); + push (@tags, "!_TAG_PROGRAM_VERSION\t$VERSION\t/supports multiple tags and extended format/"); + } + + print "\nWriting tags file.\n"; + + open (OUT, ">tags") or die "Can't open tags file: $!"; + + foreach $tagline (sort @tags) + { + print OUT "$tagline\n"; + } + + close (OUT); +} +else +{ + print "\nNo tags found.\n"; +} diff --git a/PowerEditor/Test/FunctionList/perl/unitTest.expected.result b/PowerEditor/Test/FunctionList/perl/unitTest.expected.result index a576e185..dbc77125 100644 --- a/PowerEditor/Test/FunctionList/perl/unitTest.expected.result +++ b/PowerEditor/Test/FunctionList/perl/unitTest.expected.result @@ -1 +1 @@ -{"root":"unitTest"} \ No newline at end of file +{"leaves":["MakeTag","PackageName","SubName","VarNames"],"root":"unitTest"} \ No newline at end of file