aboutsummaryrefslogtreecommitdiff
// -*- C++ -*-
//  Boost general library 'format'   ---------------------------
//  See http://www.boost.org for updates, documentation, and revision history.

//  (C) Samuel Krempp 2001
//                  krempp@crans.ens-cachan.fr
//  Permission to copy, use, modify, sell and
//  distribute this software is granted provided this copyright notice appears
//  in all copies. This software is provided "as is" without express or implied
//  warranty, and with no claim as to its suitability for any purpose.

// ideas taken from Rüdiger Loos's format class
// and Karl Nelson's ofstream

// ----------------------------------------------------------------------------
// feed_args.hpp :  functions for processing each argument 
//                      (feed, feed_manip, and distribute)
// ----------------------------------------------------------------------------


#ifndef BOOST_FORMAT_FEED_ARGS_HPP
#define BOOST_FORMAT_FEED_ARGS_HPP

#include "boost/format/format_class.hpp"
#include "boost/format/group.hpp"

#include "boost/throw_exception.hpp"

namespace boost {
namespace io {
namespace detail {
namespace  { 

  inline
  void empty_buf(BOOST_IO_STD ostringstream & os) { 
    static const std::string emptyStr;
    os.str(emptyStr); 
  }

  void do_pad( std::string & s, 
                std::streamsize w, 
                const char c, 
                std::ios::fmtflags f, 
                bool center) 
    // applies centered / left / right  padding  to the string s.
    // Effects : string s is padded.
  {
    std::streamsize n=w-s.size();
    if(n<=0) {
      return;
    }
    if(center) 
      {
        s.reserve(w); // allocate once for the 2 inserts
        const std::streamsize n1 = n /2, n0 = n - n1; 
        s.insert(s.begin(), n0, c);
        s.append(n1, c);
      } 
    else 
      {
        if(f & std::ios::left) {
          s.append(n, c);
        }
        else {
          s.insert(s.begin(), n, c);
        }
      }
  } // -do_pad(..) 


  template<class T> inline
  void put_head(BOOST_IO_STD ostream& , const T& ) {
  }

  template<class T> inline
  void put_head( BOOST_IO_STD ostream& os, const group1<T>& x ) {
    os << group_head(x.a1_); // send the first N-1 items, not the last
  }

  template<class T> inline
  void put_last( BOOST_IO_STD ostream& os, const T& x ) {
    os << x ;
  }

  template<class T> inline
  void put_last( BOOST_IO_STD ostream& os, const group1<T>& x ) {
    os << group_last(x.a1_); // this selects the last element
  }

#ifndef BOOST_NO_OVERLOAD_FOR_NON_CONST 
  template<class T> inline
  void put_head( BOOST_IO_STD ostream& , T& ) {
  }

