Commits

Anonymous committed 5fc6adf

mingw 4x has the intrinsics but checking the version w/macros does not seem to work. so, this is a work around

  • Participants
  • Parent commits fa0af26
  • Branches intrinsics

Comments (0)

Files changed (5)

 $mb->change_versions(1);
 $mb->copyright_first_year( '2006' );
 $mb->add_pod_author_copyright_license(1);
+$mb->initialization_hook( <<'HOOK' );
+    require My::Util;
+    My::Util::write_detect_h();
+HOOK
 $mb->create_build_script;
 
 1;
 include/mingw32/README
 include/cpu.h
 builder/My.pm
+builder/My/Util.pm
     },
     build_requires => {
         'Test::Sys::Info' => '0.20',
+        'Capture::Tiny'   => 0,
     },
     recommends     => {},
     sign           => 0,
 #include <tchar.h>
 #include <string.h>
 
-#ifdef __MINGW32__
-#include "include/mingw32/intrin.h"
-#else
-#include <intrin.h>
-#endif
+#include "detect.h"
 
 #include "include/cpu.h"
 

File builder/My/Util.pm

+package My::Util;
+use strict;
+use warnings;
+use vars qw( @EXPORT_OK );
+use base qw( Exporter   );
+use Carp qw( croak      );
+
+@EXPORT_OK = qw( is_gcc4 write_detect_h );
+
+sub write_detect_h {
+    # for some reason, mingw bundled with strawberry returns 3
+    # if you check the major version macro in XS
+    require IO::File;
+    my $FH = IO::File->new;
+    $FH->open( 'detect.h', '>' ) or croak "Can't open detect.h for writing: $!";
+    print {$FH} _detect_h_content() or croak "Can't print to FH: $!";
+    $FH->close;
+    return 1;
+}
+
+sub _detect_h_content {
+    my $gcc4 = is_gcc4() ? 1 : 0;
+    my $raw  = <<"RAW";
+#define GCC4 $gcc4
+
+#if defined(__MINGW32__) && (!GCC4)
+#include "include/mingw32/intrin.h"
+#else
+#include <intrin.h>
+#endif
+
+RAW
+    return $raw;
+}
+
+sub is_gcc4 {
+    require Config;
+    my $cc = $Config::Config{cc} || return;
+    return if $cc !~ m{ gcc(?:[.]exe)? \z }xmsi;
+    my $v = capture($cc, '-v');
+    return if ! $v;
+    my @buf = split m{\n}xms, $v;
+    my $vline = pop @buf;
+    return if ! $vline;
+    if ( $vline =~ m{gcc \s version \s ([\d.]+) \s }xms ) {
+        my $version = $1;
+        return $version ge '4.0';
+    }
+    return;
+}
+
+sub capture {
+    my @cmd = @_;
+    require Capture::Tiny;
+    warn "CAPTURE: @cmd\n";
+    return Capture::Tiny::capture_merged( sub { qx{@cmd} } );
+}
+
+1;
+
+__END__