diff options
| author | Yves Orton <demerphq@gmail.com> | 2023-03-11 11:00:17 +0100 |
|---|---|---|
| committer | Yves Orton <demerphq@gmail.com> | 2023-03-18 21:00:54 +0800 |
| commit | a455a55aaa6c566ab7a987ed4cf2806329380151 (patch) | |
| tree | af25b5782f957e69413de137b4f3cba114f0d407 /t | |
| parent | 1b4420e8995b35fc17ded852d068fa1ab53ddf19 (diff) | |
| download | perl-a455a55aaa6c566ab7a987ed4cf2806329380151.tar.gz | |
diag.t - parse and validate "when" parameter from deprecated_xxx() macros
the "when" parameter is expected to be a version string of the form "5.\d+",
with no minor version.
Diffstat (limited to 't')
| -rw-r--r-- | t/porting/diag.t | 11 |
1 files changed, 9 insertions, 2 deletions
diff --git a/t/porting/diag.t b/t/porting/diag.t index 80d457c2d1..874844a0f3 100644 --- a/t/porting/diag.t +++ b/t/porting/diag.t @@ -60,7 +60,7 @@ my $text_re = '"(?<text>(?:\\\\"|[^"]|"\s*[A-Z_]+\s*")*)"'; my $source_msg_call_re = qr/$source_msg_re(?:_nocontext)? \s* \( (?: \s* Perl_form \( )? (?:aTHX_)? \s* (?:packWARN\d*\((?<category>.*?)\),)? \s* - (?:(?<category>WARN_DEPRECATED__\w+)\s*,(?:\s*"5\.\d+"\s*,)?)? \s* + (?:(?<category>WARN_DEPRECATED__\w+)\s*,(?:\s*(?<version_string>"[^"]+")\s*,)?)? \s* $text_re /x; my $bad_version_re = qr{BADVERSION\([^"]*$text_re}; $regcomp_fail_re = qr/$regcomp_fail_re\([^"]*$text_re/; @@ -298,6 +298,7 @@ sub check_file { my $sub = 'top of file'; while (<$codefh>) { chomp; + my $first_line = $.; # Getting too much here isn't a problem; we only use this to skip # errors inside of XS modules, which should get documented in the # docs for the module. @@ -363,7 +364,9 @@ sub check_file { # DIE is just return Perl_die my ($name, $category, $routine, $wrapper); if (/\b$source_msg_call_re/) { - ($name, $category, $routine, $wrapper) = ($+{'text'}, $+{'category'}, $+{'routine'}, $+{'wrapper'}); + my $version_string; + ($name, $category, $routine, $wrapper, $version_string) = + ($+{'text'}, $+{'category'}, $+{'routine'}, $+{'wrapper'}, $+{'version_string'}); if ($wrapper) { $category = $wrapper if $wrapper=~/WARN/; $routine = "Perl_warner" if $wrapper=~/WARN/; @@ -371,6 +374,10 @@ sub check_file { } if ($routine=~/^deprecate/) { $name .= " is deprecated"; + if ($version_string) { + like($version_string, qr/"5\.\d+"/, + "version string is of the correct form at $codefn line $first_line"); + } } # diag(Dumper(\%+,{category=>$category, routine=>$routine, name=>$name})); # Sometimes the regexp will pick up too much for the category |