Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
67 changes: 41 additions & 26 deletions .github/workflows/perl-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -22,25 +22,18 @@ on:
jobs:
test:
name: Test With Perl ${{ matrix.perl }} ${{ matrix.os }} ${{ matrix.joblabel }}
runs-on: ${{ ( ( startsWith(matrix.os, 'ubuntu:') && 'ubuntu-latest' ) || ( startsWith(matrix.os, 'macos:') && 'macos-latest' ) || startsWith(matrix.os, 'windows:') && 'windows-latest' ) || matrix.os }}
runs-on: ${{ ( ( startsWith(matrix.os, 'ubuntu:') && 'ubuntu-latest' ) || ( startsWith(matrix.os, 'macos:') && 'macos-latest' ) || startsWith(matrix.os, 'windows') && 'windows-latest' ) || matrix.os }}
env:
AUTOMATED_CI_TESTING: 1
strategy:
fail-fast: false
matrix:
os: [ 'windows-latest' ]
#perl: [ '5.8.5', '5.8.6', '5.8.7', '5.8.8', '5.8.9', '5.10', '5.10.1', '5.12', '5.14', '5.16', '5.18', '5.20', '5.22', '5.24', '5.26', '5.28', '5.30', '5.32', '5.34', '5.36' ]
perl: [ '5.14', '5.20', '5.32', '5.36' ]
# include:
# - perl: '5.30'
# os: 'windows-latest'
# W32MNPP_FORCE_VER: 'v8.3.3'
# #- perl: '5.32'
# # # coverage: true
# # # os: 'windows-latest'
# # os: 'ubuntu-latest'
# # env:
# # W32MNPP_FORCE_NONWIN_TEST: 1
os: ['windows:strawberry']
perl: ['5.36', '5.42']
include:
- perl: '5.14'
os: 'windows-latest'
W32MNPP_FORCE_VER: 'v8.9.6.4'
steps:
- name: Checkout code
uses: actions/checkout@v6
Expand All @@ -50,15 +43,27 @@ jobs:
perl-version: ${{ matrix.perl }}
multi-thread: ${{ ( ( startsWith(matrix.os, 'windows') || endsWith(matrix.os, ':thr') ) && true ) || false }}
distribution: ${{ ( endsWith(matrix.os, ':strawberry') && 'strawberry' ) || 'default' }}
- name: restore-cache
id: perl-cache-restore
uses: actions/cache/restore@v5
with:
path: |
c:\hostedtoolcache\windows\strawberry-perl
C:\hostedtoolcache\windows\perl
key: ${{ matrix.os }}-${{ matrix.perl }}
- name: Find binaries expecting ${{ matrix.perl }} ${{ matrix.os }} ${{ matrix.joblabel }}
run: |
${{ ( startsWith(matrix.os, 'windows') && '(get-command perl).Path' ) || 'which perl' }}
perl -v
${{ ( startsWith(matrix.os, 'windows') && '(get-command cpanm).Path' ) || 'which cpanm' }}
cpanm --version
Write-Host "`n====================`nFinding perl.exe"
${{ ( startsWith(matrix.os, 'windows') && '(get-command perl).Path' ) || 'which perl' }}
perl -v
Write-Host "`n--------------------`nFinding cpanm.bat"
${{ ( startsWith(matrix.os, 'windows') && '(get-command cpanm).Path' ) || 'which cpanm' }}
cpanm --version
- name: Pre-Makefile.PL prereqs
run: |
Write-Host "`n--------------------`nExtUtils::MakeMaker:"
cpanm ExtUtils::MakeMaker@7.76
Write-Host "`n--------------------`HTTP::Tiny:"
cpanm HTTP::Tiny~0.055
# these seem to have difficulty getting automatically installed as preqreqs in earlier perl versions, so might manually do them if I start supporting older perls again
# cpanm Config::Perl::V Encode::compat Math::Int64
Expand All @@ -67,21 +72,31 @@ jobs:
W32MNPP_FORCE_VER: ${{ matrix.W32MNPP_FORCE_VER }}
# but there might be some modules needed by configure, which makes chicken/egg problem
run: |
# initially grab the prereqs for Makefile.PL
cpanm --notest File::Which File::Spec File::Fetch Archive::Extract Archive::Zip
# intial run of Makefile.PL to see missing dependencies
perl Makefile.PL
cpanm --notest --installdeps .
# re-run Makefile.PL after dependencies met
perl Makefile.PL
Write-Host "`n--------------------`n# initially grab the prereqs for Makefile.PL"
cpanm --notest File::Which File::Spec File::Fetch Archive::Extract Archive::Zip
Write-Host "`n--------------------`n# intial run of Makefile.PL to see missing dependencies"
perl Makefile.PL
cpanm --notest --installdeps .
Write-Host "`n--------------------`n# re-run Makefile.PL after dependencies met"
perl Makefile.PL
- name: save-cache
id: perl-cache-save
uses: actions/cache/save@v5
with:
path: |
c:\hostedtoolcache\windows\strawberry-perl
C:\hostedtoolcache\windows\perl
key: ${{ steps.perl-cache-restore.outputs.cache-primary-key }}
- name: cpanm test-only
env:
W32MNPP_FORCE_VER: ${{ matrix.W32MNPP_FORCE_VER }}
run: |
cpanm --test-only --verbose --no-interactive .
#- name: verbose prove (for debug)
# env:
# W32MNPP_FORCE_VER: ${{ matrix.W32MNPP_FORCE_VER }}
# run: |
# prove -vl t
# prove -vl t
- name: Run and report test coverage
if: ${{ matrix.coverage }}
env:
Expand Down
19 changes: 17 additions & 2 deletions helpbuild/myMakeHelper.pm
Original file line number Diff line number Diff line change
Expand Up @@ -19,17 +19,20 @@ sub myMakeHelper {
my %ret = ();

warn __PACKAGE__, "\tAUTOMATED_CI_TESTING = ", $ENV{AUTOMATED_CI_TESTING}//'<undef>', "\n";
warn __PACKAGE__, "\tAUTOMATED_TESTING = ", $ENV{AUTOMATED_TESTING}//'<undef>', "\n";
warn __PACKAGE__, "\tW32MNPP_FORCE_VER = ", $ENV{W32MNPP_FORCE_VER}//'<undef>', "\n";
warn __PACKAGE__, "\tTEMP = ", $ENV{TEMP}//'<undef>', "\n";
warn __PACKAGE__, "\tTMP = ", $ENV{TMP}//'<undef>', "\n";

my $IS_AUTOMATED = $ENV{AUTOMATED_CI_TESTING} || $ENV{AUTOMATED_TESTING}; # if either are set and true,

for(1) {
is_windows() or last; # if not windows, don't need to download notepad++

# need to know bitness _before_ checking for NPP existing
$ret{bits} = determine_bitness() or last; # if your Perl isn't 32-bit or 64-bit, cannot determine the necessary Notepad++ to download

unless($ENV{AUTOMATED_CI_TESTING}) { # if not automated, then don't need to
unless($IS_AUTOMATED) { # if not automated, then don't need to
if( my $nppexe = npp_already_exists($ret{bits}) ) { # if notepad++ already found, don't need to download it; make sure I set the variables
my ($vol, $dir, $fil) = File::Spec->splitpath($nppexe);
$ret{npp_folder} = File::Spec->catpath($vol, $dir, '');
Expand All @@ -48,7 +51,7 @@ sub myMakeHelper {
@ret{'npp_folder', 'npp_exe'} = unzip_npp( $ret{zip}, $td ) or last; # stop if the unzip failed

#TODO:
if ($ENV{AUTOMATED_CI_TESTING} && $ENV{W32MNPP_FORCE_GEDCOM}) {
if ($IS_AUTOMATED && $ENV{W32MNPP_FORCE_GEDCOM}) {
# download https://sourceforge.net/projects/gedcomlexer/files/GedcomLexer-0.4.0-r140/GedcomLexer-0.4.0-r140-x64.zip/download
# or https://sourceforge.net/projects/gedcomlexer/files/GedcomLexer-0.4.0-r140/GedcomLexer-0.4.0-r140-x86.zip/download
# depending on bitness
Expand Down Expand Up @@ -167,6 +170,18 @@ sub download_zip {
name => 'npp.8.9.5.portable.zip',
},
},
'v8.9.6.4' => {
64 => {
https => 'https://github.com/notepad-plus-plus/notepad-plus-plus/releases/download/v8.9.6.4/npp.8.9.6.4.portable.x64.zip',
http => 'http://github.com/notepad-plus-plus/notepad-plus-plus/releases/download/v8.9.6.4/npp.8.9.6.4.portable.x64.zip',
name => 'npp.8.9.5.portable.x64.zip',
},
32 => {
https => 'https://github.com/notepad-plus-plus/notepad-plus-plus/releases/download/v8.9.6.4/npp.8.9.6.4.portable.zip',
http => 'http://github.com/notepad-plus-plus/notepad-plus-plus/releases/download/v8.9.6.4/npp.8.9.6.4.portable.zip',
name => 'npp.8.9.5.portable.zip',
},
},
);
die "don't know the URL for ", ($nppv//'<undef>') unless exists $url{$nppv};

Expand Down
7 changes: 7 additions & 0 deletions lib/Win32/Mechanize/NotepadPlusPlus/Notepad.pm
Original file line number Diff line number Diff line change
Expand Up @@ -172,6 +172,13 @@ sub _new

# instantiate the two view-scintilla Editors from the first two Scintilla HWND children of the Editor HWND.
my @sci_hwnds = @{$self->_enumScintillaHwnds()}[0..1]; # first two are the main editors
for(1..20) {
if(!@sci_hwnds || !$sci_hwnds[0] || !$sci_hwnds[1]) {
select(undef, undef, undef, 0.25); # give it some time to find itself
@sci_hwnds = @{$self->_enumScintillaHwnds()}[0..1];
}
}
croak "could not find scintilla hwnds: [@sci_hwnds]" if !@sci_hwnds || !$sci_hwnds[0] || !$sci_hwnds[1]; # uncoverable branch true
@{$self}{qw/editor1 editor2/} = map Win32::Mechanize::NotepadPlusPlus::Editor->_new($_, $self->{_hwobj}), @sci_hwnds;

return $self;
Expand Down
10 changes: 5 additions & 5 deletions t/myTestHelpers.pm
Original file line number Diff line number Diff line change
Expand Up @@ -112,9 +112,9 @@ sub __runCodeAndClickPopup {
my $f = WaitWindowLike(0, $re, undef, undef, 3, 10); # parent, title, class, id, depth, wait
my $p = GetParent($f);
if($DEBUG_INFO) {
note "runCodeAndClickPopup(..., /$re/, n:$n, delay:$xtraDelay): ", scalar(localtime), "\n";
note sprintf qq|\tfound: %d t:"%s" c:"%s"\n\tparent: %d t:"%s" c:"%s"\n|,
$f, GetWindowText($f), GetClassName($f),
diag "runCodeAndClickPopup(..., /$re/, n:$n, delay:$xtraDelay): ", scalar(localtime), "\n";
diag sprintf qq|\tfound: 0x%016x t:"%s" c:"%s" depth:%d\n\tparent: 0x%016x t:"%s" c:"%s"\n|,
$f, GetWindowText($f), GetClassName($f), Win32::GuiTest::GetChildDepth($p,$f)//-1,
$p, GetWindowText($p), GetClassName($p),
;
}
Expand All @@ -124,7 +124,7 @@ sub __runCodeAndClickPopup {
WaitWindowLike($f, undef, qr/^Button$/, undef, 2, 5); # parent, title, class, id, depth, wait -- wait up to 5s for Button
my @buttons = FindWindowLike( $f, undef, qr/^Button$/, undef, 2); # then list all the buttons
if($DEBUG_INFO) {
note sprintf "\tbutton:\t%d t:'%s' c:'%s' id=%d vis:%d grey:%d chkd:%d\n", $_,
diag sprintf "\tbutton:\t0x%016x t:'%s' c:'%s' id=%d vis:%d grey:%d chkd:%d\n", $_,
GetWindowText($_), GetClassName($_), GetWindowID($_),
IsWindowVisible($_), IsGrayedButton($_), IsCheckedButton($_)
for grep { $_ } @buttons;
Expand All @@ -142,7 +142,7 @@ sub __runCodeAndClickPopup {

my $h = $buttons[$n] // 0;
my $id = GetWindowID($h);
if($DEBUG_INFO) { note sprintf "\tCHOSEN:\t%d t:'%s' c:'%s' id=%d\n", $h, GetWindowText($h), GetClassName($h), $id; }
if($DEBUG_INFO) { diag sprintf "\tCHOSEN:\t0x%016x t:'%s' c:'%s' id=%d\n", $h, GetWindowText($h), GetClassName($h), $id; }
_mysleep_ms($xtraDelay*1000) if $xtraDelay;

# first push to select, second push to click
Expand Down
164 changes: 0 additions & 164 deletions t/npp-macro.t
Original file line number Diff line number Diff line change
Expand Up @@ -64,167 +64,3 @@ is $got, '0', 'getCurrentMacroStatus() should be Idle during testing, and return
is $MACROSTATUS{$got//-1}, 'Idle', 'getCurrentMacroStatus() should be Idle during testing, and $MACROSTATUS{$got} should say "Idle"';

done_testing(10);
exit;

# menuCommand
{
my $ret = notepad()->menuCommand('IDM_VIEW_CLONE_TO_ANOTHER_VIEW');
ok $ret, 'menuCommand("IDM_VIEW_CLONE_TO_ANOTHER_VIEW"): retval from string-param'; note sprintf qq(\t=> "0x%08x"\n), $ret // '<undef>';

# close the cloned window, which also tests value-based menuCommand...
$ret = notepad()->menuCommand($NPPIDM{IDM_FILE_CLOSE});
ok $ret, 'menuCommand(NPPIDM{IDM_FILE_CLOSE}): retval from value-param'; note sprintf qq(\t=> "0x%08x"\n), $ret // '<undef>';
}

# runMenuCommand
{
# for runMenuCommand, I am going to SHA-256 on active selection; which means I need a selection, and need to know what it is.
my $expected = 'a591a6d40bf420404a011733cfb7b190d62c65bf0bcda32b57b277d9ad9f146e';
my $algorithm = 'SHA-256';

# 1. create new file
notepad()->newFile();
select undef,undef,undef,0.25;

# 2. add known text
editor()->{_hwobj}->SendMessage_sendRawString( $SCIMSG{SCI_SETTEXT}, 0, "Hello World" );
select undef,undef,undef,0.25;

# 3. select that text
notepad()->menuCommand('IDM_EDIT_SELECTALL');
select undef,undef,undef,0.25;

# 4. run the menu command
my $ret = notepad()->runMenuCommand( "Tools | $algorithm", 'Generate from selection into clipboard');
unless(defined $ret) {
$algorithm = 'MD5';
$expected = 'b10a8db164e0754105b7a99be72e3fe5';
$ret = notepad()->runMenuCommand( "Tools | $algorithm", 'Generate from selection into clipboard');
}
ok $ret, "runMenuCommand(Tools | $algorithm | Generate from selection into clipboard): retval"; note sprintf qq(\t=> "%s"\n), $ret // '<undef>';

# 5. paste the resulting text
notepad()->menuCommand('IDM_EDIT_PASTE');

# 6. get the resulting textlength and text
my $len = editor()->{_hwobj}->SendMessage( $SCIMSG{SCI_GETTEXTLENGTH} ); note sprintf qq(\t=> "%s"\n), $len // '<undef>';
{
my $txt;
eval {
$txt = editor()->{_hwobj}->SendMessage_getRawString( $SCIMSG{SCI_GETTEXT}, $len+1, { trim => 'wparam' } );
} or do {
diag "eval(getRawString) = '$@'";
$txt = '';
};
$txt =~ s/[\0\s]+$//; # remove trailing spaces and nulls
is $txt, $expected, "runMenuCommand(): resulting $algorithm text"; note sprintf qq(\t%s => "%s"\n), $algorithm, $txt // '<undef>';
}

# 7. need to try again without the Tools| prefix, to cover a missing level (search recursion) -- issue#63
editor()->{_hwobj}->SendMessage_sendRawString( $SCIMSG{SCI_SETTEXT}, 0, "Hello World" ); # 2. set text
select undef,undef,undef,0.25;
notepad()->menuCommand('IDM_EDIT_SELECTALL'); # 3. select all
select undef,undef,undef,0.25;
$ret = notepad()->runMenuCommand( $algorithm, 'Generate from selection into clipboard'); # 4. run truncated menu entry
ok $ret, "runMenuCommand($algorithm | Generate from selection into clipboard): retval [TRUNCATED CALL]"; note sprintf qq(\t=> "%s"\n), $ret // '<undef>';
notepad()->menuCommand('IDM_EDIT_PASTE'); # 5. paste
# 6. textLength and value
$len = editor()->{_hwobj}->SendMessage( $SCIMSG{SCI_GETTEXTLENGTH} ); note sprintf qq(\t=> "%s"\n), $len // '<undef>';
{
my $txt;
eval {
$txt = editor()->{_hwobj}->SendMessage_getRawString( $SCIMSG{SCI_GETTEXT}, $len+1, { trim => 'wparam' } );
} or do {
diag "eval(getRawString) = '$@'";
$txt = '';
};
$txt =~ s/[\0\s]+$//; # remove trailing spaces and nulls
is $txt, $expected, "runMenuCommand(): resulting $algorithm text [TRUNCATED CALL]"; note sprintf qq(\t%s => "%s"\n), $algorithm, $txt // '<undef>';
}

# 8. need to test File|New, to match File|&New\tCtrl+N
{
my $ret = notepad()->runMenuCommand('File', 'New', {refreshCache => 1} );
is $ret, 1, 'runMenuCommand(File,New,{refreshCache=>1})'
and notepad->runMenuCommand('File|Close');
}

# penultimate. clear the editor, so I can close without a dialog
editor()->{_hwobj}->SendMessage_sendRawString( $SCIMSG{SCI_SETTEXT}, 0, "\0" );

# ultimate. close
notepad()->close();
}

# runPluginCommand
# 2020-Apr-03: per issue#30, need to rework the test suite, to make sure caching is working right, etc
# new outline:
# * compare ->{_menuID} to getMainMenuHandle
# * verify Plugins menu exists in main menu
# * if not, exit
# * ok ->getPluginMenuHandle()
# new:
SKIP: {
# won't actually skip until partway through, but by wrapping the whole sequence in
# the SKIP: block, I can jump out at one or more spots without having to manually control that
# the only thing i have to do is keep the number of skipped tests correct
local $TODO;
my $remaining = 6;

# make sure main menu ID matches
my $str = "Main Menu Handle";
my $exp = notepad->{_menuID};
my $got = notepad->getMainMenuHandle();
is $got, $exp, sprintf '%s: from message vs GetMenu(hwnd)', $str;
note sprintf "\t%s: expected = GetMenu() = %s\n", $str, $exp;
note sprintf "\t%s: got = getMainMenuHandle() = %s\n", $str, $got;
--$remaining;

# plugin menu handle
$str = "Plugin Menu Handle";
my $pluginID = notepad->getPluginMenuHandle();
ok defined $got, sprintf '%s: defined handle returned', $str;
note sprintf "\t%s: got = getMainMenuHandle() = %s\n", $str, $got;
--$remaining;
skip "No $str found", $remaining unless $got;
ok $got, sprintf '%s: reasonable handle value', $str;

# plugins menu contents
$str = "Plugin Menu Contents";
my $count = GetMenuItemCount( $pluginID );
note sprintf "\t%s: got %s items\n", $str, $count//'<undef>';

my %plugin_entries;
for my $idx ( 0 .. $count-1 ) {
my %h = GetMenuItemInfo( $pluginID, $idx );
if( $h{type} eq 'string' ) {
(my $cleanText = $h{text}) =~ s/(\&|\t.*)//;
note sprintf "\t\t%-20s | %s\n", $h{text}, $cleanText;
$plugin_entries{$cleanText} = GetSubMenu($pluginID, $idx);
}
}

myTestHelpers->setDebugInfo(1);
TODO: for my $arr (
["Plugins Admin...", "Plugins Admin", 4],
["Converter", "About", "Converter Plugin", 0],
) {
$str = $arr->[0];
my $btn_num = pop @$arr;
my $title = pop @$arr;
my $t_extra = 1; # 1s extra delay
local $TODO = "couldn't find '$str'" unless exists $plugin_entries{ $str };
my $re = qr/^\Q$title\E$/;
for(1..2) {
my $ret;
runCodeAndClickPopup( sub { $ret = notepad()->runPluginCommand( @$arr ) }, $re, $btn_num, $t_extra );
ok $ret//'<undef>', sprintf "%s [#%s]: ret=%s", $str, $_, $ret//'<undef>';
--$remaining;
sleep( $t_extra );
}
}
myTestHelpers->setDebugInfo(0);

skip "NEED TO FIX initial \$remaining value", $remaining if $remaining>0;
}

Loading
Loading