  template<class T> inline
  void put_last( BOOST_IO_STD ostream& os, T& x ) {
    os << x ;
  }
#endif



  
template<class T> 
void put( T x, 
          const format_item& specs, 
          std::string & res, 
          BOOST_IO_STD ostringstream& oss_ )
{
  // does the actual conversion of x, with given params, into a string
  // using the *supplied* strinstream. (the stream state is important)

  typedef std::string string_t;
  typedef format_item  format_item_t;

  stream_format_state   prev_state(oss_);
    
  specs.state_.apply_on(oss_);

  // in case x is a group, apply the manip part of it, 
  // in order to find width
  put_head( oss_, x );
  empty_buf( oss_);

  const std::streamsize w=oss_.width();
  const std::ios::fmtflags fl=oss_.flags();
  const bool internal = (fl & std::ios::internal) != 0;
  const bool two_stepped_padding = internal
    &&  ! ( specs.pad_scheme_ & format_item_t::spacepad ) 
    && specs.truncate_ < 0 ;
      

  if(! two_stepped_padding) 
    {
      if(w>0) // handle simple padding via do_pad, not natively in stream 
        oss_.width(0);
      put_last( oss_, x);
      res = oss_.str();

      if (specs.truncate_ >= 0)
        res.erase(specs.truncate_);

      // complex pads :
      if(specs.pad_scheme_ & format_item_t::spacepad)
        {
          if( res.size()==0 ||   ( res[0]!='+' && res[0]!='-'  ))
            {
              res.insert(res.begin(), 1, ' '); // insert 1 space at  pos 0
            }
        }
      if(w > 0) // need do_pad
        {
          do_pad(res,w,oss_.fill(), fl, (specs.pad_scheme_ & format_item_t::centered) !=0 );
        }
    } 
  else  // 2-stepped padding
    {
      put_last( oss_, x); // oss_.width() may result in padding.
      res = oss_.str();
      
      if (specs.truncate_ >= 0)
        res.erase(specs.truncate_);

      if( res.size() - w > 0)
        { //   length w exceeded
          // either it was multi-output with first output padding up all width..
          // either it was one big arg and we are fine.
          empty_buf( oss_);
          oss_.width(0);
          put_last(oss_, x );
          string_t tmp = oss_.str();  // minimal-length output
          std::streamsize d;
          if( (d=w - tmp.size()) <=0 ) 
            {
              // minimal length is already >= w, so no padding  (cool!)
              res.swap(tmp);
            }
          else
            { // hum..  we need to pad (it was necessarily multi-output)
              typedef typename string_t::size_type size_type;
              size_type i = 0;
              while( i<tmp.size() && tmp[i] == res[i] ) // find where we should pad.
                ++i;
              tmp.insert(i, static_cast<size_type>( d ), oss_.fill());
              res.swap( tmp );
            }
        }
      else 
        { // okay, only one thing was printed and padded, so res is fine.
        }
    }

  prev_state.apply_on(oss_);
  empty_buf( oss_);
  oss_.clear();
} // end- put(..)


}  // local namespace





template<class T> 
void distribute(basic_format& self, T x) 
  // call put(x, ..) on every occurence of the current argument :
{
  if(self.cur_arg_ >= self.num_args_)
    {
      if( self.exceptions() & too_many_args_bit )
        boost::throw_exception(too_many_args()); // too many variables have been supplied !
      else return;
    }
  for(unsigned long i=0; i < self.items_.size(); ++i)
    {
      if(self.items_[i].argN_ == self.cur_arg_)
        {
          put<T> (x, self.items_[i], self.items_[i].res_, self.oss_ );
        }
    }
}

template<class T> 
basic_format&  feed(basic_format& self, T x) 
{
  if(self.dumped_) self.clear();
  distribute<T> (self, x);
  ++self.cur_arg_;
  if(self.bound_.size() != 0)
    {
      while( self.cur_arg_ < self.num_args_ && self.bound_[self.cur_arg_] )
        ++self.cur_arg_;
    }

  // this arg is finished, reset the stream's format state
  self.state0_.apply_on(self.oss_);
  return self;
}
    

} // namespace detail
} // namespace io
} // namespace boost


