← Back to branch summary

~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to lib/critcl-util/util.tcl

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
Import upstream version 3.1.9

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/critcl-util/util.tcl
 
1
## -*- tcl -*-
 
2
# # ## ### ##### ######## ############# #####################
 
3
# Pragmas for MetaData Scanner.
 
4
# n/a
 
5
 
 
6
# CriTcl Utility Commands.
 
7
 
 
8
package provide critcl::util 1
 
9
 
 
10
# # ## ### ##### ######## ############# #####################
 
11
## Requirements.
 
12
 
 
13
package require Tcl    8.4   ; # Min supported version.
 
14
 
 
15
if {[catch {
 
16
    package require critcl 3
 
17
}]} {
 
18
    package require critcl 2.1 ; # Only this and higher has the enhanced check, and checklink.
 
19
}
 
20
 
 
21
namespace eval ::critcl::util {}
 
22
 
 
23
# # ## ### ##### ######## ############# #####################
 
24
## Implementation -- API: Embed C Code
 
25
 
 
26
proc ::critcl::util::checkfun {name {label {}}} {
 
27
    variable cftemplate
 
28
    if {$label eq {}} { set label "Checking for function '$name'" }
 
29
    return [critcl::checklink $label [string map [list @@@ $name] $cftemplate]]
 
30
}
 
31
 
 
32
proc ::critcl::util::def {configfile define {value 1}} {
 
33
    set result [file join [critcl::cache] [file tail $configfile]]
 
34
 
 
35
    Put $result "[Get $result]\n\#define $define $value\n"
 
36
    return
 
37
}
 
38
 
 
39
proc ::critcl::util::undef {configfile define} {
 
40
    set result [file join [critcl::cache] [file tail $configfile]]
 
41
 
 
42
    Put $result "[Get $result]\n\#undef $define\n"
 
43
    return
 
44
}
 
45
 
 
46
# # ## ### ##### ######## ############# #####################
 
47
 
 
48
proc ::critcl::util::Get {path} {
 
49
    if {[catch {
 
50
        set c [open $path r]
 
51
        set d [read $c]
 
52
        close $c
 
53
    }]} {
 
54
        set d {}
 
55
    }
 
56
    return $d
 
57
}
 
58
 
 
59
proc ::critcl::util::Put {path data} {
 
60
    # Write changes back, via temp file. Commit via atomic rename.
 
61
    set c [open $path.[pid] w]
 
62
    puts -nonewline $c $data
 
63
    close $c
 
64
    file rename -force $path.[pid] $path
 
65
    return
 
66
}
 
67
 
 
68
# # ## ### ##### ######## ############# #####################
 
69
## State
 
70
 
 
71
namespace eval ::critcl::util {
 
72
    variable cftemplate {
 
73
        /* The header <limits.h> may declare @@@. To avoid a clash
 
74
         * redefine it to something aside. As an example, gettimeofday()
 
75
         * is declared in the <limits.h> provided by HP-UX 11i. Regardless,
 
76
         * we pull in a system header defining the __stub macros, and a
 
77
         * few prototypes only possibly in conflict with @@@, we hope.
 
78
         * As <limits.h> exists even on free-standing compilers its use
 
79
         * is preferred when __STDC__ is active.
 
80
         */
 
81
 
 
82
        #define @@@ innocuous_@@@
 
83
        #ifdef __STDC__
 
84
        # include <limits.h>
 
85
        #else
 
86
        # include <assert.h>
 
87
        #endif
 
88
        #undef @@@
 
89
 
 
90
        /* Next up a declaration to override whatever internal prototype
 
91
         * was declared by GCC, to prevent an error. As the return type
 
92
         * 'int' might match such a GCC builtin, and thus causing the application
 
93
         * of the argument prototype despite this we use 'char' instead.
 
94
         */
 
95
 
 
96
        #ifdef __cplusplus
 
97
        extern "C"
 
98
        #endif
 
99
        char @@@ ();
 
100
 
 
101
        /* Lastly the GNU libc defines a few special names for its functions,
 
102
         * these will always fail with ENONSYS. Further, some functions
 
103
         * actually start with __, with the normal name (we are looking for)
 
104
         * an alias of it. Regardless, for these we bail.
 
105
        */
 
106
 
 
107
        #if defined __stub_@@@ || defined __stub___@@@
 
108
        choke me
 
109
        #endif
 
110
 
 
111
        int main ()
 
112
        {
 
113
            return @@@ ();
 
114
            ;
 
115
            return 0;
 
116
        }
 
117
    }
 
118
}
 
119
 
 
120
# # ## ### ##### ######## ############# #####################
 
121
## Export API
 
122
 
 
123
namespace eval ::critcl::util {
 
124
    namespace export checkfun def undef
 
125
    catch { namespace ensemble create }
 
126
}
 
127
 
 
128
# # ## ### ##### ######## ############# #####################
 
129
## Ready
 
130
return