Adjust some perl & tcl related things in various scripts & utilities.
[dragonfly.git] / lib / libc_r / test / propagate_s.pl
CommitLineData
52b73b16 1#!/usr/pkg/bin/perl -w
984263bc
MD
2#
3# Copyright (C) 2000 Jason Evans <jasone@freebsd.org>.
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions
8# are met:
9# 1. Redistributions of source code must retain the above copyright
10# notice(s), this list of conditions and the following disclaimer as
11# the first lines of this file unmodified other than the possible
12# addition of one or more copyright notices.
13# 2. Redistributions in binary form must reproduce the above copyright
14# notice(s), this list of conditions and the following disclaimer in
15# the documentation and/or other materials provided with the
16# distribution.
17#
18# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER(S) ``AS IS'' AND ANY
19# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
20# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
21# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER(S) BE
22# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
23# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
24# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
25# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
26# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
27# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
28# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29#
30###########################################################################
31#
32# Verify that no cancellation points are propagated inside of libc_r.
33#
34# $FreeBSD: src/lib/libc_r/test/propagate_s.pl,v 1.1.2.1 2000/07/17 22:18:32 jasone Exp $
1de703da 35# $DragonFly: src/lib/libc_r/test/propagate_s.pl,v 1.2 2003/06/17 04:26:48 dillon Exp $
984263bc
MD
36#
37
38@CPOINTS = ("aio_suspend", "close", "creat", "fcntl", "fsync", "mq_receive",
39 "mq_send", "msync", "nanosleep", "open", "pause",
40 "pthread_cond_timedwait", "pthread_cond_wait", "pthread_join",
41 "pthread_testcancel", "read", "sem_wait", "sigsuspend",
42 "sigtimedwait", "sigwait", "sigwaitinfo", "sleep", "system",
43 "tcdrain", "wait", "waitpid", "write");
44
45print "1..1\n";
46
47$cpoints = join '\|', @CPOINTS;
48$regexp = "\" U \\(" . $cpoints . "\\\)\$\"";
49
50`nm -a /usr/lib/libc.a |grep $regexp >propagate_s.out`;
51if (!open (NMOUT, "<./propagate_s.out"))
52{
53 print "not ok 1\n";
54}
55else
56{
57 $propagations = 0;
58
59 while (<NMOUT>)
60 {
61 $propagations++;
62 print "$_\n";
63 }
64 if ($propagations != 0)
65 {
66 print "$propagations propagation(s)\n";
67 print "not ok 1\n";
68 }
69 else
70 {
71 print "ok 1\n";
72 }
73 close NMOUT;
74 unlink "propagate_s.out";
75}