Changeset 960 for trunk/base


Ignore:
Timestamp:
Oct 5, 2002, 8:41:06 PM (22 years ago)
Author:
jkh
Message:
  1. rename portname to name (externally) and portversion to version (likewise)
  2. add platforms lines to everything based on current buildability testing on darwin and freebsd.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/base/src/port1.0/portutil.tcl

    r956 r960  
    6565                \} \n\
    6666        \}"
    67 
     67       
    6868        eval "proc ${option}-delete {args} \{ \n\
    6969            global ${option} user_options \n\
    … …  
    112112
    113113proc option_proc {option args} {
    114         global option_procs
    115         eval "lappend option_procs($option) $args"
     114    global option_procs
     115    eval "lappend option_procs($option) $args"
    116116}
    117117
    … …  
    130130proc command {command} {
    131131    global ${command}.dir ${command}.pre_args ${command}.args ${command}.post_args ${command}.env ${command}.type ${command}.cmd
    132 
     132   
    133133    set cmdstring ""
    134134    if [info exists ${command}.dir] {
    135135        set cmdstring "cd [set ${command}.dir] &&"
    136136    }
    137 
     137   
    138138    if [info exists ${command}.env] {
    139139        foreach string [set ${command}.env] {
    140                 set cmdstring "$cmdstring $string"
    141         }
    142     }
    143 
     140            set cmdstring "$cmdstring $string"
     141        }
     142    }
     143   
    144144    if [info exists ${command}.cmd] {
    145145        foreach string [set ${command}.cmd] {
    146                 set cmdstring "$cmdstring $string"
     146            set cmdstring "$cmdstring $string"
    147147        }
    148148    } else {
    … …  
    151151    foreach var "${command}.pre_args ${command}.args ${command}.post_args" {
    152152        if [info exists $var] {
    153         foreach string [set ${var}] {
     153            foreach string [set ${var}] {
    154154                set cmdstring "$cmdstring $string"
    155         }
     155            }
    156156        }
    157157    }
    … …  
    166166proc default {option val} {
    167167    global $option option_defaults
    168         if {[info exists option_defaults($option)]} {
    169                 ui_debug "Re-registering default for $option"
    170         } else {
    171                 # If option is already set and we did not set it
    172                 # do not reset the value
    173                 if {[info exists $option]} {
    174                         return
    175                 }
    176         }
    177         set option_defaults($option) $val
    178         set $option $val
    179         trace variable $option rwu default_check
     168    if {[info exists option_defaults($option)]} {
     169        ui_debug "Re-registering default for $option"
     170    } else {
     171        # If option is already set and we did not set it
     172        # do not reset the value
     173        if {[info exists $option]} {
     174            return
     175        }
     176    }
     177    set option_defaults($option) $val
     178    set $option $val
     179    trace variable $option rwu default_check
    180180}
    181181
    … …  
    184184# for default variable values
    185185proc default_check {optionName index op} {
    186         global option_defaults $optionName
    187         switch $op {
    188                 w {
    189                         unset option_defaults($optionName)
    190                         trace vdelete $optionName rwu default_check
    191                         return
    192                 }
    193                 r {
    194                         upvar $optionName option
    195                         uplevel #0 set $optionName $option_defaults($optionName)
    196                         return
    197                 }
    198                 u {
    199                         unset option_defaults($optionName)
    200                         trace vdelete $optionName rwu default_check
    201                         return
    202                 }
    203         }
     186    global option_defaults $optionName
     187    switch $op {
     188        w {
     189            unset option_defaults($optionName)
     190            trace vdelete $optionName rwu default_check
     191            return
     192        }
     193        r {
     194            upvar $optionName option
     195            uplevel #0 set $optionName $option_defaults($optionName)
     196            return
     197        }
     198        u {
     199            unset option_defaults($optionName)
     200            trace vdelete $optionName rwu default_check
     201            return
     202        }
     203    }
    204204}
    205205
    … …  
    236236    $obj append requires $requires
    237237    $obj set code $code
    238         lappend variants $obj
    239 
     238    lappend variants $obj
     239   
    240240    # Export provided variant to PortInfo
    241241    lappend PortInfo(variants) $provides
    … …  
    246246proc variant_isset {name} {
    247247    global variations
    248 
     248   
    249249    if {[info exists variations($name)] && $variations($name) == "+"} {
    250250        return 1
    … …  
    257257proc variant_set {name} {
    258258    global variations
    259 
     259   
    260260    set variations($name) +
    261261}
    … …  
    399399    global targets target_uniqid
    400400   
    401         set obj [dlist_get_by_name $targets $name]
    402         if {$obj == ""} {
    403                 set obj [target_new $name]
    404                 lappend targets $obj
    405         }
    406 
     401    set obj [dlist_get_by_name $targets $name]
     402    if {$obj == ""} {
     403        set obj [target_new $name]
     404        lappend targets $obj
     405    }
     406   
    407407    if {$mode == "target"} {
    408408        set procedure [lindex $args 0]
    … …  
    411411        }
    412412        $obj set procedure $procedure
    413                
    414                 # Set runtype {always,once} if available
    415                 if {[llength $args] >= 2} {
    416                         $obj set runtype [lindex $args 1]
    417                 }
     413       
     414        # Set runtype {always,once} if available
     415        if {[llength $args] >= 2} {
     416            $obj set runtype [lindex $args 1]
     417        }
    418418    } elseif {$mode == "init"} {
    419                 set init [lindex $args 0]
    420                 if {[$obj has init]} {
    421                         ui_debug "Warning: target '$name' re-registered init procedure (new procedure: '$init')"
    422                 }
    423                 $obj set init $init
     419        set init [lindex $args 0]
     420        if {[$obj has init]} {
     421            ui_debug "Warning: target '$name' re-registered init procedure (new procedure: '$init')"
     422        }
     423        $obj set init $init
    424424    } elseif {$mode == "prerun"} {
    425                 set prerun [lindex $args 0]
    426                 if {[$obj has prerun]} {
    427                         ui_debug "Warning: target '$name' re-registered pre-run procedure (new procedure: '$prerun')"
    428                 }
    429                 $obj prerun $prerun
     425        set prerun [lindex $args 0]
     426        if {[$obj has prerun]} {
     427            ui_debug "Warning: target '$name' re-registered pre-run procedure (new procedure: '$prerun')"
     428        }
     429        $obj prerun $prerun
    430430    } elseif {$mode == "postrun"} {
    431                 set postrun [lindex $args 0]
    432                 if {[$obj has postrun]} {
    433                         ui_debug "Warning: target '$name' re-registered post-run procedure (new procedure: '$postrun')"
    434                 }
    435                 $obj set postrun $postrun
     431        set postrun [lindex $args 0]
     432        if {[$obj has postrun]} {
     433            ui_debug "Warning: target '$name' re-registered post-run procedure (new procedure: '$postrun')"
     434        }
     435        $obj set postrun $postrun
    436436    } elseif {$mode == "requires" || $mode == "uses" || $mode == "provides"} {
    437                 $obj append $mode $args
     437        $obj append $mode $args
    438438       
    439439        if {$mode == "provides"} {
    … …  
    443443            # Thus if the user code breaks, dependent targets will not execute.
    444444            foreach target $args {
    445                                 if {[info commands $target] != ""} {
    446                                         ui_error "$name attempted to register provide \'$target\' which is a pre-existing procedure. Ignoring register."
    447                                         continue;
    448                                 }
     445                if {[info commands $target] != ""} {
     446                    ui_error "$name attempted to register provide \'$target\' which is a pre-existing procedure. Ignoring register."
     447                    continue;
     448                }
    449449                set ident [lindex [depspec_get_matches $targets provides $args] 0]
    450450                set origproc [$ident get procedure]
    451                                 set ident [$ident get name]
     451                set ident [$ident get name]
    452452                eval "proc $target {args} \{ \n\
    453453                                        global target_uniqid \n\
    … …  
    492492            }
    493493        }
    494 
    495         } elseif {$mode == "deplist"} {
    496                 $obj append $mode $args
     494       
     495    } elseif {$mode == "deplist"} {
     496        $obj append $mode $args
    497497       
    498498    } elseif {$mode == "preflight"} {
    499                 # Find target which provides the specified name, and add a preflight.
    500                 # XXX: this only returns the first match, is this what we want?
    501                 set obj [lindex [depspec_get_matches $targets provides $name] 0]
    502                 $obj append pre $args
    503                
     499        # Find target which provides the specified name, and add a preflight.
     500        # XXX: this only returns the first match, is this what we want?
     501        set obj [lindex [depspec_get_matches $targets provides $name] 0]
     502        $obj append pre $args
     503       
    504504    } elseif {$mode == "postflight"} {
    505                 # Find target which provides the specified name, and add a preflight.
    506                 # XXX: this only returns the first match, is this what we want?
    507                 set obj [lindex [depspec_get_matches $targets provides $name] 0]
    508                 $obj append post $args
    509         }
     505        # Find target which provides the specified name, and add a preflight.
     506        # XXX: this only returns the first match, is this what we want?
     507        set obj [lindex [depspec_get_matches $targets provides $name] 0]
     508        $obj append post $args
     509    }
    510510}
    511511
    … …  
    521521# returns a depspec by name
    522522proc dlist_get_by_name {dlist name} {
    523         set result ""
    524         foreach d $dlist {
    525                 if {[$d get name] == $name} {
    526                         set result $d
    527                         break
    528                 }
    529         }
    530         return $result
     523    set result ""
     524    foreach d $dlist {
     525        if {[$d get name] == $name} {
     526            set result $d
     527            break
     528        }
     529    }
     530    return $result
    531531}
    532532
    … …  
    535535    set result [list]
    536536    foreach d $dlist {
    537                 foreach val [$d get $key] {
    538                         if {$val == $value} {
    539                                 lappend result $d
    540                         }
    541                 }
     537        foreach val [$d get $key] {
     538            if {$val == $value} {
     539                lappend result $d
     540            }
     541        }
    542542    }
    543543    return $result
    … …  
    549549    set unmet 0
    550550    foreach name $names {
    551                 # Service was provided, check next.
    552                 if {[info exists upstatusdict($name)] && $upstatusdict($name) == 1} {
    553                         continue
    554                 } else {
    555                         incr unmet
    556                 }
     551        # Service was provided, check next.
     552        if {[info exists upstatusdict($name)] && $upstatusdict($name) == 1} {
     553            continue
     554        } else {
     555            incr unmet
     556        }
    557557    }
    558558    return $unmet
    … …  
    562562proc dlist_has_pending {dlist uses} {
    563563    foreach name $uses {
    564                 if {[llength [depspec_get_matches $dlist provides $name]] > 0} {
    565                         return 1
    566                 }
     564        if {[llength [depspec_get_matches $dlist provides $name]] > 0} {
     565            return 1
     566        }
    567567    }
    568568    return 0
    … …  
    577577   
    578578    foreach obj $dlist {               
    579                 # skip if unsatisfied hard dependencies
    580                 if {[dlist_count_unmet $dlist upstatusdict [$obj get requires]]} { continue }
    581                
    582                 # favor item with fewest unment soft dependencies
    583                 set unmet [dlist_count_unmet $dlist upstatusdict [$obj get uses]]
    584 
    585                 # delay items with unmet soft dependencies that can be filled
    586                 if {$unmet > 0 && [dlist_has_pending $dlist [$obj get uses]]} { continue }
    587                
    588                 if {$unmet >= $minfailed} {
    589                         # not better than our last pick
    590                         continue
    591                 } else {
    592                         # better than our last pick
    593                         set minfailed $unmet
    594                         set nextitem $obj
    595                 }
     579        # skip if unsatisfied hard dependencies
     580        if {[dlist_count_unmet $dlist upstatusdict [$obj get requires]]} { continue }
     581       
     582        # favor item with fewest unment soft dependencies
     583        set unmet [dlist_count_unmet $dlist upstatusdict [$obj get uses]]
     584       
     585        # delay items with unmet soft dependencies that can be filled
     586        if {$unmet > 0 && [dlist_has_pending $dlist [$obj get uses]]} { continue }
     587       
     588        if {$unmet >= $minfailed} {
     589            # not better than our last pick
     590            continue
     591        } else {
     592            # better than our last pick
     593            set minfailed $unmet
     594            set nextitem $obj
     595        }
    596596    }
    597597    return $nextitem
    … …  
    603603# get_next_proc is used to determine the best item to run
    604604proc dlist_evaluate {dlist get_next_proc} {
    605         global portname
     605    global portname
    606606       
    607607    # status - keys will be node names, values will be {-1, 0, 1}.
    608608    array set statusdict [list]
    609609       
    610         # XXX: Do we want to evaluate this dynamically instead of statically?
    611         foreach obj $dlist {
    612                 if {[$obj test] == 1} {
    613                         foreach name [$obj get provides] {
    614                                 set statusdict($name) 1
    615                         }
    616                         ldelete dlist $obj
    617                 }
    618         }
     610    # XXX: Do we want to evaluate this dynamically instead of statically?
     611    foreach obj $dlist {
     612        if {[$obj test] == 1} {
     613            foreach name [$obj get provides] {
     614                set statusdict($name) 1
     615            }
     616            ldelete dlist $obj
     617        }
     618    }
    619619   
    620620    # loop for as long as there are nodes in the dlist.
    621621    while (1) {
    622                 set obj [$get_next_proc $dlist statusdict]
    623 
    624                 if {$obj == ""} {
    625                         break
    626                 } else {
    627                         set result [$obj run]
    628                         # depspec->run returns an error code, so 0 == success.
    629                         # translate this to the statusdict notation where 1 == success.
    630                         foreach name [$obj get provides] {
    631                                 set statusdict($name) [expr $result == 0]
    632                         }
    633                        
    634                         # Delete the item from the waiting list.
    635                         ldelete dlist $obj
     622        set obj [$get_next_proc $dlist statusdict]
     623       
     624        if {$obj == ""} {
     625            break
     626        } else {
     627            set result [$obj run]
     628            # depspec->run returns an error code, so 0 == success.
     629            # translate this to the statusdict notation where 1 == success.
     630            foreach name [$obj get provides] {
     631                set statusdict($name) [expr $result == 0]
     632            }
     633           
     634            # Delete the item from the waiting list.
     635            ldelete dlist $obj
     636        }
     637    }
     638   
     639    if {[llength $dlist] > 0} {
     640        # somebody broke!
     641        ui_info "Warning: the following items did not execute (for $portname): "
     642        foreach obj $dlist {
     643            ui_info "[$obj get name] " -nonewline
     644        }
     645        ui_info ""
     646        return 1
     647    }
     648    return 0
     649}
     650
     651proc target_run {this} {
     652    global target_state_fd portname
     653    set result 0
     654    set procedure [$this get procedure]
     655    if {$procedure != ""} {
     656        set name [$this get name]
     657       
     658        if {[$this has init]} {
     659            set result [catch {[$this get init] $name} errstr]
     660        }
     661       
     662        if {[check_statefile $name $target_state_fd]} {
     663            set result 0
     664            ui_debug "Skipping completed $name ($portname)"
     665        } else {
     666            # Execute pre-run procedure
     667            if {[$this has prerun]} {
     668                set result [catch {[$this get prerun] $name} errstr]
     669            }
     670           
     671            if {$result == 0} {
     672                foreach pre [$this get pre] {
     673                    ui_debug "Executing $pre"
     674                    set result [catch {$pre $name} errstr]
     675                    if {$result != 0} { break }
    636676                }
    637     }
    638    
    639         if {[llength $dlist] > 0} {
    640                 # somebody broke!
    641                 ui_info "Warning: the following items did not execute (for $portname): "
    642                 foreach obj $dlist {
    643                         ui_info "[$obj get name] " -nonewline
     677            }
     678           
     679            if {$result == 0} {
     680                ui_debug "Executing $name ($portname)"
     681                set result [catch {$procedure $name} errstr]
     682            }
     683           
     684            if {$result == 0} {
     685                foreach post [$this get post] {
     686                    ui_debug "Executing $post"
     687                    set result [catch {$post $name} errstr]
     688                    if {$result != 0} { break }
    644689                }
    645                 ui_info ""
    646                 return 1
    647     }
    648         return 0
    649 }
    650 
    651 proc target_run {this} {
    652         global target_state_fd portname
    653         set result 0
    654         set procedure [$this get procedure]
    655     if {$procedure != ""} {
    656                 set name [$this get name]
    657        
    658                 if {[$this has init]} {
    659                         set result [catch {[$this get init] $name} errstr]
    660                 }
    661                                
    662                 if {[check_statefile $name $target_state_fd]} {
    663                         set result 0
    664                         ui_debug "Skipping completed $name ($portname)"
    665                 } else {
    666                         # Execute pre-run procedure
    667                         if {[$this has prerun]} {
    668                                 set result [catch {[$this get prerun] $name} errstr]
    669                         }
    670 
    671                         if {$result == 0} {
    672                                 foreach pre [$this get pre] {
    673                                         ui_debug "Executing $pre"
    674                                         set result [catch {$pre $name} errstr]
    675                                         if {$result != 0} { break }
    676                                 }
    677                         }
    678 
    679                         if {$result == 0} {
    680                                 ui_debug "Executing $name ($portname)"
    681                                 set result [catch {$procedure $name} errstr]
    682                         }
    683                        
    684                         if {$result == 0} {
    685                                 foreach post [$this get post] {
    686                                         ui_debug "Executing $post"
    687                                         set result [catch {$post $name} errstr]
    688                                         if {$result != 0} { break }
    689                                 }
    690                         }
    691                         # Execute post-run procedure
    692                         if {[$this has postrun] && $result == 0} {
    693                                 set postrun [$this get postrun]
    694                                 ui_debug "Executing $postrun"
    695                                 set result [catch {$postrun $name} errstr]
    696                         }
    697                 }
    698                 if {$result == 0} {
    699                         if {[$this get runtype] != "always"} {
    700                                 write_statefile $name $target_state_fd
    701                         }
    702                 } else {
    703                         ui_error "Target error: $name returned: $errstr"
    704                         set result 1
    705                 }
    706                
     690            }
     691            # Execute post-run procedure
     692            if {[$this has postrun] && $result == 0} {
     693                set postrun [$this get postrun]
     694                ui_debug "Executing $postrun"
     695                set result [catch {$postrun $name} errstr]
     696            }
     697        }
     698        if {$result == 0} {
     699            if {[$this get runtype] != "always"} {
     700                write_statefile $name $target_state_fd
     701            }
     702        } else {
     703            ui_error "Target error: $name returned: $errstr"
     704            set result 1
     705        }
     706       
    707707    } else {
    708                 ui_info "Warning: $name does not have a registered procedure"
    709                 set result 1
    710     }
    711 
     708        ui_info "Warning: $name does not have a registered procedure"
     709        set result 1
     710    }
     711   
    712712    return $result
    713713}
    714714
    715715proc eval_targets {target} {
    716         global targets target_state_fd
    717         set dlist $targets
    718 
     716    global targets target_state_fd
     717    set dlist $targets
     718   
    719719    # Select the subset of targets under $target
    720720    if {$target != ""} {
    721                 # XXX munge target. install really means registry, then install
    722                 # If more than one target ever needs this, make this a generic interface
    723                 if {$target == "install"} {
    724                         set target registry
    725                 }
     721        # XXX munge target. install really means registry, then install
     722        # If more than one target ever needs this, make this a generic interface
     723        if {$target == "install"} {
     724            set target registry
     725        }
    726726        set matches [depspec_get_matches $dlist provides $target]
    727727        if {[llength $matches] > 0} {
    728                         set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
    729                 # Special-case 'all'
     728            set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
     729            # Special-case 'all'
    730730        } elseif {$target != "all"} {
    731731            ui_info "unknown target: $target"
    … …  
    733733        }
    734734    }
    735        
     735   
    736736    # Restore the state from a previous run.
    737737    set target_state_fd [open_statefile]
    738738   
    739739    set ret [dlist_evaluate $dlist generic_get_next]
    740 
     740   
    741741    close $target_state_fd
    742         return $ret
     742    return $ret
    743743}
    744744
    745745# returns the names of dependents of <name> from the <itemlist>
    746746proc dlist_append_dependents {dlist obj result} {
    747 
    748         # Append the item to the list, avoiding duplicates
    749         if {[lsearch $result $obj] == -1} {
    750                 lappend result $obj
    751         }
    752        
     747   
     748    # Append the item to the list, avoiding duplicates
     749    if {[lsearch $result $obj] == -1} {
     750        lappend result $obj
     751    }
     752   
    753753    # Recursively append any hard dependencies
    754         foreach dep [$obj get requires] {
    755                 foreach provider [depspec_get_matches $dlist provides $dep] {
    756                         set result [dlist_append_dependents $dlist $provider $result]
     754    foreach dep [$obj get requires] {
     755        foreach provider [depspec_get_matches $dlist provides $dep] {
     756            set result [dlist_append_dependents $dlist $provider $result]
    757757        }
    758758    }
    759759    # XXX: add soft-dependencies?
    760         return $result
     760    return $result
    761761}
    762762
    … …  
    765765proc open_statefile {args} {
    766766    global portpath workdir
    767 
     767   
    768768    if ![file isdirectory $portpath/$workdir] {
    769769        file mkdir $portpath/$workdir
    … …  
    793793proc check_statefile {name fd} {
    794794    global portpath workdir
    795 
     795   
    796796    seek $fd 0
    797797    while {[gets $fd line] >= 0} {
    … …  
    844844proc choose_variants {dlist variations} {
    845845    upvar $variations upvariations
    846 
     846   
    847847    set selected [list]
    848848   
    849849    foreach obj $dlist {
    850                 # Enumerate through the provides, tallying the pros and cons.
    851                 set pros 0
    852                 set cons 0
    853                 set ignored 0
    854                 foreach flavor [$obj get provides] {
    855                         if {[info exists upvariations($flavor)]} {
    856                                 if {$upvariations($flavor) == "+"} {
    857                                         incr pros
    858                                 } elseif {$upvariations($flavor) == "-"} {
    859                                         incr cons
    860                                 }
    861                         } else {
    862                                 incr ignored
    863                         }
     850        # Enumerate through the provides, tallying the pros and cons.
     851        set pros 0
     852        set cons 0
     853        set ignored 0
     854        foreach flavor [$obj get provides] {
     855            if {[info exists upvariations($flavor)]} {
     856                if {$upvariations($flavor) == "+"} {
     857                    incr pros
     858                } elseif {$upvariations($flavor) == "-"} {
     859                    incr cons
    864860                }
    865                
    866                 if {$cons > 0} { continue }
    867                
    868                 if {$pros > 0 && $ignored == 0} {
    869                         lappend selected $obj
    870                 }
    871         }
     861            } else {
     862                incr ignored
     863            }
     864        }
     865       
     866        if {$cons > 0} { continue }
     867       
     868        if {$pros > 0 && $ignored == 0} {
     869            lappend selected $obj
     870        }
     871    }
    872872    return $selected
    873873}
    874874
    875875proc variant_run {this} {
    876         set name [$this get name]
     876    set name [$this get name]
    877877    ui_debug "Executing $name provides [$this get provides]"
    878878    makeuserproc $name-code "\{[$this get code]\}"
    879879    if ([catch $name-code result]) {
    880                 ui_error "Error executing $name: $result"
    881                 return 1
    882         }
     880        ui_error "Error executing $name: $result"
     881        return 1
     882    }
    883883    return 0
    884884}
    885885
    886886proc eval_variants {variations} {
    887         global variants
    888         set dlist $variants
    889         upvar $variations upvariations
    890         set chosen [choose_variants $dlist upvariations]
    891    
    892         # now that we've selected variants, change all provides [a b c] to [a-b-c]
     887    global variants
     888    set dlist $variants
     889    upvar $variations upvariations
     890    set chosen [choose_variants $dlist upvariations]
     891   
     892    # now that we've selected variants, change all provides [a b c] to [a-b-c]
    893893    # this will eliminate ambiguity between item a, b, and a-b while fulfilling requirments.
    894894    #foreach obj $dlist {
    895895    #    $obj set provides [list [join [$obj get provides] -]]
    896896    #}
    897        
    898         set newlist [list]
     897   
     898    set newlist [list]
    899899    foreach variant $chosen {
    900900        set newlist [dlist_append_dependents $dlist $variant $newlist]
    901901    }
    902 
     902   
    903903    dlist_evaluate $newlist generic_get_next
    904904}
    … …  
    934934# constructor for abstract depspec class
    935935proc depspec_new {name} {
    936         global depspec_uniqid
    937         set id [incr depspec_uniqid]
    938        
    939         # declare the array of data
    940         set data dpspc_data_${id}
    941         set disp dpspc_disp_${id}
    942        
    943         global $data
    944         set ${data}(name) $name
    945         set ${data}(_vtbl) depspec_vtbl
    946        
    947         eval "proc $disp {method args} { \n \
     936    global depspec_uniqid
     937    set id [incr depspec_uniqid]
     938   
     939    # declare the array of data
     940    set data dpspc_data_${id}
     941    set disp dpspc_disp_${id}
     942   
     943    global $data
     944    set ${data}(name) $name
     945    set ${data}(_vtbl) depspec_vtbl
     946   
     947    eval "proc $disp {method args} { \n \
    948948                        global $data \n \
    949949                        eval return \\\[depspec_dispatch $disp $data \$method \$args\\\] \n \
    950950                }"
    951        
    952         return $disp
     951   
     952    return $disp
    953953}
    954954
    … …  
    957957# the virtual members get a real "this" object.
    958958proc depspec_dispatch {this data method args} {
    959         global $data
    960         switch $method {
    961                 get {
    962                         set prop [lindex $args 0]
    963                         if {[eval info exists ${data}($prop)]} {
    964                                 eval return $${data}($prop)
    965                         } else {
    966                                 return ""
    967                         }
    968                 }
    969                 set {
    970                         set prop [lindex $args 0]
    971                         eval "set ${data}($prop) [lrange $args 1 end]"
    972                 }
    973                 has {
    974                         set prop [lindex $args 0]
    975                         return [info exists ${data}($prop)]
    976                 }
    977                 append {
    978                         set prop [lindex $args 0]
    979                         set vals [join [lrange $args 1 end] " "]
    980                         eval "lappend ${data}($prop) $vals"
    981                 }
    982                 default {
    983                         eval set vtbl $${data}(_vtbl)
    984                         global $vtbl
    985                         if {[info exists ${vtbl}($method)]} {
    986                                 eval set function $${vtbl}($method)
    987                                 eval "return \[$function $this $args\]"
    988                         } else {
    989                                 ui_error "unknown method: $method"
    990                         }
    991                 }
    992         }
    993         return ""
     959    global $data
     960    switch $method {
     961        get {
     962            set prop [lindex $args 0]
     963            if {[eval info exists ${data}($prop)]} {
     964                eval return $${data}($prop)
     965            } else {
     966                return ""
     967            }
     968        }
     969        set {
     970            set prop [lindex $args 0]
     971            eval "set ${data}($prop) [lrange $args 1 end]"
     972        }
     973        has {
     974            set prop [lindex $args 0]
     975            return [info exists ${data}($prop)]
     976        }
     977        append {
     978            set prop [lindex $args 0]
     979            set vals [join [lrange $args 1 end] " "]
     980            eval "lappend ${data}($prop) $vals"
     981        }
     982        default {
     983            eval set vtbl $${data}(_vtbl)
     984            global $vtbl
     985            if {[info exists ${vtbl}($method)]} {
     986                eval set function $${vtbl}($method)
     987                eval "return \[$function $this $args\]"
     988            } else {
     989                ui_error "unknown method: $method"
     990            }
     991        }
     992    }
     993    return ""
    994994}
    995995
    996996proc depspec_test {this} {
    997         return 0
     997    return 0
    998998}
    999999
    10001000proc depspec_run {this} {
    1001         return 0
     1001    return 0
    10021002}
    10031003
    … …  
    10111011# constructor for target depspec class
    10121012proc target_new {name} {
    1013         set obj [depspec_new $name]
    1014        
    1015         $obj set _vtbl target_vtbl
    1016 
    1017         return $obj
     1013    set obj [depspec_new $name]
     1014   
     1015    $obj set _vtbl target_vtbl
     1016   
     1017    return $obj
    10181018}
    10191019
    … …  
    10271027# constructor for target depspec class
    10281028proc variant_new {name} {
    1029         set obj [depspec_new $name]
    1030        
    1031         $obj set _vtbl variant_vtbl
    1032 
    1033         return $obj
     1029    set obj [depspec_new $name]
     1030   
     1031    $obj set _vtbl variant_vtbl
     1032   
     1033    return $obj
    10341034}
    10351035
    … …  
    10431043
    10441044proc portfile_new {name} {
    1045         set obj [depspec_new $name]
    1046        
    1047         $obj set _vtbl portfile_vtbl
    1048        
    1049         return $obj
     1045    set obj [depspec_new $name]
     1046   
     1047    $obj set _vtbl portfile_vtbl
     1048   
     1049    return $obj
    10501050}
    10511051
    10521052# build the specified portfile
    10531053proc portfile_run {this} {
    1054         set portname [$this get name]
    1055        
     1054    set portname [$this get name]
     1055   
    10561056    ui_debug "Building $portname"
    10571057    array set options [list]
    … …  
    10631063    }
    10641064    set porturl $portinfo(porturl)
    1065 
     1065   
    10661066    set worker [dportopen $porturl options variations]
    1067         if {[catch {dportexec $worker clean} result] || $result != 0} {
    1068                 ui_error "Clean of $portname before build failed: $result"
    1069                 dportclose $worker
    1070                 return -1
    1071     }
    1072         if {[catch {dportexec $worker install} result] || $result != 0} {
    1073                 ui_error "Build of $portname failed: $result"
    1074                 dportclose $worker
    1075                 return -1
    1076         }
    1077         if {[catch {dportexec $worker clean} result] || $result != 0} {
    1078                 ui_error "Clean of $portname after build failed: $result"
     1067    if {[catch {dportexec $worker clean} result] || $result != 0} {
     1068        ui_error "Clean of $portname before build failed: $result"
     1069        dportclose $worker
     1070        return -1
     1071    }
     1072    if {[catch {dportexec $worker install} result] || $result != 0} {
     1073        ui_error "Build of $portname failed: $result"
     1074        dportclose $worker
     1075        return -1
     1076    }
     1077    if {[catch {dportexec $worker clean} result] || $result != 0} {
     1078        ui_error "Clean of $portname after build failed: $result"
    10791079    }
    10801080    dportclose $worker
    1081        
     1081   
     1082    return 0
     1083}
     1084
     1085proc portfile_test {this} {
     1086    set receipt [registry_exists [$this get name]]
     1087    if {$receipt != ""} {
     1088        ui_debug "Found Dependency: receipt: $receipt"
     1089        return 1
     1090    } else {
    10821091        return 0
    1083 }
    1084 
    1085 proc portfile_test {this} {
    1086         set receipt [registry_exists [$this get name]]
    1087         if {$receipt != ""} {
    1088                 ui_debug "Found Dependency: receipt: $receipt"
    1089                 return 1
    1090         } else {
    1091                 return 0
    1092         }
     1092    }
    10931093}
    10941094
    10951095proc portfile_search_path {depregex search_path} {
    1096         set found 0
     1096    set found 0
    10971097    foreach path $search_path {
    1098                 if {![file isdirectory $path]} {
    1099                         continue
    1100                 }
    1101                 foreach filename [readdir $path] {
    1102                         if {[regexp $depregex $filename] == 1} {
    1103                                 ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
    1104                                 set found 1
    1105                                 break
    1106                         }
    1107                 }
    1108         }
    1109         return $found
     1098        if {![file isdirectory $path]} {
     1099            continue
     1100        }
     1101        foreach filename [readdir $path] {
     1102            if {[regexp $depregex $filename] == 1} {
     1103                ui_debug "Found Dependency: path: $path filename: $filename regex: $depregex"
     1104                set found 1
     1105                break
     1106            }
     1107        }
     1108    }
     1109    return $found
    11101110}
    11111111
    … …  
    11181118
    11191119proc libportfile_new {name match} {
    1120         set obj [portfile_new $name]
    1121        
    1122         $obj set _vtbl libportfile_vtbl
    1123         $obj set depregex $match
    1124        
    1125         return $obj
     1120    set obj [portfile_new $name]
     1121   
     1122    $obj set _vtbl libportfile_vtbl
     1123    $obj set depregex $match
     1124   
     1125    return $obj
    11261126}
    11271127
    … …  
    11351135
    11361136proc libportfile_test {this} {
    1137         global env prefix
    1138 
    1139         # Check the registry first
    1140         set result [portfile_test $this]
    1141         if {$result == 1} {
    1142                 return $result
     1137    global env prefix
     1138   
     1139    # Check the registry first
     1140    set result [portfile_test $this]
     1141    if {$result == 1} {
     1142        return $result
     1143    } else {
     1144        # Not in the registry, check the library path.
     1145        set depregex [$this get depregex]
     1146       
     1147        if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
     1148            lappend search_path $env(DYLD_FRAMEWORK_PATH)
    11431149        } else {
    1144                 # Not in the registry, check the library path.
    1145                 set depregex [$this get depregex]
    1146                
    1147                 if {[info exists env(DYLD_FRAMEWORK_PATH)]} {
    1148                 lappend search_path $env(DYLD_FRAMEWORK_PATH)
    1149                 } else {
    1150                 lappend search_path /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
    1151                 }
    1152                 if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
    1153                 lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
    1154                 }
    1155                 if {[info exists env(DYLD_LIBRARY_PATH)]} {
    1156                 lappend search_path $env(DYLD_LIBRARY_PATH)
    1157                 } else {
    1158                 lappend search_path /lib /usr/local/lib /lib /usr/lib /op/local/lib /usr/X11R6/lib ${prefix}/lib
    1159                 }
    1160                 if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
    1161                 lappend search_path $env(DYLD_LIBRARY_PATH)
    1162                 }
    1163                 regsub {\.} $depregex {\.} depregex
    1164                 set depregex \^$depregex.*\\.dylib\$
    1165 
    1166                 return [portfile_search_path $depregex $search_path]
    1167         }
     1150            lappend search_path /Library/Frameworks /Network/Library/Frameworks /System/Library/Frameworks
     1151        }
     1152        if {[info exists env(DYLD_FALLBACK_FRAMEWORK_PATH)]} {
     1153            lappend search_path $env(DYLD_FALLBACK_FRAMEWORK_PATH)
     1154        }
     1155        if {[info exists env(DYLD_LIBRARY_PATH)]} {
     1156            lappend search_path $env(DYLD_LIBRARY_PATH)
     1157        } else {
     1158            lappend search_path /lib /usr/local/lib /lib /usr/lib /op/local/lib /usr/X11R6/lib ${prefix}/lib
     1159        }
     1160        if {[info exists env(DYLD_FALLBACK_LIBRARY_PATH)]} {
     1161            lappend search_path $env(DYLD_LIBRARY_PATH)
     1162        }
     1163        regsub {\.} $depregex {\.} depregex
     1164        set depregex \^$depregex.*\\.dylib\$
     1165       
     1166        return [portfile_search_path $depregex $search_path]
     1167    }
    11681168}
    11691169
    … …  
    11741174
    11751175proc binportfile_new {name match} {
    1176         set obj [portfile_new $name]
    1177        
    1178         $obj set _vtbl binportfile_vtbl
    1179         $obj set depregex $match
    1180 
    1181         return $obj
     1176    set obj [portfile_new $name]
     1177   
     1178    $obj set _vtbl binportfile_vtbl
     1179    $obj set depregex $match
     1180   
     1181    return $obj
    11821182}
    11831183
    11841184proc binportfile_test {this} {
    1185         global env prefix
    1186 
    1187         # Check the registry first
    1188         set result [portfile_test $this]
    1189         if {$result == 1} {
    1190                 return $result
    1191         } else {
    1192                 # Not in the registry, check the binary path.
    1193                 set depregex [$this get depregex]
    1194 
    1195                 set search_path [split $env(PATH) :]
    1196                
    1197                 set depregex \^$depregex\$
    1198 
    1199                 return [portfile_search_path $depregex $search_path]
    1200         }
    1201 }
     1185    global env prefix
     1186   
     1187    # Check the registry first
     1188    set result [portfile_test $this]
     1189    if {$result == 1} {
     1190        return $result
     1191    } else {
     1192        # Not in the registry, check the binary path.
     1193        set depregex [$this get depregex]
     1194       
     1195        set search_path [split $env(PATH) :]
     1196       
     1197        set depregex \^$depregex\$
     1198       
     1199        return [portfile_search_path $depregex $search_path]
     1200    }
     1201}
Note: See TracChangeset for help on using the changeset viewer.