Hello,
As some of you may remember, I am the maintainer of Debian package
for Hugs.
I got the following bug report from Havoc Pennington through the Debian
bug tracking system. To me it looks like a genuine bug, but what do I
know ;-) Could you please take a look at it?
I've been able to reproduce the problem with Hugs 98 (May 1999) compiled
directly from your sources, on a Debian potato system (GNU libc 2.1,
Linux 2.2) running on a i386.
Here's how to reproduce the segfault:
Take a copy of GNU General Public License, and
save it into a file called "GPL" in the current directory.
Also put the script below to the same directory, with name
havoc.lhs; set its execute bit. Then do
./havoc.lhs GPL bar baz
Please CC any responses to <[EMAIL PROTECTED]>. The address will log
the conversation in the Debian Bug Tracking system, for later reference
(and forward it to me, but this is insignificant, as I follow this list).
You can view the bug log at http://bugs.debian.org/45546 .
You can reach the original submitter at Havoc Pennington
<[EMAIL PROTECTED]>. It may be a good idea to CC him, too.
Thanks.
----- Forwarded message from Havoc Pennington <[EMAIL PROTECTED]> -----
Subject: Bug#45546: Hugs segfaults on my first Haskell program
Reply-To: Havoc Pennington <[EMAIL PROTECTED]>, [EMAIL PROTECTED]
Date: Mon, 20 Sep 1999 01:15:42 -0400 (EDT)
From: Havoc Pennington <[EMAIL PROTECTED]>
To: [EMAIL PROTECTED]
Package: hugs
Version: 98.199905-4
Running the appended program I get a segfault. (There are two sub-bugs
while I'm at it: 1) writing the string a character at a time is the most
phenomenally slow thing you could ever do, do it in larger chunks for
God's sake... you could easily make this 100 times faster for large
strings... 2) the Hugs segv handler is totally uninformative - "Unexpected
signal" - and prevents the default Linux message "Segmentation Fault", so
I had to do the strace to figure out what was going on. Suggested fix is
to remove the handler or change it to print the signal number.)
Anyway, here's the strace, and then my very first non-working Haskell
program, don't laugh too hard.
Thanks,
Havoc
Tail end of the strace:
write(4, "f", 1) = 1
write(4, "r", 1) = 1
write(4, "o", 1) = 1
write(4, "m", 1) = 1
write(4, " ", 1) = 1
write(4, "t", 1) = 1
write(4, "h", 1) = 1
write(4, "e", 1) = 1
write(4, " ", 1) = 1
write(4, "P", 1) = 1
write(4, "r", 1) = 1
write(4, "o", 1) = 1
write(4, "g", 1) = 1
write(4, "r", 1) = 1
write(4, "a", 1) = 1
write(4, "m", 1) = 1
write(4, "\n", 1) = 1
write(4, "i", 1) = 1
write(4, "s", 1) = 1
write(4, " ", 1) = 1
write(4, "c", 1) = 1
write(4, "o", 1) = 1
write(4, "v", 1) = 1
write(4, "e", 1) = 1
sigaction(SIGINT, {0x8049a08, [], SA_RESTART}, {SIG_DFL}, 0x400aad70) = 0
sigprocmask(SIG_UNBLOCK, [INT], NULL) = 0
close(4) = 0
munmap(0x40018000, 4096) = 0
sigaction(SIGINT, {0x8049a08, [], SA_RESTART}, {0x8049a08, [],
SA_RESTART}, 0x4005bd70) = 0
sigprocmask(SIG_UNBLOCK, [INT], NULL) = 0
--- SIGSEGV (Segmentation fault) ---
ioctl(0, SNDCTL_TMR_CONTINUE, {B0 opost isig icanon echo ...}) = 0
write(2, "\nUnexpected signal\n", 19
Unexpected signal
) = 19
_exit(1)
Program:
#!/usr/bin/runhugs
> import System (getArgs, ExitCode(ExitSuccess, ExitFailure), exitWith)
> import IO
> import Monad (when)
If the substring is at the head of the original string, return the
True plus original string with the substring stripped off; otherwise,
return False plus the original string.
> takeoff :: Eq a => [a] -> [a] -> (Bool, [a])
> takeoff sub other = takeoff' sub other other
> where
> takeoff' [] [] orig = (True, [])
> takeoff' sub [] orig = (False, orig)
> takeoff' [] other orig = (True, other)
> takeoff' sub@(s:ss) other@(o:os) orig = if (s == o)
> then takeoff' ss os orig
> else (False, orig)
Substitute old sublist with new sublist in the given list
> subst :: Eq a => [a] -> [a] -> [a] -> [a]
> subst list [] _ = list
> subst list old new = case takeoff old list of
> (True, remainder) -> new ++ subst remainder old new
> (False, entire@(c:cs)) -> c : subst cs old new
Get a file's contents, aborting on error
> reliableGetContents :: Handle -> IO String
> reliableGetContents infile =
> do
> let getContentsError :: IOError -> IO String
> getContentsError err = do
> hPrint stderr ("Failed to get file contents: " ++
>show err)
> exitWith (ExitFailure 1)
> getContents :: IO String
> getContents = do
> contents <- hGetContents infile
> return contents
> contents <- catch getContents getContentsError
> return contents
Open a file, aborting on error
> reliableOpenFile :: String -> IOMode -> IO Handle
> reliableOpenFile filename mode =
> do
> let openFileError :: IOError -> IO Handle
> openFileError err = do
> hPrint stderr ("Failed to open file " ++ filename ++ ":
>" ++ show err)
> exitWith (ExitFailure 1)
> doOpenFile :: IO Handle
> doOpenFile = do
> handle <- openFile filename mode
> return handle
>
> handle <- catch doOpenFile openFileError
> return handle
Replace old in infile with new in outfile.
> replace :: Handle -> Handle -> String -> String -> IO ()
> replace infile outfile old new =
> do
> contents <- reliableGetContents infile
> let newContents = subst contents old new
> hPutStr outfile newContents
> return ()
checkArgs ensures arguments are valid
> checkArgs :: [String] -> Bool
> checkArgs [x,y,z] = True
> checkArgs _ = False
function to print a usage message...
> usage :: IO ()
> usage = do
> hPrint stderr "Usage: replace <filename> <oldstring> <newstring>"
> exitWith (ExitFailure 1)
Main function
> main :: IO ()
> main = do
> args <- getArgs
> when (not (checkArgs args))
> usage
> infile <- reliableOpenFile (args!!0) ReadMode
> outfile <- reliableOpenFile ((args!!0)++".replaced") WriteMode
> replace infile outfile (args!!1) (args!!2)
> exitWith ExitSuccess
> return ()
----- End forwarded message -----
--
%%% Antti-Juhani Kaijanaho % [EMAIL PROTECTED] % http://www.iki.fi/gaia/ %%%
""
(John Cage)
[[email protected]: Bug#45546: Hugs segfaults on my first Haskell program]
Antti-Juhani Kaijanaho Mon, 20 Sep 1999 18:26:52 +0200 (MET DST)