#endif //  BOOST_FORMAT_FEED_ARGS_HPP
" s) (run-with-store store (lower-object (package-source p0*)))))))))))))) (test-assert "options->transformation, with-input" (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,(specification->package "coreutils")) ("bar" ,(specification->package "grep")) ("baz" ,(dummy-package "chbouib" (native-inputs `(("x" ,grep))))))))) (t (options->transformation '((with-input . "coreutils=busybox") (with-input . "grep=findutils"))))) (let ((new (t p))) (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2) ("baz" dep3)) (and (string=? (package-full-name dep1) (package-full-name busybox)) (string=? (package-full-name dep2) (package-full-name findutils)) (string=? (package-name dep3) "chbouib") (match (package-native-inputs dep3) ((("x" dep)) (string=? (package-full-name dep) (package-full-name findutils))))))))))) ;; The following test requires grafting enabled, but it becomes extremely ;; expensive if there's a graft on glibc or other package deep in the graph. (when (package-replacement (@ (gnu packages commencement) glibc-final)) (test-skip 1)) (test-assert "options->transformation, with-graft" (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,grep) ("bar" ,(dummy-package "chbouib" (native-inputs `(("x" ,grep))))))))) (t (options->transformation '((with-graft . "grep=findutils"))))) (let ((new (t p))) (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1) (package-full-name grep)) (string=? (package-full-name (package-replacement dep1)) (package-full-name findutils)) (string=? (package-name dep2) "chbouib") (match (package-native-inputs dep2) ((("x" dep)) (with-store store (string=? (derivation-file-name (package-derivation store findutils)) (derivation-file-name (package-derivation store dep))))))))))))) (test-equal "options->transformation, with-branch" (git-checkout (url "https://example.org") (branch "devel") (recursive? #t)) (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,grep) ("bar" ,(dummy-package "chbouib" (source (origin (method git-fetch) (uri (git-reference (url "https://example.org") (commit "cabba9e"))) (sha256 #f))))))))) (t (options->transformation '((with-branch . "chbouib=devel"))))) (let ((new (t p))) (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1) (package-full-name grep)) (string=? (package-name dep2) "chbouib") (package-source dep2)))))))) (test-equal "options->transformation, with-commit" (git-checkout (url "https://example.org") (commit "abcdef") (recursive? #t)) (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,grep) ("bar" ,(dummy-package "chbouib" (source (origin (method git-fetch) (uri (git-reference (url "https://example.org") (commit "cabba9e"))) (sha256 #f))))))))) (t (options->transformation '((with-commit . "chbouib=abcdef"))))) (let ((new (t p))) (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1) (package-full-name grep)) (string=? (package-name dep2) "chbouib") (package-source dep2)))))))) (test-equal "options->transformation, with-commit, version transformation" '("1.0" "1.0-rc1-2-gabc123" "git.abc123") (map (lambda (commit) (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,(dummy-package "chbouib" (source (origin (method git-fetch) (uri (git-reference (url "https://example.org") (commit "cabba9e"))) (sha256 #f))))))))) (t (options->transformation `((with-commit . ,(string-append "chbouib=" commit)))))) (let ((new (t p))) (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1)) (package-version dep1))))))) '("v1.0" "1.0-rc1-2-gabc123" "abc123"))) (test-equal "options->transformation, with-git-url" (let ((source (git-checkout (url "https://example.org") (recursive? #t)))) (list source source)) (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,grep) ("bar" ,(dummy-package "chbouib" (native-inputs `(("x" ,grep))))))))) (t (options->transformation '((with-git-url . "grep=https://example.org"))))) (let ((new (t p))) (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2)) (and (string=? (package-full-name dep1) (package-full-name grep)) (string=? (package-name dep2) "chbouib") (match (package-native-inputs dep2) ((("x" dep3)) (map package-source (list dep1 dep3))))))))))) (test-equal "options->transformation, with-git-url + with-branch" ;; Combine the two options and make sure the 'with-branch' transformation ;; comes after the 'with-git-url' transformation. (let ((source (git-checkout (url "https://example.org") (branch "BRANCH") (recursive? #t)))) (list source source)) (let* ((p (dummy-package "guix.scm" (inputs `(("foo" ,grep) ("bar" ,(dummy-package "chbouib" (native-inputs `(("x" ,grep))))))))) (t (options->transformation (reverse '((with-git-url . "grep=https://example.org") (with-branch . "grep=BRANCH")))))) (let ((new (t p))) (and (not (eq? new p)) (match (package-inputs new) ((("foo" dep1) ("bar" dep2)) (and (string=? (package-name dep1) "grep") (string=? (package-name dep2) "chbouib") (match (package-native-inputs dep2) ((("x" dep3)) (map package-source (list dep1 dep3))))))))))) (define* (depends-on-toolchain? p #:optional (toolchain "gcc-toolchain")) "Return true if P depends on TOOLCHAIN instead of the default tool chain." (define toolchain-packages '("gcc" "binutils" "glibc" "ld-wrapper")) (define (package-name* obj) (and (package? obj) (package-name obj))) (match (bag-build-inputs (package->bag p)) (((_ (= package-name* packages) . _) ...) (and (not (any (cut member <> packages) toolchain-packages)) (member toolchain packages))))) (test-assert "options->transformation, with-c-toolchain" (let* ((dep0 (dummy-package "chbouib" (build-system gnu-build-system) (native-inputs `(("y" ,grep))))) (dep1 (dummy-package "stuff" (native-inputs `(("x" ,dep0))))) (p (dummy-package "thingie" (build-system gnu-build-system) (inputs `(("foo" ,grep) ("bar" ,dep1))))) (t (options->transformation '((with-c-toolchain . "chbouib=gcc-toolchain"))))) ;; Here we check that the transformation applies to DEP0 and all its ;; dependents: DEP0 must use GCC-TOOLCHAIN, DEP1 must use GCC-TOOLCHAIN ;; and the DEP0 that uses GCC-TOOLCHAIN, and so on. (let ((new (t p))) (and (depends-on-toolchain? new "gcc-toolchain") (match (bag-build-inputs (package->bag new)) ((("foo" dep0) ("bar" dep1) _ ...) (and (depends-on-toolchain? dep1 "gcc-toolchain") (not (depends-on-toolchain? dep0 "gcc-toolchain")) (string=? (package-full-name dep0) (package-full-name grep)) (match (bag-build-inputs (package->bag dep1)) ((("x" dep) _ ...) (and (depends-on-toolchain? dep "gcc-toolchain") (match (bag-build-inputs (package->bag dep)) ((("y" dep) _ ...) ;this one is unchanged (eq? dep grep))))))))))))) (test-equal "options->transformation, with-c-toolchain twice" (package-full-name grep) (let* ((dep0 (dummy-package "chbouib")) (dep1 (dummy-package "stuff")) (p (dummy-package "thingie" (build-system gnu-build-system) (inputs `(("foo" ,dep0) ("bar" ,dep1) ("baz" ,grep))))) (t (options->transformation '((with-c-toolchain . "chbouib=clang-toolchain") (with-c-toolchain . "stuff=clang-toolchain"))))) (let ((new (t p))) (and (depends-on-toolchain? new "clang-toolchain") (match (bag-build-inputs (package->bag new)) ((("foo" dep0) ("bar" dep1) ("baz" dep2) _ ...) (and (depends-on-toolchain? dep0 "clang-toolchain") (depends-on-toolchain? dep1 "clang-toolchain") (not (depends-on-toolchain? dep2 "clang-toolchain")) (package-full-name dep2)))))))) (test-assert "options->transformation, with-c-toolchain, no effect" (let ((p (dummy-package "thingie")) (t (options->transformation '((with-c-toolchain . "does-not-exist=gcc-toolchain"))))) ;; When it has no effect, '--with-c-toolchain' returns P. (eq? (t p) p))) (test-equal "options->transformation, with-debug-info" '(#:strip-binaries? #f) (let* ((dep (dummy-package "chbouib")) (p (dummy-package "thingie" (build-system gnu-build-system) (inputs `(("foo" ,dep) ("bar" ,grep))))) (t (options->transformation '((with-debug-info . "chbouib"))))) (let ((new (t p))) (match (package-inputs new) ((("foo" dep0) ("bar" dep1)) (and (string=? (package-full-name dep1) (package-full-name grep)) (package-arguments (package-replacement dep0)))))))) (test-equal "options->transformation, with-configure-flag" '(append '() '("--flag=42")) (let* ((p (dummy-package "foo" (build-system gnu-build-system))) (t (options->transformation '((with-configure-flag . "foo=--flag=42"))))) (let ((new (t p))) (match (package-arguments new) ((#:configure-flags flags) (gexp->approximate-sexp flags)))))) (test-assert "options->transformation, without-tests" (let* ((dep (dummy-package "dep")) (p (dummy-package "foo" (inputs `(("dep" ,dep))))) (t (options->transformation '((without-tests . "dep") (without-tests . "tar"))))) (let ((new (t p))) (match (bag-direct-inputs (package->bag new)) ((("dep" dep) ("tar" tar) _ ...) (and (equal? (package-arguments dep) '(#:tests? #f)) (match (memq #:tests? (package-arguments tar)) ((#:tests? #f _ ...) #t)))))))) (test-equal "options->transformation, with-patch" (search-patches "glibc-locales.patch" "guile-relocatable.patch") (let* ((dep (dummy-package "dep" (source (dummy-origin)))) (p (dummy-package "foo" (inputs `(("dep" ,dep))))) (patch1 (search-patch "glibc-locales.patch")) (patch2 (search-patch "guile-relocatable.patch")) (t (options->transformation `((with-patch . ,(string-append "dep=" patch1)) (with-patch . ,(string-append "dep=" patch2)) (with-patch . ,(string-append "tar=" patch1)))))) (let ((new (t p))) (match (bag-direct-inputs (package->bag new)) ((("dep" dep) ("tar" tar) _ ...) (and (member patch1 (filter-map (lambda (patch) (and (local-file? patch) (local-file-file patch))) (origin-patches (package-source tar)))) (map local-file-file (origin-patches (package-source dep))))))))) (test-equal "options->transformation, with-commit + with-patch" '(#t #t) (let* ((patch (search-patch "glibc-locales.patch")) (commit "f8934ec94df5868ee8baf1fb0f8ed0f24e7e91eb") (t (options->transformation ;; Note: options are applied in reverse order, so ;; 'with-patch' comes on top. `((with-patch . ,(string-append "guile-gcrypt=" patch)) (with-commit . ,(string-append "guile-gcrypt=" commit)))))) (let ((new (t (@ (gnu packages gnupg) guile-gcrypt)))) (match (package-source new) ((? computed-file? source) (let* ((gexp (computed-file-gexp source)) (inputs (map gexp-input-thing ((@@ (guix gexp) gexp-inputs) gexp)))) (list (any (lambda (input) (and (git-checkout? input) (string=? commit (git-checkout-commit input)))) inputs) (any (lambda (input) (and (local-file? input) (string=? (local-file-file input) patch))) inputs)))))))) (test-equal "options->transformation, property order" ;; See <https://issues.guix.gnu.org/54942>. '((with-debug-info . "does-not-exist") (with-commit . "does-not-exist=aaaaaaa") (without-tests . "does-not-exist")) (let* ((t (options->transformation '((with-debug-info . "does-not-exist") (with-commit . "does-not-exist=aaaaaaa") (without-tests . "does-not-exist"))))) (let ((new (t coreutils))) (assq-ref (package-properties new) 'transformations)))) (test-equal "package-with-upstream-version" '("42.0" "42.0" ("http://example.org") ("a" "b") (do something)) (mock ((guix upstream) %updaters (delay (list (upstream-updater (name 'dummy) (pred (const #t)) (description "") (import (const (upstream-source (package "foo") (version "42.0") (urls '("http://example.org"))))))))) (let* ((old (dummy-package "foo" (version "1.0") (source (dummy-origin (patches '("a" "b")) (snippet '(do something)))))) (new (package-with-upstream-version old)) (new+patches (package-with-upstream-version old #:preserve-patches? #t))) (list (package-version new) (package-version new+patches) ;; Source of NEW is directly an <upstream-source>. (upstream-source-urls (package-source new)) ;; Check that #:preserve-patches? #t gave us an origin. (origin-patches (package-source new+patches)) (origin-snippet (package-source new+patches)))))) (test-equal "options->transformation, with-latest" "42.0" (mock ((guix upstream) %updaters (delay (list (upstream-updater (name 'dummy) (pred (const #t)) (description "") (import (const (upstream-source (package "foo") (version "42.0") (urls '("http://example.org"))))))))) (let* ((p (dummy-package "foo" (version "1.0"))) (t (options->transformation `((with-latest . "foo"))))) (package-version (t p))))) (test-equal "options->transformation, with-version" "1.0" (mock ((guix upstream) %updaters (delay (list (upstream-updater (name 'dummy) (pred (const #t)) (description "") (import (const (upstream-source (package "foo") (version "1.0") (urls '("http://example.org"))))))))) (let* ((p0 (dummy-package "foo" (version "7.7"))) (p1 (dummy-package "bar" (inputs (list p0)))) (t (options->transformation `((with-version . "foo=1.0"))))) (package-version (lookup-package-input (t p1) "foo"))))) (test-equal "options->transformation, tune" '(cpu-tuning . "superfast") (let* ((p0 (dummy-package "p0")) (p1 (dummy-package "p1" (inputs `(("p0" ,p0))) (properties '((tunable? . #t))))) (p2 (dummy-package "p2" (inputs `(("p1" ,p1))))) (t (options->transformation '((tune . "superfast")))) (p3 (t p2))) (and (not (package-replacement p3)) (match (package-inputs p3) ((("p1" tuned)) (match (package-inputs tuned) ((("p0" p0)) (and (not (package-replacement p0)) (assq 'cpu-tuning (package-properties (package-replacement tuned))))))))))) (test-assert "options->transformations, tune, wrong micro-architecture" (let ((p (dummy-package "tunable" (properties '((tunable? . #t))))) (t (options->transformation '((tune . "nonexistent-superfast"))))) ;; Because GCC used by P's build system does not support ;; '-march=nonexistent-superfast', we should see an error when lowering ;; the tuned package. (guard (c ((formatted-message? c) (member "nonexistent-superfast" (formatted-message-arguments c)))) (package->bag (t p)) #f))) (test-equal "options->transformation + package->manifest-entry" '((transformations . ((without-tests . "foo")))) (let* ((p (dummy-package "foo")) (t (options->transformation '((without-tests . "foo")))) (e (package->manifest-entry (t p)))) (manifest-entry-properties e))) (test-end) ;;; Local Variables: ;;; eval: (put 'dummy-package 'scheme-indent-function 1) ;;; End: