Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
f1ce3535
Commit
f1ce3535
authored
Oct 08, 2019
by
Vladislav Zavialov
Committed by
Marge Bot
Oct 12, 2019
Browse files
Escape stats file command (
#13676
)
parent
c2290596
Changes
4
Hide whitespace changes
Inline
Side-by-side
rts/RtsFlags.c
View file @
f1ce3535
...
...
@@ -1777,16 +1777,30 @@ openStatsFile (char *filename, // filename, or NULL
* and the arguments it was invoked with.
-------------------------------------------------------------------------- */
// stats_fprintf augmented with Bash-compatible escaping. See #13676
static
void
stats_fprintf_escape
(
FILE
*
f
,
char
*
s
)
{
stats_fprintf
(
f
,
"'"
);
while
(
*
s
!=
'\0'
)
{
switch
(
*
s
)
{
case
'\''
:
stats_fprintf
(
f
,
"'
\\
''"
);
break
;
default:
stats_fprintf
(
f
,
"%c"
,
*
s
);
break
;
}
++
s
;
}
stats_fprintf
(
f
,
"' "
);
}
static
void
initStatsFile
(
FILE
*
f
)
{
/* Write prog_argv and rts_argv into start of stats file */
int
count
;
for
(
count
=
0
;
count
<
prog_argc
;
count
++
)
{
stats_fprintf
(
f
,
"%s "
,
prog_argv
[
count
]);
stats_fprintf
_escape
(
f
,
prog_argv
[
count
]);
}
stats_fprintf
(
f
,
"+RTS "
);
for
(
count
=
0
;
count
<
rts_argc
;
count
++
)
stats_fprintf
(
f
,
"%s "
,
rts_argv
[
count
]);
stats_fprintf
_escape
(
f
,
rts_argv
[
count
]);
stats_fprintf
(
f
,
"
\n
"
);
}
...
...
testsuite/tests/rts/T13676.hs
0 → 100644
View file @
f1ce3535
-- T13676 test driver.
-- Tests that the command dumped by the RTS into the stats file is properly escaped.
module
T13676_Driver
(
GhcPath
(
GhcPath
),
test_t13676
)
where
import
Control.Monad
import
Data.Maybe
import
System.Exit
import
System.Process
import
System.FilePath
-- This expression contains quotation marks and spaces which must be escaped.
expr
::
String
expr
=
"'$' == '
\\
x0024'"
-- Check that evaluation of expr succeeds.
check_output
::
String
->
IO
()
check_output
out
=
unless
(
lines
out
==
[
"True"
])
$
exitWith
(
ExitFailure
13
)
-- A name for the .t file.
tfilename
::
String
tfilename
=
"T13676.t"
newtype
GhcPath
=
GhcPath
FilePath
-- GHC arguments for the initial invocation.
initial_cmd_args
::
[
String
]
initial_cmd_args
=
[
"-e"
,
expr
,
"+RTS"
,
"-t"
++
tfilename
]
test_t13676
::
GhcPath
->
IO
()
test_t13676
(
GhcPath
ghcPath
)
=
do
initial_out
<-
readCreateProcess
(
proc
ghcPath
initial_cmd_args
)
""
check_output
initial_out
tfile_content
<-
readFile
tfilename
dumped_cmd
<-
case
listToMaybe
(
lines
tfile_content
)
of
Nothing
->
exitWith
(
ExitFailure
14
)
Just
str
->
return
str
secondary_out
<-
readCreateProcess
(
shell
dumped_cmd
)
""
check_output
secondary_out
testsuite/tests/rts/T13676.script
0 → 100644
View file @
f1ce3535
:load T13676.hs
import System.Environment
Just ghcPath <- lookupEnv "HC" -- must be set by the testsuite driver
test_t13676 (GhcPath ghcPath)
testsuite/tests/rts/all.T
View file @
f1ce3535
...
...
@@ -393,3 +393,5 @@ test('keep-cafs',
test
('
T16514
',
unless
(
opsys
('
mingw32
'),
skip
),
compile_and_run
,
['
T16514_c.cpp -lstdc++
'])
test
('
test-zeroongc
',
extra_run_opts
('
-DZ
'),
compile_and_run
,
['
-debug
'])
test
('
T13676
',
[
extra_files
(['
T13676.hs
'])],
ghci_script
,
['
T13676.script
'])
Ben Gamari
🐢
@bgamari
mentioned in issue
#17447
·
Nov 07, 2019
mentioned in issue
#17447
mentioned in issue #17447
Toggle commit list
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment