Changeset 2118 for trunk/base


Ignore:
Timestamp:
Mar 1, 2003, 11:37:04 PM (21 years ago)
Author:
kevin
Message:

Merging 3 days of diffs last good backup:

  • Use new dependency list package
  • Added accessors for portfile options
  • use cpio format pax(1) archives
Location:
trunk/base/src/port1.0
Files:
15 edited

Legend:

Unmodified
Added
Removed

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

    r1651 r2118  
    3434
    3535set com.apple.build [target_new com.apple.build build_main]
    36 ${com.apple.build} provides build
    37 ${com.apple.build} requires main fetch extract checksum patch configure
    38 ${com.apple.build} deplist depends_build depends_lib
    39 ${com.apple.build} set prerun build_start
     36target_provides ${com.apple.build} build
     37target_requires ${com.apple.build} main fetch extract checksum patch configure
     38target_prerun ${com.apple.build} build_start
    4039
    4140# define options
    … …  
    4948default build.target "all"
    5049
    51 
    5250set UI_PREFIX "---> "
    5351
    5452proc build_getmaketype {args} {
    55     global build.type build.cmd os.platform
    56 
    57     if ![info exists build.type] {
     53    if {![exists build.type]} {
    5854        return make
    5955    }
    60     switch -exact -- ${build.type} {
     56    switch -exact -- [option build.type] {
    6157        bsd {
    62             if {${os.platform} == "darwin"} {
     58            if {[option os.platform] == "darwin"} {
    6359                return bsdmake
    6460            } else {
    … …  
    6763        }
    6864        gnu {
    69             if {${os.platform} == "darwin"} {
     65            if {[option os.platform] == "darwin"} {
    7066                return gnumake
    7167            } else {
    … …  
    7773        }
    7874        default {
    79             ui_warn "[format [msgcat::mc "Unknown build.type %s, using 'gnumake'"] ${build.type}]"
     75            ui_warn "[format [msgcat::mc "Unknown build.type %s, using 'gnumake'"] [option build.type]]"
    8076            return gnumake
    8177        }
    … …  
    8480
    8581proc build_start {args} {
    86     global UI_PREFIX portname build.target
     82    global UI_PREFIX
    8783
    88     ui_msg "$UI_PREFIX [format [msgcat::mc "Building %s with target %s"] ${portname} ${build.target}]"
     84    ui_msg "$UI_PREFIX [format [msgcat::mc "Building %s with target %s"] [option portname] [option build.target]]"
    8985}
    9086

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

    r1638 r2118  
    3434
    3535set com.apple.checksum [target_new com.apple.checksum checksum_main]
    36 ${com.apple.checksum} provides checksum
    37 ${com.apple.checksum} requires main fetch
    38 ${com.apple.checksum} set prerun checksum_start
     36target_provides ${com.apple.checksum} checksum
     37target_requires ${com.apple.checksum} main fetch
     38target_prerun ${com.apple.checksum} checksum_start
    3939
    4040# define options
    … …  
    6565
    6666proc dmd5 {file} {
    67     global checksums
    68 
    69     foreach {name type sum} $checksums {
     67    foreach {name type sum} [option checksums] {
    7068        if {$name == $file} {
    7169            return $sum
    … …  
    8280
    8381proc checksum_main {args} {
    84     global checksums distpath all_dist_files UI_PREFIX
     82    global distpath all_dist_files UI_PREFIX
    8583
    8684    # If no files have been downloaded there is nothing to checksum
    … …  
    8987    }
    9088
    91     if ![info exists checksums] {
     89    if {![exists checksums]} {
    9290        ui_error "[msgcat::mc "No checksums statement in Portfile.  File checksums are:"]"
    9391        foreach distfile $all_dist_files {
    … …  
    9896
    9997    # Optimization for the 2 argument case for checksums
    100     if {[llength $checksums] == 2 && [llength $all_dist_files] == 1} {
    101         set checksums [linsert $checksums 0 $all_dist_files]
     98    if {[llength [option checksums]] == 2 && [llength $all_dist_files] == 1} {
     99        option checksums [linsert [option checksums] 0 $all_dist_files]
    102100    }
    103101

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

    r1638 r2118  
    3636
    3737set com.apple.clean [target_new com.apple.clean clean_main]
    38 ${com.apple.clean} set runtype always
    39 ${com.apple.clean} provides clean
    40 ${com.apple.clean} requires main
    41 ${com.apple.clean} set prerun clean_start
     38target_runtype ${com.apple.clean} always
     39target_provides ${com.apple.clean} clean
     40target_requires ${com.apple.clean} main
     41target_prerun ${com.apple.clean} clean_start
     42
     43set UI_PREFIX "--->"
    4244
    4345proc clean_start {args} {
    44     global UI_PREFIX portname
     46    global UI_PREFIX
    4547
    46     ui_msg "$UI_PREFIX [format [msgcat::mc "Cleaning %s"] $portname]"
     48    ui_msg "$UI_PREFIX [format [msgcat::mc "Cleaning %s"] [option portname]]"
    4749}
    4850
    4951proc clean_main {args} {
    50     global workpath
    51     exec rm -rf [file join ${workpath}]
     52    exec rm -rf [file join [option workpath]]
    5253    return 0
    5354}

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

    r1638 r2118  
    3434
    3535set com.apple.configure [target_new com.apple.configure configure_main]
    36 ${com.apple.configure} provides configure
    37 ${com.apple.configure} requires main fetch extract checksum patch
    38 ${com.apple.configure} deplist depends_build depends_lib
    39 ${com.apple.configure} set prerun configure_start
     36target_provides ${com.apple.configure} configure
     37target_requires ${com.apple.configure} main fetch extract checksum patch
     38target_prerun ${com.apple.configure} configure_start
    4039
    4140# define options
    … …  
    5453
    5554proc configure_start {args} {
    56     global UI_PREFIX portname
     55    global UI_PREFIX
    5756
    58     ui_msg "$UI_PREFIX [format [msgcat::mc "Configuring %s"] $portname]"
     57    ui_msg "$UI_PREFIX [format [msgcat::mc "Configuring %s"] [option portname]]"
    5958}
    6059

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

    r1638 r2118  
    3434
    3535set com.apple.contents [target_new com.apple.contents contents_main]
    36 ${com.apple.contents} set runtype always
    37 ${com.apple.contents} provides toc
    38 ${com.apple.contents} requires main
     36target_runtype ${com.apple.contents} always
     37target_provides ${com.apple.contents} toc
     38target_requires ${com.apple.contents} main
    3939
    4040set UI_PREFIX "---> "

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

    r1642 r2118  
    3737
    3838# define options
    39 options depends_fetch depends_build depends_run depends_extract depends_lib
     39options depends_build depends_run depends_lib
    4040# Export options via PortInfo
    41 options_export depends_lib depends_run
     41options_export depends_build depends_lib depends_run
    4242
    43 option_proc depends_fetch handle_depends_options
    44 option_proc depends_build handle_depends_options
    45 option_proc depends_run handle_depends_options
    46 option_proc depends_extract handle_depends_options
    47 option_proc depends_lib handle_depends_options
     43option_proc depends_build validate_depends_options
     44option_proc depends_run validate_depends_options
     45option_proc depends_lib validate_depends_options
    4846
    49 proc handle_depends_options {option action args} {
     47proc validate_depends_options {option action args} {
    5048    global targets
    5149    switch -regex $action {
    52         set|append {
     50        set|append|delete {
    5351            foreach depspec $args {
    5452                        if {[regexp {([A-Za-z\./0-9]+):([A-Za-z0-9_/\-\.$^\?\+\(\)\|\\]+):([-A-Za-z\./0-9_]+)} "$depspec" match deppath depregex portname] == 1} {
    5553                                switch $deppath {
    56                                         lib { set obj [libportfile_new $portname $depregex] }
    57                                         bin { set obj [binportfile_new $portname $depregex] }
    58                                         path { set obj [pathportfile_new $portname $depregex] }
    59                                 }
    60                                 if {[info exists obj]} {
    61                                         $obj append provides $option portfile-$portname
    62                                         lappend targets $obj
    63                                         foreach obj [depspec_get_matches $targets deplist $option] {
    64                                                 $obj append requires portfile-$portname
    65                                         }
    66                                 } else {
    67                                         return -code error [format [msgcat::mc "unknown depspec type: %s"] $deppath]
     54                                        lib {}
     55                                        bin {}
     56                                        path {}
     57                                        default {return -code error [format [msgcat::mc "unknown depspec type: %s"] $deppath]}
    6858                                }
    6959                        } else {
    … …  
    7262            }
    7363        }
    74         delete {
    75             # xxx: need to delete requirement from each item in the deplist
    76         }
    7764    }
    7865}

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

    r1766 r2118  
    3434
    3535set com.apple.extract [target_new com.apple.extract extract_main]
    36 ${com.apple.extract} set init extract_init
    37 ${com.apple.extract} provides extract
    38 ${com.apple.extract} requires fetch checksum
    39 ${com.apple.extract} deplist depends_extract
    40 ${com.apple.extract} set prerun extract_start
     36target_init ${com.apple.extract} extract_init
     37target_provides ${com.apple.extract} extract
     38target_requires ${com.apple.extract} fetch checksum
     39target_prerun ${com.apple.extract} extract_start
    4140
    4241# define options
    … …  
    5958    global extract.only extract.dir extract.cmd extract.pre_args extract.post_args distfiles use_bzip2 use_zip workpath
    6059
    61     if [info exists use_bzip2] {
    62         set extract.cmd bzip2
    63     } elseif [info exists use_zip] {
    64         set extract.cmd unzip
    65         set extract.pre_args -q
    66         set extract.post_args "-d ${extract.dir}"
     60    if [exists use_bzip2] {
     61                option extract.cmd bzip2
     62    } elseif [exists use_zip] {
     63                option extract.cmd unzip
     64                option extract.pre_args -q
     65                option extract.post_args "-d [option extract.dir]"
    6766    }
    6867}
    6968
    7069proc extract_start {args} {
    71     global UI_PREFIX portname
     70    global UI_PREFIX
    7271
    73     ui_msg "$UI_PREFIX [format [msgcat::mc "Extracting %s"] $portname]"
     72    ui_msg "$UI_PREFIX [format [msgcat::mc "Extracting %s"] [option portname]]"
    7473}
    7574
    7675proc extract_main {args} {
    77     global portname distname distpath distfiles use_bzip2 extract.only extract.cmd extract.before_args extract.after_args extract.args UI_PREFIX
     76    global UI_PREFIX
    7877
    79     if {![info exists distfiles] && ![info exists extract.only]} {
     78    if {![exists distfiles] && ![exists extract.only]} {
    8079        # nothing to do
    8180        return 0
    8281    }
    8382
    84     foreach distfile ${extract.only} {
     83    foreach distfile [option extract.only] {
    8584        ui_info "$UI_PREFIX [format [msgcat::mc "Extracting %s"] $distfile] ... " -nonewline
    86         set extract.args "$distpath/$distfile"
     85        option extract.args "[option distpath]/$distfile"
    8786        if [catch {system "[command extract]"} result] {
    8887            return -code error "$result"

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

    r1924 r2118  
    3434
    3535set com.apple.fetch [target_new com.apple.fetch fetch_main]
    36 ${com.apple.fetch} set init fetch_init
    37 ${com.apple.fetch} provides fetch
    38 ${com.apple.fetch} requires main
    39 ${com.apple.fetch} deplist depends_fetch
    40 ${com.apple.fetch} set prerun fetch_start
     36target_init ${com.apple.fetch} fetch_init
     37target_provides ${com.apple.fetch} fetch
     38target_requires ${com.apple.fetch} main
     39target_prerun ${com.apple.fetch} fetch_start
    4140
    4241# define options: distname master_sites

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

    r2075 r2118  
    3434
    3535set com.apple.install [target_new com.apple.install install_main]
    36 ${com.apple.install} set runtype always
    37 ${com.apple.install} provides install
    38 ${com.apple.install} requires main fetch extract checksum patch configure build
    39 ${com.apple.install} deplist depends_run depends_lib
    40 ${com.apple.install} set prerun install_start
    41 ${com.apple.install} set postrun install_registry
     36target_runtype ${com.apple.install} always
     37target_provides ${com.apple.install} install
     38target_requires ${com.apple.install} main fetch extract checksum patch configure build
     39target_prerun ${com.apple.install} install_start
     40target_postrun ${com.apple.install} install_registry
    4241
    4342# define options

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

    r1790 r2118  
    3737
    3838set com.apple.main [target_new com.apple.main main]
    39 ${com.apple.main} provides main
     39target_provides ${com.apple.main} main
    4040
    4141# define options

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

    r2059 r2118  
    3434
    3535set com.apple.mpkg [target_new com.apple.mpkg mpkg_main]
    36 ${com.apple.mpkg} set runtype always
    37 ${com.apple.mpkg} provides mpkg
    38 ${com.apple.mpkg} requires package
     36target_runtype ${com.apple.mpkg} always
     37target_provides ${com.apple.mpkg} mpkg
     38target_requires ${com.apple.mpkg} package
    3939
    4040# define options

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

    r2059 r2118  
    3434
    3535set com.apple.package [target_new com.apple.package package_main]
    36 ${com.apple.package} set runtype always
    37 ${com.apple.package} provides package
    38 ${com.apple.package} requires install
     36target_runtype ${com.apple.package} always
     37target_provides ${com.apple.package} package
     38target_requires ${com.apple.package} install
    3939
    4040# define options
    … …  
    7777    system "mkbom ${destpath} ${pkgpath}/Contents/Archive.bom"
    7878    system "cd ${pkgpath}/Contents/Resources/ && ln -fs ../Archive.bom ${portname}-${portversion}.bom"
    79     system "cd ${destpath} && pax -w -z . > ${pkgpath}/Contents/Archive.pax.gz"
     79    system "cd ${destpath} && pax -x cpio -w -z . > ${pkgpath}/Contents/Archive.pax.gz"
    8080    system "cd ${pkgpath}/Contents/Resources/ && ln -fs ../Archive.pax.gz ${portname}-${portversion}.pax.gz"
    8181

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

    r1638 r2118  
    3434
    3535set com.apple.patch [target_new com.apple.patch patch_main]
    36 ${com.apple.patch} provides patch
    37 ${com.apple.patch} requires main fetch checksum extract
    38 ${com.apple.patch} deplist depends_build depends_lib
     36target_provides ${com.apple.patch} patch
     37target_requires ${com.apple.patch} main fetch checksum extract
    3938
    4039set UI_PREFIX "---> "
    … …  
    4847
    4948proc patch_main {args} {
    50     global portname patchfiles distpath filespath workpath worksrcpath UI_PREFIX
     49    global UI_PREFIX
    5150
    5251    # First make sure that patchfiles exists and isn't stubbed out.
    53     if ![info exists patchfiles] {
     52    if {![exists patchfiles]} {
    5453        return 0
    5554    }
    5655
    57     foreach patch $patchfiles {
    58         if [file exists $filespath/$patch] {
    59             lappend patchlist $filespath/$patch
    60         } elseif [file exists $distpath/$patch] {
    61             lappend patchlist $distpath/$patch
     56    foreach patch [option patchfiles] {
     57        if [file exists [option filespath]/$patch] {
     58            lappend patchlist [option filespath]/$patch
     59        } elseif [file exists [option distpath]/$patch] {
     60            lappend patchlist [option distpath]/$patch
    6261        }
    6362    }
    … …  
    6564        return -code error [msgcat::mc "Patch files missing"]
    6665    }
    67     cd ${worksrcpath}
     66    cd [option worksrcpath]
    6867    foreach patch $patchlist {
    6968        ui_info "$UI_PREFIX [format [msgcat::mc "Applying %s"] $patch]"

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

    r1888 r2118  
    3434
    3535set com.apple.uninstall [target_new com.apple.uninstall uninstall_main]
    36 ${com.apple.uninstall} set runtype always
    37 ${com.apple.uninstall} provides uninstall
    38 ${com.apple.uninstall} requires main
    39 ${com.apple.uninstall} set prerun uninstall_start
     36target_runtype ${com.apple.uninstall} always
     37target_provides ${com.apple.uninstall} uninstall
     38target_requires ${com.apple.uninstall} main
     39target_prerun ${com.apple.uninstall} uninstall_start
    4040
    4141# define options

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

    r2070 r2118  
    3232package provide portutil 1.0
    3333package require Pextlib 1.0
     34package require darwinports_dlist 1.0
    3435package require msgcat
    3536
    … …  
    4445
    4546namespace eval options {
     47}
     48
     49# option
     50# This is an accessor for Portfile options.  Targets may use
     51# this in the same style as the standard Tcl "set" procedure.
     52#       name  - the name of the option to read or write
     53#       value - an optional value to assign to the option
     54
     55proc option {name args} {
     56        # XXX: right now we just transparently use globals
     57        # eventually this will need to bridge the options between
     58        # the Portfile's interpreter and the target's interpreters.
     59        global $name
     60        if {[llength $args] > 0} {
     61                ui_debug "setting option $name to $args"
     62                set $name [lindex $args 0]
     63        }
     64        return [set $name]
     65}
     66
     67# exists
     68# This is an accessor for Portfile options.  Targets may use
     69# this procedure to test for the existence of a Portfile option.
     70#       name - the name of the option to test for existence
     71
     72proc exists {name} {
     73        # XXX: right now we just transparently use globals
     74        # eventually this will need to bridge the options between
     75        # the Portfile's interpreter and the target's interpreters.
     76        global $name
     77        return [info exists $name]
    4678}
    4779
    … …  
    253285    set args [lrange $args 0 [expr $len - 2]]
    254286   
    255     set obj [variant_new "temp-variant"]
     287    set ditem [variant_new "temp-variant"]
    256288   
    257289    # mode indicates what the arg is interpreted as.
    … …  
    265297                        requires { set mode "requires" }
    266298                        conflicts { set mode "conflicts" }
    267                         default { $obj append $mode $arg }             
     299                        default { ditem_append $ditem $mode $arg }             
    268300        }
    269301    }
    270     $obj set name "[join [$obj get provides] -]"
     302    ditem_key $ditem name "[join [ditem_key $ditem provides] -]"
    271303
    272304    # make a user procedure named variant-blah-blah
    273305    # we will call this procedure during variant-run
    274     makeuserproc "variant-[$obj get name]" \{$code\}
    275     lappend all_variants $obj
     306    makeuserproc "variant-[ditem_key $ditem name]" \{$code\}
     307    lappend all_variants $ditem
    276308   
    277309    # Export provided variant to PortInfo
    278     lappend PortInfo(variants) [$obj get provides]
     310    lappend PortInfo(variants) [ditem_key $ditem provides]
    279311}
    280312
    … …  
    400432########### Internal Dependancy Manipulation Procedures ###########
    401433
    402 # returns a depspec by name
    403 proc dlist_get_by_name {dlist name} {
    404     set result ""
    405     foreach d $dlist {
    406         if {[$d get name] == $name} {
    407             set result $d
    408             break
    409         }
    410     }
    411     return $result
    412 }
    413 
    414 # returns a list of depspecs that contain the given name in the given key
    415 proc depspec_get_matches {dlist key value} {
    416     set result [list]
    417     foreach d $dlist {
    418         foreach val [$d get $key] {
    419             if {$val == $value} {
    420                 lappend result $d
    421             }
    422         }
    423     }
    424     return $result
    425 }
    426 
    427 # Count the unmet dependencies in the dlist based on the statusdict
    428 proc dlist_count_unmet {dlist statusdict names} {
    429     upvar $statusdict upstatusdict
    430     set unmet 0
    431     foreach name $names {
    432         # Service was provided, check next.
    433         if {[info exists upstatusdict($name)] && $upstatusdict($name) == 1} {
    434             continue
    435         } else {
    436             incr unmet
    437         }
    438     }
    439     return $unmet
    440 }
    441 
    442 # Returns true if any of the dependencies are pending in the dlist
    443 proc dlist_has_pending {dlist uses} {
    444     foreach name $uses {
    445         if {[llength [depspec_get_matches $dlist provides $name]] > 0} {
    446             return 1
    447         }
    448     }
    449     return 0
    450 }
    451 
    452 # Get the name of the next eligible item from the dependency list
    453 proc generic_get_next {dlist statusdict} {
    454     set nextitem ""
    455     # arbitrary large number ~ INT_MAX
    456     set minfailed 2000000000
    457     upvar $statusdict upstatusdict
    458    
    459     foreach obj $dlist {               
    460         # skip if unsatisfied hard dependencies
    461         if {[dlist_count_unmet $dlist upstatusdict [$obj get requires]]} { continue }
    462        
    463         # favor item with fewest unment soft dependencies
    464         set unmet [dlist_count_unmet $dlist upstatusdict [$obj get uses]]
    465        
    466         # delay items with unmet soft dependencies that can be filled
    467         if {$unmet > 0 && [dlist_has_pending $dlist [$obj get uses]]} { continue }
    468        
    469         if {$unmet >= $minfailed} {
    470             # not better than our last pick
    471             continue
    472         } else {
    473             # better than our last pick
    474             set minfailed $unmet
    475             set nextitem $obj
    476         }
    477     }
    478     return $nextitem
    479 }
    480 
    481 
    482 # Evaluate the list of depspecs, running each as it becomes eligible.
    483 # dlist is a collection of depspec objects to be run
    484 # get_next_proc is used to determine the best item to run
    485 proc dlist_evaluate {dlist get_next_proc} {
    486     global portname
    487    
    488     # status - keys will be node names, values will be {-1, 0, 1}.
    489     array set statusdict [list]
    490    
    491     # XXX: Do we want to evaluate this dynamically instead of statically?
    492     foreach obj $dlist {
    493         if {[$obj test] == 1} {
    494             foreach name [$obj get provides] {
    495                 set statusdict($name) 1
    496             }
    497             ldelete dlist $obj
    498         }
    499     }
    500    
    501     # loop for as long as there are nodes in the dlist.
    502     while (1) {
    503         set obj [$get_next_proc $dlist statusdict]
    504        
    505         if {$obj == ""} {
    506             break
    507         } else {
    508             catch {$obj run} result
    509             # depspec->run returns an error code, so 0 == success.
    510             # translate this to the statusdict notation where 1 == success.
    511             foreach name [$obj get provides] {
    512                 set statusdict($name) [expr $result == 0]
    513             }
    514            
    515             # Delete the item from the waiting list.
    516             ldelete dlist $obj
    517         }
    518     }
    519    
    520     if {[llength $dlist] > 0} {
    521         # somebody broke!
    522         ui_info "Warning: the following items did not execute (for $portname): "
    523         foreach obj $dlist {
    524             ui_info "[$obj get name] " -nonewline
    525         }
    526         ui_info ""
    527         return 1
    528     }
    529     return 0
    530 }
    531 
    532 proc target_run {this} {
     434proc target_run {ditem} {
    533435    global target_state_fd portname
    534436    set result 0
    535     set procedure [$this get procedure]
     437    set procedure [ditem_key $ditem procedure]
    536438    if {$procedure != ""} {
    537         set name [$this get name]
    538        
    539         if {[$this has init]} {
    540             set result [catch {[$this get init] $name} errstr]
     439        set name [ditem_key $ditem name]
     440       
     441        if {[ditem_contains $ditem init]} {
     442            set result [catch {[ditem_key $ditem init] $name} errstr]
    541443        }
    542444       
    … …  
    546448        } elseif {$result == 0} {
    547449            # Execute pre-run procedure
    548             if {[$this has prerun]} {
    549                 set result [catch {[$this get prerun] $name} errstr]
     450            if {[ditem_contains $ditem prerun]} {
     451                set result [catch {[ditem_key $ditem prerun] $name} errstr]
    550452            }
    551453           
    552454            if {$result == 0} {
    553                 foreach pre [$this get pre] {
     455                foreach pre [ditem_key $ditem pre] {
    554456                    ui_debug "Executing $pre"
    555457                    set result [catch {$pre $name} errstr]
    … …  
    564466           
    565467            if {$result == 0} {
    566                 foreach post [$this get post] {
     468                foreach post [ditem_key $ditem post] {
    567469                    ui_debug "Executing $post"
    568470                    set result [catch {$post $name} errstr]
    … …  
    571473            }
    572474            # Execute post-run procedure
    573             if {[$this has postrun] && $result == 0} {
    574                 set postrun [$this get postrun]
     475            if {[ditem_contains $ditem postrun] && $result == 0} {
     476                set postrun [ditem_key $ditem postrun]
    575477                ui_debug "Executing $postrun"
    576478                set result [catch {$postrun $name} errstr]
    … …  
    578480        }
    579481        if {$result == 0} {
    580             if {[$this get runtype] != "always"} {
     482            if {[ditem_key $ditem runtype] != "always"} {
    581483                write_statefile target $name $target_state_fd
    582484            }
    … …  
    595497
    596498proc eval_targets {target} {
    597     global targets target_state_fd
     499    global targets target_state_fd portname
    598500    set dlist $targets
    599    
    600     # Select the subset of targets under $target
     501           
     502        # Select the subset of targets under $target
    601503    if {$target != ""} {
    602         set matches [depspec_get_matches $dlist provides $target]
     504        set matches [dlist_search $dlist provides $target]
     505
    603506        if {[llength $matches] > 0} {
    604             set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
    605             # Special-case 'all'
    606         } elseif {$target != "all"} {
    607             ui_info "unknown target: $target"
     507                        set dlist [dlist_append_dependents $dlist [lindex $matches 0] [list]]
     508                        # Special-case 'all'
     509                } elseif {$target != "all"} {
     510                        ui_info "unknown target: $target"
    608511            return 1
    609512        }
    610513    }
    611    
     514       
    612515    # Restore the state from a previous run.
    613516    set target_state_fd [open_statefile]
    614517   
    615     set ret [dlist_evaluate $dlist generic_get_next]
    616    
     518    set dlist [dlist_eval $dlist "" target_run]
     519
     520    if {[llength $dlist] > 0} {
     521                # somebody broke!
     522                ui_info "Warning: the following items did not execute (for $portname): "
     523                foreach ditem $dlist {
     524                        ui_info "[ditem_key $ditem name] " -nonewline
     525                }
     526                ui_info ""
     527                set result 1
     528        } else {
     529                set result 0
     530        }
     531       
    617532    close $target_state_fd
    618     return $ret
    619 }
    620 
    621 # returns the names of dependents of <name> from the <itemlist>
    622 proc dlist_append_dependents {dlist obj result} {
    623    
    624     # Append the item to the list, avoiding duplicates
    625     if {[lsearch $result $obj] == -1} {
    626         lappend result $obj
    627     }
    628    
    629     # Recursively append any hard dependencies
    630     foreach dep [$obj get requires] {
    631         foreach provider [depspec_get_matches $dlist provides $dep] {
    632             set result [dlist_append_dependents $dlist $provider $result]
    633         }
    634     }
    635     # XXX: add soft-dependencies?
    636533    return $result
    637534}
    … …  
    759656    set selected [list]
    760657   
    761     foreach obj $dlist {
     658    foreach ditem $dlist {
    762659        # Enumerate through the provides, tallying the pros and cons.
    763660        set pros 0
    764661        set cons 0
    765662        set ignored 0
    766         foreach flavor [$obj get provides] {
     663        foreach flavor [ditem_key $ditem provides] {
    767664            if {[info exists upvariations($flavor)]} {
    768665                if {$upvariations($flavor) == "+"} {
    … …  
    779676       
    780677        if {$pros > 0 && $ignored == 0} {
    781             lappend selected $obj
     678            lappend selected $ditem
    782679        }
    783680    }
    … …  
    785682}
    786683
    787 proc variant_run {this} {
    788     set name [$this get name]
    789     ui_debug "Executing $name provides [$this get provides]"
     684proc variant_run {ditem} {
     685    set name [ditem_key $ditem name]
     686    ui_debug "Executing $name provides [ditem_key $ditem provides]"
    790687
    791688        # test for conflicting variants
    792         foreach v [$this get conflicts] {
     689        foreach v [ditem_key $ditem conflicts] {
    793690                if {[variant_isset $v]} {
    794691                        ui_error "Variant $name conflicts with $v"
    … …  
    823720    }
    824721   
    825     dlist_evaluate $newlist generic_get_next
     722    dlist_eval $newlist "" variant_run
    826723       
    827724        # Make sure the variations match those stored in the statefile.
    … …  
    852749}
    853750
    854 ##### DEPSPEC #####
    855 
    856 # Object-Oriented Depspecs
    857 #
    858 # Each depspec will have its data stored in an array
    859 # (indexed by field name) and its procedures will be
    860 # called via the dispatch procedure that is returned
    861 # from depspec_new.
    862 #
    863 # sample usage:
    864 # set obj [depspec_new]
    865 # $obj set name "hello"
    866 #
    867 
    868 # Depspec
    869 #       str name
    870 #       str provides[]
    871 #       str requires[]
    872 #       str uses[]
    873 
    874 global depspec_uniqid
    875 set depspec_uniqid 0
    876 
    877 # Depspec class definition.
    878 global depspec_vtbl
    879 set depspec_vtbl(test) depspec_test
    880 set depspec_vtbl(run) depspec_run
    881 set depspec_vtbl(get) depspec_get
    882 set depspec_vtbl(set) depspec_set
    883 set depspec_vtbl(has) depspec_has
    884 set depspec_vtbl(append) depspec_append
    885 
    886 # constructor for abstract depspec class
    887 proc depspec_new {name} {
    888     global depspec_uniqid
    889     set id [incr depspec_uniqid]
    890    
    891     # declare the array of data
    892     set data dpspc_data_${id}
    893     set disp dpspc_disp_${id}
    894    
    895     global $data
    896     set ${data}(name) $name
    897     set ${data}(_vtbl) depspec_vtbl
    898    
    899     eval "proc $disp {method args} { \n \
    900                         global $data \n \
    901                         eval return \\\[depspec_dispatch $disp $data \$method \$args\\\] \n \
    902                 }"
    903    
    904     return $disp
    905 }
    906 
    907 proc depspec_get {this prop} {
    908     set data [$this _data]
    909     global $data
    910     if {[eval info exists ${data}($prop)]} {
    911         eval return $${data}($prop)
    912     } else {
    913         return ""
    914     }
    915 }
    916 
    917 proc depspec_set {this prop args} {
    918     set data [$this _data]
    919     global $data
    920     eval "set ${data}($prop) \"$args\""
    921 }
    922 
    923 proc depspec_has {this prop} {
    924     set data [$this _data]
    925     global $data
    926     eval return \[info exists ${data}($prop)\]
    927 }
    928 
    929 proc depspec_append {this prop args} {
    930     set data [$this _data]
    931     global $data
    932     set vals [join $args " "]
    933     eval lappend ${data}($prop) $vals
    934 }
    935 
    936 # is the only proc to get direct access to the object's data
    937 # so the _data accessor has to be defined here.  all other
    938 # methods are looked up in the virtual function table,
    939 # and are called with {$this $args}.
    940 proc depspec_dispatch {this data method args} {
    941     global $data
    942     if {$method == "_data"} { return $data }
    943     eval set vtbl $${data}(_vtbl)
    944     global $vtbl
    945     if {[info exists ${vtbl}($method)]} {
    946         eval set function $${vtbl}($method)
    947         eval "return \[$function $this $args\]"
    948     } else {
    949         ui_error "unknown method: $method"
    950     }
    951     return ""
    952 }
    953 
    954 proc depspec_test {this} {
    955     return 0
    956 }
    957 
    958 proc depspec_run {this} {
    959     return 0
    960 }
    961 
    962 ##### target depspec subclass #####
    963 
    964751# Target class definition.
    965 global target_vtbl
    966 array set target_vtbl [array get depspec_vtbl]
    967 set target_vtbl(run) target_run
    968 set target_vtbl(provides) target_provides
    969 set target_vtbl(requires) target_requires
    970 set target_vtbl(uses) target_uses
    971 set target_vtbl(deplist) target_deplist
    972 set target_vtbl(prerun) target_prerun
    973 set target_vtbl(postrun) target_postrun
    974 
    975 # constructor for target depspec class
     752
     753# constructor for target object
    976754proc target_new {name procedure} {
    977755    global targets
    978     set obj [depspec_new $name]
    979    
    980     $obj set _vtbl target_vtbl
    981     $obj set procedure $procedure
    982    
    983     lappend targets $obj
    984    
    985     return $obj
    986 }
    987 
    988 proc target_provides {this args} {
     756    set ditem [ditem_create]
     757       
     758        ditem_key $ditem name $name
     759        ditem_key $ditem procedure $procedure
     760   
     761    lappend targets $ditem
     762   
     763    return $ditem
     764}
     765
     766proc target_provides {ditem args} {
    989767    global targets
    990768    # Register the pre-/post- hooks for use in Portfile.
    … …  
    993771    # Thus if the user code breaks, dependent targets will not execute.
    994772    foreach target $args {
    995         set origproc [$this get procedure]
    996         set ident [$this get name]
     773        set origproc [ditem_key $ditem procedure]
     774        set ident [ditem_key $ditem name]
    997775        if {[info commands $target] != ""} {
    998             ui_debug "[$this get name] registered provides \'$target\', a pre-existing procedure. Target override will not be provided"
     776            ui_debug "$ident registered provides \'$target\', a pre-existing procedure. Target override will not be provided"
    999777        } else {
    1000778                eval "proc $target {args} \{ \n\
    1001                         $this set procedure proc-${ident}-${target}
     779                        ditem_key $ditem procedure proc-${ident}-${target}
    1002780                        eval \"proc proc-${ident}-${target} \{name\} \{ \n\
    1003781                                if \{\\\[catch userproc-${ident}-${target} result\\\]\} \{ \n\
    … …  
    1012790        }
    1013791        eval "proc pre-$target {args} \{ \n\
    1014                         $this append pre proc-pre-${ident}-${target}
     792                        ditem_append $ditem pre proc-pre-${ident}-${target}
    1015793                        eval \"proc proc-pre-${ident}-${target} \{name\} \{ \n\
    1016794                                if \{\\\[catch userproc-pre-${ident}-${target} result\\\]\} \{ \n\
    … …  
    1023801                \}"
    1024802        eval "proc post-$target {args} \{ \n\
    1025                         $this append post proc-post-${ident}-${target}
     803                        ditem_append $ditem post proc-post-${ident}-${target}
    1026804                        eval \"proc proc-post-${ident}-${target} \{name\} \{ \n\
    1027805                                if \{\\\[catch userproc-post-${ident}-${target} result\\\]\} \{ \n\
    … …  
    1034812                \}"
    1035813    }
    1036     eval "depspec_append $this provides $args"
    1037 }
    1038 
    1039 proc target_requires {this args} {
    1040     eval "depspec_append $this requires $args"
    1041 }
    1042 
    1043 proc target_uses {this args} {
    1044     eval "depspec_append $this uses $args"
    1045 }
    1046 
    1047 proc target_deplist {this args} {
    1048     eval "depspec_append $this deplist $args"
    1049 }
    1050 
    1051 proc target_prerun {this args} {
    1052     eval "depspec_append $this prerun $args"
    1053 }
    1054 
    1055 proc target_postrun {this args} {
    1056     eval "depspec_append $this postrun $args"
    1057 }
    1058 
    1059 ##### variant depspec subclass #####
    1060 
    1061 # Variant class definition.
    1062 global variant_vtbl
    1063 array set variant_vtbl [array get depspec_vtbl]
    1064 set variant_vtbl(run) variant_run
    1065 
    1066 # constructor for target depspec class
     814    eval "ditem_append $ditem provides $args"
     815}
     816
     817proc target_requires {ditem args} {
     818    eval "ditem_append $ditem requires $args"
     819}
     820
     821proc target_uses {ditem args} {
     822    eval "ditem_append $ditem uses $args"
     823}
     824
     825proc target_deplist {ditem args} {
     826    eval "ditem_append $ditem deplist $args"
     827}
     828
     829proc target_prerun {ditem args} {
     830    eval "ditem_append $ditem prerun $args"
     831}
     832
     833proc target_postrun {ditem args} {
     834    eval "ditem_append $ditem postrun $args"
     835}
     836
     837proc target_runtype {ditem args} {
     838        eval "ditem_append $ditem runtype $args"
     839}
     840
     841proc target_init {ditem args} {
     842    eval "ditem_append $ditem init $args"
     843}
     844
     845##### variant class #####
     846
     847# constructor for variant objects
    1067848proc variant_new {name} {
    1068     set obj [depspec_new $name]
    1069    
    1070     $obj set _vtbl variant_vtbl
    1071    
    1072     return $obj
     849    set ditem [ditem_create]
     850    ditem_key $ditem name $name
     851    return $ditem
    1073852}
    1074853
    … …  
    1091870}
    1092871
    1093 ##### portfile depspec subclass #####
    1094 global portfile_vtbl
    1095 array set portfile_vtbl [array get depspec_vtbl]
    1096 set portfile_vtbl(run) portfile_run
    1097 set portfile_vtbl(test) portfile_test
    1098 
    1099 proc portfile_new {name} {
    1100     set obj [depspec_new $name]
    1101    
    1102     $obj set _vtbl portfile_vtbl
    1103    
    1104     return $obj
    1105 }
    1106 
    1107 # portfile primitive that calls portexec_int with newworkpath == ${workpath}
    1108 proc portexec {portname target} {
    1109         global workpath
    1110         portexec_int $portname $target $workpath
    1111 }
    1112 
    1113 # build the specified portfile with default workpath
    1114 proc portfile_run {this} {
    1115     set portname [$this get name]
    1116     if {![catch {portexec_int $portname install} result]} {
    1117                 portexec_int $portname clean
    1118     }
    1119     return $result
    1120 }
    1121872
    1122873# builds the specified port (looked up in the index) to the specified target
    … …  
    1157908}
    1158909
    1159 proc portfile_test {this} {
    1160     set receipt [registry_exists [$this get name]]
    1161     if {$receipt != ""} {
    1162         ui_debug "Found Dependency: receipt: $receipt"
    1163         return 1
    1164     } else {
    1165         return 0
    1166     }
    1167 }
    1168 
    1169910proc portfile_search_path {depregex search_path} {
    1170911    set found 0
    … …  
    1184925}
    1185926
    1186 
    1187 
    1188 ##### lib portfile depspec subclass #####
    1189 # Search registry, then library path for regex
    1190 global libportfile_vtbl
    1191 array set libportfile_vtbl [array get portfile_vtbl]
    1192 set libportfile_vtbl(test) libportfile_test
    1193 
    1194 proc libportfile_new {name match} {
    1195     set obj [portfile_new $name]
    1196    
    1197     $obj set _vtbl libportfile_vtbl
    1198     $obj set depregex $match
    1199    
    1200     return $obj
    1201 }
    1202927
    1203928# XXX - Architecture specific
    … …  
    1243968}
    1244969
    1245 ##### bin portfile depspec subclass #####
    1246 # Search registry, then binary path for regex
    1247 global binportfile_vtbl
    1248 array set binportfile_vtbl [array get portfile_vtbl]
    1249 set binportfile_vtbl(test) binportfile_test
    1250 
    1251 proc binportfile_new {name match} {
    1252     set obj [portfile_new $name]
    1253    
    1254     $obj set _vtbl binportfile_vtbl
    1255     $obj set depregex $match
    1256    
    1257     return $obj
    1258 }
    1259 
    1260970proc binportfile_test {this} {
    1261971    global env prefix
    … …  
    1275985        return [portfile_search_path $depregex $search_path]
    1276986    }
    1277 }
    1278 
    1279 ##### path portfile depspec subclass #####
    1280 # Search registry, then search specified absolute or
    1281 # ${prefix} relative path for regex
    1282 global pathportfile_vtbl
    1283 array set pathportfile_vtbl [array get portfile_vtbl]
    1284 set pathportfile_vtbl(test) pathportfile_test
    1285 
    1286 proc pathportfile_new {name match} {
    1287     set obj [portfile_new $name]
    1288    
    1289     $obj set _vtbl pathportfile_vtbl
    1290     $obj set depregex $match
    1291     return $obj
    1292987}
    1293988
Note: See TracChangeset for help on using the changeset viewer.