On 12/10/22 04:43, Arsen Arsenović wrote:
This script is a helper used to generate dg-output lines from an existing program output conveniently. It takes care of escaping Tcl and ARE stuff. contrib/ChangeLog:* dg-out-generator.pl: New file. --- contrib/dg-out-generator.pl | 67 +++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100755 contrib/dg-out-generator.pl diff --git a/contrib/dg-out-generator.pl b/contrib/dg-out-generator.pl new file mode 100755 index 00000000000..38aed2aa38d --- /dev/null +++ b/contrib/dg-out-generator.pl @@ -0,0 +1,67 @@ +#!/usr/bin/env perl +# +# Copyright (C) 2022 GCC Contributors. +# Contributed by Arsen Arsenović. +# +# This script is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. + +# This script reads program output on STDIN, and out of it produces a block of +# dg-output lines that can be yanked at the end of a file. It will escape +# special ARE and Tcl constructs automatically. +# +# Each argument passed on the standard input is treated as a string to be +# replaced by ``.*'' in the final result. This is intended to mask out build +# paths, filenames, etc. +# +# Usage example: + +# $ g++-13 -fcontracts -o test \ +# 'g++.dg/contracts/contracts-access1.C' && \ +# ./test |& dg-out-generator.pl 'g++.dg/contracts/contracts-access1.C' +# // { dg-output "contract violation in function Base::b at .*:11: pub > 0(\n|\r\n|\r)*" } +# // { dg-output "\\\[level:default, role:default, continuation mode:never\\\](\n|\r\n|\r)*" } +# // { dg-output "terminate called without an active exception(\n|\r\n|\r)*" } +# You can now freely dump the above into your testcase. + +use strict; +use warnings; +use POSIX 'floor'; + +my $escapees = '(' . join ('|', map { quotemeta } @ARGV) . ')'; + +sub gboundary($) +{ + my $str = shift; + my $sz = 10.0; + for (;;) + { + my $bnd = join '', (map chr 64 + rand 27, 1 .. floor $sz); + return $bnd unless index ($str, $bnd) >= 0; + $sz += 0.1; + } +} + +while (<STDIN>) + { + # Escape our escapees. + my $boundary = gboundary $_; + s/$escapees/$boundary/; + + # Quote stuff special in Tcl ARE. + s/([[\]*+?{}()\\])/\\$1/g; + + # Then, special stuff in TCL itself. + s/([\][\\])/\\$1/g; + + # Newlines should be more tolerant. + s/\n$/(\\n|\\r\\n|\\r)*/; + + # Then split out the boundary, replacing it with .*. + s/$boundary/.*/; + + # Then, let's print it in a dg-output block. + print "// { dg-output \"$_\" }\n";
I wonder if you want to wrap the pattern in {} instead of "" so you don't need the "special stuff in TCL itself" quoting?
Jason
