Skip to content

Commit

Permalink
base: add ui_debug[1-3]
Browse files Browse the repository at this point in the history
  • Loading branch information
mascguy committed May 30, 2021
1 parent f9f1a33 commit 36a28c1
Show file tree
Hide file tree
Showing 8 changed files with 75 additions and 6 deletions.
9 changes: 8 additions & 1 deletion src/macports1.0/macports.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -339,14 +339,21 @@ proc macports::ui_prefix_default {priority} {
# ui_options(ports_verbose) - If set, output info messages (ui_info)
# ui_options(ports_quiet) - If set, don't output "standard messages"
proc macports::ui_channels_default {priority} {
switch -- $priority {
switch -regexp -- $priority {
debug {
if {[ui_isset ports_debug]} {
return stderr
} else {
return {}
}
}
debug[0-9] {
if {[ui_isset ports_debug_x] && (${priority} le ${ports_debug_x})} {
return stderr
} else {
return {}
}
}
info {
if {[ui_isset ports_verbose]} {
return stdout
Expand Down
35 changes: 35 additions & 0 deletions src/pextlib1.0/Pextlib.c
Original file line number Diff line number Diff line change
Expand Up @@ -135,6 +135,14 @@ static void ui_message(Tcl_Interp *interp, const char *severity, const char *for
free(tclcmd);
}

__attribute__((format(printf, 3, 0)))
static void ui_debug_x(Tcl_Interp *interp, unsigned int level, const char *format, va_list va) {
char cLevel[20]; // longer than necessary, but also safer

sprintf(cLevel, "debug%u", level);
ui_message(interp, cLevel, format, va);
}

__attribute__((format(printf, 2, 3)))
void ui_error(Tcl_Interp *interp, const char *format, ...) {
va_list va;
Expand Down Expand Up @@ -187,6 +195,33 @@ void ui_debug(Tcl_Interp *interp, const char *format, ...) {
va_end(va);
}

__attribute__((format(printf, 2, 3)))
void ui_debug1(Tcl_Interp *interp, const char *format, ...) {
va_list va;

va_start(va, format);
ui_debug_x(interp, 1 /*debug level*/, format, va);
va_end(va);
}

__attribute__((format(printf, 2, 3)))
void ui_debug2(Tcl_Interp *interp, const char *format, ...) {
va_list va;

va_start(va, format);
ui_debug_x(interp, 2 /*debug level*/, format, va);
va_end(va);
}

__attribute__((format(printf, 2, 3)))
void ui_debug3(Tcl_Interp *interp, const char *format, ...) {
va_list va;

va_start(va, format);
ui_debug_x(interp, 3 /*debug level*/, format, va);
va_end(va);
}

int StrsedCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
char *pattern, *string, *res;
Expand Down
3 changes: 3 additions & 0 deletions src/pextlib1.0/Pextlib.h
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,9 @@ void ui_msg(Tcl_Interp *interp, const char *format, ...) __attribute__((format(p
void ui_notice(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
void ui_info(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
void ui_debug(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
void ui_debug1(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
void ui_debug2(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));
void ui_debug3(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3)));

/* Mount point file system case-sensitivity caching infrastructure. */
typedef struct _mount_cs_cache mount_cs_cache_t;
Expand Down
9 changes: 9 additions & 0 deletions src/pextlib1.0/tests/system.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,15 @@ set failures 0
proc ui_debug {args} {
# ignored
}
proc ui_debug1 {args} {
# ignored
}
proc ui_debug2 {args} {
# ignored
}
proc ui_debug3 {args} {
# ignored
}
proc ui_info {args} {
global output
append output "$args\n"
Expand Down
11 changes: 10 additions & 1 deletion src/port/port.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -4568,7 +4568,7 @@ proc parse_options { action ui_options_name global_options_name } {
# Process short arg(s)
set opts [string range $arg 1 end]
foreach c [split $opts {}] {
switch -- $c {
switch -regexp -- $c {
v {
set ui_options(ports_verbose) yes
}
Expand All @@ -4577,6 +4577,15 @@ proc parse_options { action ui_options_name global_options_name } {
# debug implies verbose
set ui_options(ports_verbose) yes
}
d[0-3] {
set ui_options(ports_debug) yes
# debug implies verbose
set ui_options(ports_verbose) yes

set debug_level [regsub {d(\d)} ${c} {\1}]
set ui_options(ports_debug_x) "debug${debug_level}"
unset debug_level
}
q {
set ui_options(ports_quiet) yes
# quiet implies noninteractive
Expand Down
6 changes: 6 additions & 0 deletions src/port/portindex.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -197,6 +197,12 @@ for {set i 0} {$i < $argc} {incr i} {
{^-.+} {
if {$arg eq "-d"} { # Turn on debug output
set ui_options(ports_debug) yes
elseif {[regexp {\-d[0-3]} ${arg}] == 1} { # Turn on debugX output
set ui_options(ports_debug) yes

set debug_level [regsub {\-d(\d)} ${arg} {\1}]
set ui_options(ports_debug_x) "debug${debug_level}"
unset debug_level
} elseif {$arg eq "-o"} { # Set output directory
incr i
set outdir [file join [pwd] [lindex $argv $i]]
Expand Down
4 changes: 2 additions & 2 deletions src/port1.0/port.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -54,9 +54,9 @@ namespace eval port {
proc run_callbacks {} {
variable _callback_list
foreach callback ${_callback_list} {
ui_debug "Running callback ${callback}"
ui_debug1 "Running callback ${callback}"
${callback}
ui_debug "Finished running callback ${callback}"
ui_debug1 "Finished running callback ${callback}"
}
set _callback_list [list]
}
Expand Down
4 changes: 2 additions & 2 deletions src/port1.0/portutil.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -2607,7 +2607,7 @@ proc PortGroup {group version} {
if {[file exists $groupFile]} {
lappend PortInfo(portgroups) [list $group $version $groupFile]
uplevel "source $groupFile"
ui_debug "Sourcing PortGroup $group $version from $groupFile"
ui_debug1 "Sourcing PortGroup $group $version from $groupFile"
return
}
}
Expand All @@ -2618,7 +2618,7 @@ proc PortGroup {group version} {
if {[file exists $groupFile]} {
lappend PortInfo(portgroups) [list $group $version $groupFile]
uplevel "source $groupFile"
ui_debug "Sourcing PortGroup $group $version from $groupFile"
ui_debug1 "Sourcing PortGroup $group $version from $groupFile"
} else {
ui_error "${subport}: PortGroup ${group} ${version} could not be located. ${group}-${version}.tcl does not exist."
return -code error "PortGroup not found"
Expand Down

0 comments on commit 36a28c1

Please sign in to comment.