no_comment

11 files changed, 35 insertions, 26 deletions

diff --git a/perl-install/Makefile b/perl-install/Makefile
index 4ae205f52..dcb0ff56b 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -61,7 +61,8 @@ $(DIRS):
 
 test_pms: verify_c
 	./perl2fcalls -excludec install2
-	(for i in $(PMS); do perl -cw -I. -Ic -Ic/blib/arch $$i || exit 1 ; done)
+	perl -cw -I. -Ic -Ic/blib/arch install2
+	perl -cw -I. -Ic -Ic/blib/arch install_steps_graphical.pm
 
 verify_c:
 	./verify_c $(PMS)
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 9eec42f88..acd1c17f0 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -252,7 +252,7 @@ sub testFinalConfig($;$) {
     symlink "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix;
 
     local *F;
-    open F, "|perl" or die;
+    open F, "|perl" or die '';
     print F "use lib qw(", join(' ', @INC), ");\n";
     print F q{
 	use interactive_gtk;
@@ -426,7 +426,7 @@ sub resolutionsConfiguration($$) {
     #-$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("),
     #-							_("Do you want to try?") ]);
     
-    unless ($card->{depth}) {
+    if (is_empty_hash_ref($card->{depth})) {
 	$card->{depth}{$_} = [ map { [ split "x" ] } @resolutions ] 
 	  foreach @depths;
 
@@ -435,6 +435,9 @@ _("I can try to find the available resolutions (eg: 800x600).
 Alas it can freeze sometimes
 Do you want to try?")))) {
 	    autoResolutions($o, $nowarning);
+	    is_empty_hash_ref($card->{depth}) and $in->ask_warn('', 
+_("No valid modes found
+Try with another video card or monitor")), return;
 	}
     }
 
@@ -449,7 +452,7 @@ Do you want to try?")))) {
     keepOnlyLegalModes($card);
 
     my $res = $o->{resolution_wanted} || $resolution_wanted;
-    my $depth = $card->{default_depth} || autoDefaultDepth($card, $res);
+    my $depth = eval { $card->{default_depth} || autoDefaultDepth($card, $res) };
 
     $auto or ($depth, $res) = chooseResolutions($card, $depth) or return;
 
diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm
index 97280f36d..3bc757382 100644
--- a/perl-install/Xconfigurator_consts.pm
+++ b/perl-install/Xconfigurator_consts.pm
@@ -28,6 +28,7 @@ $resolution_wanted = "1024x768";
 
 %standard_monitors = (
   __("Standard VGA, 640x480 at 60 Hz")                             => [ '640x480@60',      "31.5"            , "60" ],
+  __("Standard VGA, 640x480 at 60 Hz")                             => [ '640x480@60',      "31.5"            , "60" ],
   __("Super VGA, 800x600 at 56 Hz") 				   => [ '800x600@56',      "31.5-35.1"       , "55-60" ],
   __("8514 Compatible, 1024x768 at 87 Hz interlaced (no 800x600)") => [ '8514 compatible', "31.5,35.5"       , "60,70,87" ],
   __("Super VGA, 1024x768 at 87 Hz interlaced, 800x600 at 56 Hz")  => [ '1024x768@87i',    "31.5,35.15,35.5" , "55-90" ],
diff --git a/perl-install/common.pm b/perl-install/common.pm
index baef6befa..e2a135cdc 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
 
 @ISA = qw(Exporter);
 %EXPORT_TAGS = (
-    common     => [ qw(__ min max sum sign product bool listlength bool2text to_int ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate warp_text) ],
+    common     => [ qw(__ min max sum sign product bool listlength bool2text to_int ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate warp_text) ],
     functional => [ qw(fold_left map_index map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie) ],
     file       => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
     system     => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
@@ -62,6 +62,7 @@ sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
 sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
 sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
 sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
+sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 }
 sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
 sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = (); } keys %l }
 
@@ -136,7 +137,7 @@ sub add_f4before_leaving {
     my $list = *common::before_leaving::list;
     $list->{$b}{$name} = $f;
     *N = sub {
-	my $f = $list->{$_[0]}{$name} or die;
+	my $f = $list->{$_[0]}{$name} or die '';
 	$name eq 'DESTROY' and delete $list->{$_[0]};
 	goto $f;
     } unless defined &{*N};
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 61a0f2dff..9ff3a0c01 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -251,7 +251,7 @@ sub move {
     return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
 
     local (*F, *G);
-    sysopen F, $hd->{file}, 0 or die;
+    sysopen F, $hd->{file}, 0 or die '';
     sysopen G, $hd2->{file}, 2 or die _("Error opening %s for writing: %s", $hd2->{file}, "$!");
 
     my $base = $part->{start};
@@ -273,7 +273,7 @@ sub move {
 	c::lseek_sector(fileno(G), $base2, 0) or die "seeking to sector $base2 failed on drive $hd2->{device}";
     
 	my $buf;
-	sysread F, $buf, $SECTORSIZE * abs($_[0]) or die;
+	sysread F, $buf, $SECTORSIZE * abs($_[0]) or die '';
 	syswrite G, $buf;
     };
 
diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm
index c33a53e55..6e1002840 100644
--- a/perl-install/ftp.pm
+++ b/perl-install/ftp.pm
@@ -39,8 +39,8 @@ sub new {
 	$host = join ".", unpack "C4", (gethostbyname $host)[4];
     }
 
-    my $ftp = Net::FTP->new($host, %options) or die;
-    $ftp->login($ENV{LOGIN}, $ENV{PASSWORD}) or die;
+    my $ftp = Net::FTP->new($host, %options) or die '';
+    $ftp->login($ENV{LOGIN}, $ENV{PASSWORD}) or die '';
     $ftp->binary;
 
     $ftp;
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index cd45e7763..5d864a3f0 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -382,19 +382,21 @@ sub setupSCSI {
 
 #------------------------------------------------------------------------------
 sub partitionDisks {
-    $o->{drives} = [ detect_devices::hds() ];
-    $o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) }
-      sub {
-	  $o->ask_warn(_("Error"), 
+    unless ($o->{hds}) {
+	$o->{drives} = [ detect_devices::hds() ];
+	$o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) }
+	  sub {
+	      $o->ask_warn(_("Error"), 
 _("I can't read your partition table, it's too corrupted for me :(
 I'll try to go on blanking bad partitions"));
-	  1;
-      };
+	      1;
+	  };
 
-    unless (@{$o->{hds}} > 0) {
-	$o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card
+	unless (@{$o->{hds}} > 0) {
+	    $o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card
+	}
     }
-    unless (@{$o->{hds}} > 0) { #- no way
+    if (@{$o->{hds}} == 0) { #- no way
 	die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
     }
 
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 6485aa759..2cab51528 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -75,9 +75,9 @@ sub spawnShell {
     local *F;
     sysopen F, "/dev/tty2", 2 or die "cannot open /dev/tty2 -- no shell will be provided";
 
-    open STDIN, "<&F" or die;
-    open STDOUT, ">&F" or die;
-    open STDERR, ">&F" or die;
+    open STDIN, "<&F" or die '';
+    open STDOUT, ">&F" or die '';
+    open STDERR, ">&F" or die '';
     close F;
 
     c::setsid();
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 3b296a982..4ffb44d71 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -59,14 +59,14 @@ sub ask_okcancel($$$;$) {
 
 sub ask_from_list_ {
     my ($o, $title, $message, $l, $def) = @_;    
-    @$l == 0 and die;
+    @$l == 0 and die '';
     @$l == 1 and return $l->[0];
     goto &ask_from_list2_;
 }
 
 sub ask_from_list {
     my ($o, $title, $message, $l, $def) = @_;
-    @$l == 0 and die;
+    @$l == 0 and die '';
     @$l == 1 and return $l->[0];
     goto &ask_from_list2;
 }
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 33f753638..f3228358f 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -163,7 +163,7 @@ sub gtkset_default_fontset($) {
     my ($fontset) = @_;
 
     my $style = Gtk::Widget->get_default_style;
-    my $f = Gtk::Gdk::Font->fontset_load($fontset) or die;
+    my $f = Gtk::Gdk::Font->fontset_load($fontset) or die '';
     $style->font($f);
     Gtk::Widget->set_default_style($style);
 }
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 94c17b815..b16f9dd38 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -36,6 +36,7 @@ my %types = (
   0xb => "Win98 FAT32 0xb",
   0xc => "Win98 FAT32",
   0xe => "Win98 FAT32 0xd",
+  0xf => "Win95 Ext'd (LBA)",
   0x12 => "Compaq setup",
   0x40 => "Venix 80286",
   0x51 => "Novell?",
@@ -89,7 +90,7 @@ sub type2fs($) { $type2fs{$_[0]} }
 sub name2type($) { $types_rev{$_[0]} }
 sub fs2type($) { $fs2type{$_[0]} }
 
-sub isExtended($) { $_[0]{type} == 5 }
+sub isExtended($) { $_[0]{type} == 5 || $_[0]{type} == 0xf }
 sub isSwap($) { $type2fs{$_[0]{type}} eq 'swap' }
 sub isExt2($) { $type2fs{$_[0]{type}} eq 'ext2' }
 sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]{type}} }