ruby-perl 0.99.15j

data/lib/perl/value.rb

@@ -0,0 +1,4 @@
+module Perl
+  class Value
+  end
+end

data/lib/perl/value/array.rb

@@ -0,0 +1,54 @@
+require 'perl/value'
+require 'ffi'
+
+class Perl::Value::Array
+  class Av < FFI::Struct
+    class Xnv_u < FFI::Union
+      layout  :xnv_nv,        :long,
+              :xgv_stash,     :pointer,
+              :xpad_cop_seq,  :long,
+              :xbm_s,         :long
+    end
+
+    layout  :xnv_u,     Xnv_u,
+            :xav_fill,  :long,
+            :xav_max,   :long
+
+    def inspect
+      "<#{self.class.name} @xav_fill=#{self[:xav_fill].inspect} @xav_max=#{self[:xav_max].inspect}>"
+    end
+  end
+
+  def initialize(args)
+    @perl = Perl.PL_curinterp
+    @value = nil
+    @array = nil
+    @av = nil
+
+    case args
+    when Perl::Value::Scalar::SV
+      @array = args[:sv_u][:svu_array]
+      @av = Av.new(args[:sv_any])
+    when nil
+    else
+      raise "Don't know how to handle #{args.class} (#{args.inspect})"
+    end
+  end
+
+  def value
+    return @value if @value
+    if @array
+      @value = @array.get_array_of_pointer(0, @av[:xav_fill]+1).map do |ptr|
+        Perl::Value::Scalar.new(ptr)
+      end
+    else
+      return nil
+    end
+  end
+
+  def freeze!
+    self.value.each { |v| v.freeze! }
+    @array = nil
+    @av = nil
+  end
+end

data/lib/perl/value/hash.rb

@@ -0,0 +1,73 @@
+require 'perl/value'
+require 'perl/value/scalar'
+require 'ffi'
+
+require 'stringio'
+
+class Perl::Value::Hash
+  HV_DISABLE_UVAR_XKEY  = 0x01
+  HV_FETCH_ISSTORE      = 0x04
+  HV_FETCH_ISEXISTS     = 0x08
+  HV_FETCH_LVALUE       = 0x10
+  HV_FETCH_JUST_SV      = 0x20
+  HV_DELETE             = 0x40
+
+  class << self
+    def to_perl(hash)
+      build_hv(Perl.PL_curinterp, hash)
+    end
+
+  protected
+    def build_hv(perl, hash)
+      new_hv(perl).tap do |hv|
+        hash.each do |k,v|
+          value = value_to_sv(k, v)
+          add_key_value(perl, hv, k.to_s, value) if value
+        end
+      end
+    end
+
+    def new_hv(perl)
+      Perl.Perl_newHV(perl)
+    end
+
+    def value_to_sv(key, value)
+      case value
+      when Array, IO
+        puts "Don't know how to handle #{value.class} (#{key} => #{value.inspect})"
+      when FalseClass
+        Perl::Value::Scalar.to_perl(value.to_s) # FIXME
+      when Method
+        puts "Cannot handle value with class=#{value.class} (#{key} => #{value.inspect}), skipping"
+      when String, StringIO
+        Perl::Value::Scalar.to_perl(value)
+      when TrueClass
+        Perl::Value::Scalar.to_perl(value.to_s) # FIXME
+      else
+        raise "Don't know how to handle #{value.class} (#{key} => #{value.inspect})"
+      end
+    end
+
+    def add_key_value(perl, hv, key, value)
+      Perl.Perl_hv_common_key_len(perl, hv, key, key.length, (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), value, 0)
+    end
+  end
+
+  def initialize(args = nil)
+    @perl = Perl.PL_curinterp
+    @hash = nil
+    @hv = nil
+
+    case args
+    when Hash
+      @hash = args
+    when nil
+    else
+      raise "Don't know how to handle #{args.class} (#{args.inspect})"
+    end
+  end
+
+  def to_perl
+    @hv ||= self.class.send(:build_hv, @perl, @hash)
+  end
+end

data/lib/perl/value/scalar.rb

@@ -0,0 +1,130 @@
+require 'perl/value'
+require 'perl/value/array'
+require 'ffi'
+
+class Perl::Value::Scalar
+  class SV < FFI::Struct
+    class SvU < FFI::Union
+      layout  :svu_iv,    :long,
+              :svu_uv,    :long, # XXX ?
+              :svu_rv,    :pointer,
+              :svu_pv,    :string,
+              :svu_array, :pointer,
+              :svu_hash,  :pointer,
+              :svu_gp,    :pointer
+    end
+
+    layout  :sv_any,    :pointer,
+            :sv_refcnt, :int32,
+            :sv_flags,  :int32,
+            :sv_u,      SvU
+
+    SVt_NULL    = 0
+    SVt_BIND    = 1
+    SVt_IV      = 2
+    SVt_NV      = 3
+    SVt_RV      = 4
+    SVt_PV      = 5
+    SVt_PVIV    = 6
+    SVt_PVNV    = 7
+    SVt_PVMG    = 8
+    SVt_PVGV    = 9
+    SVt_PVLV    = 10
+    SVt_PVAV    = 11
+    SVt_PVHV    = 12
+    SVt_PVCV    = 13
+    SVt_PVFM    = 14
+    SVt_PVIO    = 15
+    SVTYPEMASK  = 0xff
+
+    SVf_IOK = 0x00000100
+    SVf_NOK = 0x00000200
+    SVf_POK = 0x00000400
+    SVf_ROK = 0x00000800
+
+    def value
+      case
+      when (self[:sv_flags] & SVf_POK) == SVf_POK
+        self[:sv_u][:svu_pv]
+      when (self[:sv_flags] & SVf_ROK) == SVf_ROK
+        Perl::Value::Scalar.new(self[:sv_u][:svu_rv])
+      when (self[:sv_flags] & SVTYPEMASK) == SVt_PVAV
+        Perl::Value::Array.new(self)
+      else
+        raise "Don't know how to handle #{self[:sv_u]} (#{self.inspect})"
+      end
+    end
+
+    def reference?
+      (self[:sv_flags] & SVf_ROK) == SVf_ROK
+    end
+
+    def deref
+      raise "Not a reference!" unless (self[:sv_flags] & SVf_ROK) == SVf_ROK
+
+      SV.new(self[:sv_u][:svu_rv]).value
+    end
+
+    def inspect
+      "<#{self.class.name} @pointer=#{self.pointer} @sv_any=#{self[:sv_any].inspect} @sv_refcnt=#{self[:sv_refcnt].inspect} @sv_flags=0x#{self[:sv_flags].to_s(16)} @sv_u=#{self[:sv_u].inspect}>"
+    end
+  end
+
+  class << self
+    def to_perl(value)
+      case value
+      when String
+        Perl.Perl_newSVpv(Perl.PL_curinterp, value, value.length)
+      when StringIO
+        value = value.string
+        Perl.Perl_newSVpv(Perl.PL_curinterp, value, value.length)
+      when nil
+      else
+        raise "Don't know how to handle #{value.class} (#{value.inspect})"
+      end
+    end
+  end
+
+  def initialize(args = nil)
+    @perl = Perl.PL_curinterp
+    @scalar = nil
+    @sv = nil
+    @deref = nil
+    @is_ref = nil
+
+    case args
+    when FFI::Pointer
+      @sv = SV.new(args)
+    when String
+      @scalar = args
+    when nil
+    else
+      raise "Don't know how to handle #{args.class} (#{args.inspect})"
+    end
+  end
+
+  def to_perl
+    @sv ||= Perl.Perl_newSVpv(@perl, @scalar, @scalar.length)
+  end
+
+  def value
+    @scalar ||= @sv ? @sv.value : nil
+  end
+
+  def reference?
+    if @is_ref.nil?
+      @is_ref = @sv.reference?
+    else
+      @is_ref
+    end
+  end
+
+  def deref
+    @deref ||= to_perl.deref
+  end
+
+  def freeze!
+    reference? ? self.deref.freeze! : self.value
+    @sv = nil
+  end
+end

data/spec/ext/hash_spec.rb

@@ -0,0 +1,24 @@
+require 'spec_helper'
+
+require 'perl/ext/hash'
+require 'perl/interpreter'
+
+describe Hash do
+  describe "#to_perl" do
+    before(:all) do
+      @interpreter = Perl::Interpreter.new
+    end
+    after(:all) do
+      @interpreter.stop
+    end
+
+    describe "on an empty Hash" do
+      let(:subject) { {} }
+
+      it "should return the expected result" do
+        ptr = subject.to_perl
+        ptr.should be_kind_of(FFI::Pointer)
+      end
+    end
+  end
+end

data/spec/ext/object_spec.rb

@@ -0,0 +1,40 @@
+require 'spec_helper'
+
+require 'perl/ext/object'
+
+class Object
+  def perl_interpreter
+    @_perl
+  end
+end
+
+describe Object do
+  after(:each) do
+    perl_interpreter.stop
+  end
+
+  describe "#Perl" do
+    it "should instance an interpreter" do
+      perl_interpreter.should be_nil
+      Perl("$_")
+      perl_interpreter.should_not be_nil
+      perl_interpreter.should be_kind_of(Perl::Interpreter)
+    end
+
+    # it "should run the provided code" do
+    #   ret = capture_stdout_descriptor do
+    #     Perl("print \"hi there\";")
+    #   end
+    #   ret.should == "hi there"
+    # end
+    # 
+    # it "should run the provided code block" do
+    #   ret = capture_stdout_descriptor do
+    #     Perl do
+    #       run "print \"hi there\";"
+    #     end
+    #   end
+    #   ret.should == "hi there"
+    # end
+  end
+end

data/spec/ext/string_spec.rb

@@ -0,0 +1,37 @@
+require 'spec_helper'
+
+require 'perl/ext/string'
+require 'perl/interpreter'
+
+describe String do
+  describe "#to_perl" do
+    before(:all) do
+      @interpreter = Perl::Interpreter.new
+    end
+    after(:all) do
+      @interpreter.stop
+    end
+
+    describe "on an empty String" do
+      let(:subject) { "" }
+
+      it "should return the expected result" do
+        ptr = subject.to_perl
+        ptr.should be_kind_of(FFI::Pointer)
+        value = Perl::Value::Scalar.new(ptr)
+        value.value.should == ""
+      end
+    end
+
+    describe "on a String" do
+      let(:subject) { "something" }
+
+      it "should return the expected result" do
+        ptr = subject.to_perl
+        ptr.should be_kind_of(FFI::Pointer)
+        value = Perl::Value::Scalar.new(ptr)
+        value.value.should == "something"
+      end
+    end
+  end
+end

data/spec/hash_value_spec.rb

@@ -0,0 +1,47 @@
+require 'spec_helper'
+
+require 'perl/value/hash'
+require 'perl/interpreter'
+
+describe Perl::Value::Hash do
+  include PerlValueHelpers
+
+  context "built without arguments" do
+    its(:perl) { should_not be_nil }
+    its(:hash) { should be_nil }
+    its(:hv) { should be_nil }
+  end
+
+  context "built from a String" do
+    let(:input) { "pippo" }
+    it do
+      lambda { described_class.new(input) }.should raise_error
+    end
+  end
+
+  context "built from a Hash" do
+    before(:all) do
+      @interpreter = Perl::Interpreter.new
+    end
+    after(:all) do
+      @interpreter.stop
+    end
+
+    let(:input) { {:a => "b", :c => "d"} }
+    subject { described_class.new(input) }
+    its(:perl) { should_not be_nil }
+    its(:hash) { should_not be_nil }
+    its(:hash) { should eq(input) }
+    its(:hv) { should be_nil }
+
+    describe "when #to_perl is called" do
+      it "should return the expected object" do
+        subject.to_perl.should_not be_nil
+      end
+
+      it "should cache the returned object" do
+        subject.to_perl.should == subject.hv
+      end
+    end
+  end
+end

data/spec/interpreter_spec.rb

@@ -0,0 +1,220 @@
+require 'spec_helper'
+
+require 'perl/interpreter'
+require 'perl/value/hash'
+require 'ffi'
+
+class PerlCommon
+  extend Perl::Common
+end
+
+describe Perl::Interpreter do
+  describe "#initialize" do
+    it "should call setup" do
+      original_setup = Perl.setup
+      Perl.should_receive(:setup) do
+        @called = true
+        original_setup
+      end
+
+      described_class.new
+      @called.should be_true
+    end
+
+    it "should call perl_alloc and pass its return value to more methods" do
+      Perl.should_receive(:perl_alloc).and_return(42)
+      Perl.should_receive(:perl_construct).with(42)
+      Perl.should_receive(:perl_parse) do |*args|
+        @args = args
+      end
+      Perl.should_receive(:perl_run).with(42)
+
+      described_class.new
+      @args[0].should == 42
+    end
+
+    # XXX this is a bad spec, it should be a spec to fake_args itself
+    it "should call perl_parse with the expected arguments" do
+      argc, argv = PerlCommon.embedded_argv_to_ffi
+      Perl.should_receive(:perl_parse) do |*args|
+        @args = args
+      end
+
+      described_class.new
+      @args[2].should == argc
+      @args[3].should be_kind_of(FFI::MemoryPointer)
+      @args[3].size.should == FFI.type_size(:pointer) * (argc + 1)
+
+      (0..@args[2]).each do |i|
+        entry = @args[3][i].get_pointer(0)
+        entry.should be_kind_of(FFI::Pointer)
+      end
+      @args[3][0].get_pointer(0).read_string.should == ""
+      @args[3][1].get_pointer(0).read_string.should == "-e"
+      @args[3][2].get_pointer(0).read_string.should == "0"
+      @args[3][3].get_pointer(0).address.should == 0
+    end
+  end
+
+  describe "#call" do
+    after(:each) do
+      subject.stop
+    end
+
+    it "should prepare a Perl stack" do
+      Perl::Stack.should_receive(:function_stack)
+
+      subject.call("something", [], :void)
+    end
+
+    it "should call args_on_stack" do
+      Perl::Stack::Function.should_receive(:new).any_number_of_times do |stack, args|
+        @stack = stack
+        @args = args
+      end
+
+      subject.call("something", [], :void)
+      @args.should == []
+      subject.call("something", [{}, :hash], :void)
+      @args.should == [{}, :hash]
+    end
+
+    # XXX this should be a spec for Perl::Stack::Function
+    # it "should push all the arguments onto the stack" do
+    #   @stack = []
+    # 
+    #   fs = mock(:function_stack).tap do |stack|
+    #     stack.should_receive(:push).any_number_of_times do |arg|
+    #       @stack << arg
+    #     end
+    #   end
+    #   Perl::Stack::Function.should_receive(:new).and_yield(fs)
+    #   Perl.should_receive(:Perl_call_pv)
+    # 
+    #   subject.call("something", [{}, :hash], :void)
+    #   @stack.length.should == 1
+    #   @stack[0].should be_kind_of(FFI::Pointer)
+    # end
+
+    it "should pass a String to a Perl function" do
+      func = subject.eval("require 'dumpvar.pl'; sub { dumpValue(\\@_); };")
+
+      ret = capture_stdout_descriptor do
+        subject.call(func, "42", :void)
+      end
+      ret = ret.split(/\n/)
+      ret.length.should == 1
+      ret[0].should =~ /^0\s+42/
+    end
+
+    it "should pass a String reference to a Perl function" do
+      func = subject.eval("require 'dumpvar.pl'; sub { dumpValue(\\@_); };")
+
+      ret = capture_stdout_descriptor do
+        subject.call(func, {:ref => "42"}, :void)
+      end
+      ret = ret.split(/\n/)
+      ret.length.should == 2
+      ret[0].should =~ /^0\s+SCALAR/
+      ret[1].should =~ /^\s+-> 42/
+    end
+
+    it "should pass a Hash reference to a Perl function" do
+      func = subject.eval("require 'dumpvar.pl'; sub { dumpValue(\\@_); };")
+
+      ret = capture_stdout_descriptor do
+        subject.call(func, {:ref => {'a' => 'b'}}, :void)
+      end
+      ret = ret.split(/\n/)
+      ret.length.should == 2
+      ret[0].should =~ /^0\s+HASH/
+      ret[1].should =~ /^\s+'a' => 'b'/
+    end
+
+    context "in a void context" do
+      context "when passed a string" do
+        it "should yield nil" do
+          func = subject.eval("sub { return \"string\"; };")
+
+          subject.call(func, [], :void) do |ret|
+            ret.should be_nil
+          end
+        end
+
+        it "the return value should be nil" do
+          func = subject.eval("sub { return \"string\"; };")
+
+          subject.call(func, [], :void).should be_nil
+        end
+      end
+
+      context "when passed an array" do
+        it "should yield nil" do
+          func = subject.eval("sub { return [\"1\", \"2\"]; };")
+
+          subject.call(func, [], :void) do |ret|
+            ret.should be_nil
+          end
+        end
+
+        it "the return value should be nil" do
+          func = subject.eval("sub { return [\"1\", \"2\"]; };")
+
+          subject.call(func, [], :void).should be_nil
+        end
+      end
+    end
+
+    context "in a scalar context" do
+      context "when passed a string" do
+        it "should yield a scalar that acts as a string" do
+          func = subject.eval("sub { return \"string\"; };")
+
+          subject.call(func, [], :scalar) do |ret|
+            ret.value.should == "string"
+          end
+        end
+
+        it "should return a scalar that acts as a string" do
+          func = subject.eval("sub { return \"string\"; };")
+
+          ret = subject.call(func, [], :scalar)
+          ret.value.should == "string"
+        end
+      end
+
+      context "when passed an array" do
+        it "should yield an array reference" do
+          func = subject.eval("sub { return [\"1\", \"2\"]; };")
+
+          subject.call(func, [], :scalar) do |ret|
+            ret.reference?.should be_true
+            ret.deref.should be_kind_of(Perl::Value::Array)
+
+            array = ret.deref.value
+            array.length.should == 2
+            array[0].should be_kind_of(Perl::Value::Scalar)
+            array[0].value.should == "1"
+            array[1].should be_kind_of(Perl::Value::Scalar)
+            array[1].value.should == "2"
+          end
+        end
+
+        it "the return value should be an array reference" do
+          func = subject.eval("sub { return [\"1\", \"2\"]; };")
+
+          ret = subject.call(func, [], :scalar)
+          ret.reference?.should be_true
+          ret.deref.should be_kind_of(Perl::Value::Array)
+
+          array = ret.deref.value
+          array.length.should == 2
+          array[0].should be_kind_of(Perl::Value::Scalar)
+          array[0].value.should == "1"
+          array[1].should be_kind_of(Perl::Value::Scalar)
+          array[1].value.should == "2"
+        end
+      end
+    end
+  end
+end