Re: Greg Spencer's win32 extensions

[Rajesh Vaidheeswarran]

Zach,

I'm not sure I understand this change well. Please feel free to correct
me if my understanding is incorrect.

Is the default of building in a linked directory going to be changed for
win32 to build in the source tree? If so, I'm not sure that would be
acceptable by many win32 users who use the command line solely.. I would
expect this behavior to be caused by passing a flag to cons (and explicitly
warning the users of the consequence.)

Also, your input is valuable.. I request that you submit your changes
with changes to the documentation of cons too. We have to keep the docs
up-to-date, and that was the reason for putting it in the code.

Thanks
rv


In a previous message, "Zachary Deretsky" writes:

> This is a multi-part message in MIME format.
> 
> ------=_NextPart_000_000E_01C0BBAE.DEAC47B0
> Content-Type: text/plain;
>       charset="iso-8859-1"
> Content-Transfer-Encoding: 7bit
> 
> We moved win32 changes which Greg Spencer posted against cons 1.8 to cons
> 2.2.0
> The resulting cons works with the original ConsExtensions.pm and
> DSPGenerator.pl
> 
> 
> I attach the patch made against cons.pl 1.126; the latest version today is
> 1.147, so things change very rapidly.
> I made the patch on NT, so it has dos line endings.
> 
> Steven, would it be possible to merge these changes into 2.3.0?
> I believe Windows users will appreciate the inclusion of these features even
> if they are not perfect.
> 
> Two comments:
> 
> 1. Greg's methodology is to compile from the source directory (not from the
> linked build directory).
> This allows to run compiles and debug from the MS Visual Studio.
> If you have Commands which generate .cpp files which then need to be
> compiled, then these
> intermediate .cpp files need to be copied or moved from the build directory
> to the source directory.
> 
> 2. The patch also includes the change necessary for the long link commands
> on NT.
> Temporary files for these commands could be created in some other, maybe
> more elegant way.
> 
> Thanks, Zach.
> 
> 
> 
> 
> 
> ------=_NextPart_000_000E_01C0BBAE.DEAC47B0
> Content-Type: application/octet-stream;
>       name="cons126.patch"
> Content-Transfer-Encoding: quoted-printable
> Content-Disposition: attachment;
>       filename="cons126.patch"
> 
> *** e:\gnucvs_01_2001\cons\src\cons.pl        Mon Apr 02 18:35:41 2001
> --- e:\atools\nt\bin\cons.pl  Mon Mar 26 13:25:27 2001
> ***************
> *** 13,26 ****
>   # Regression tests keep the code honest by checking for warnings
>   # and "use strict" failures.
>  =20
> ! # $Id: cons.pl,v 1.126 2000/11/09 16:26:03 knight Exp $
>  =20
>   use vars qw( $ver_num $ver_rev $version );
>  =20
>   $ver_num =3D "__VERSION__";
>   $ver_rev =3D "__REVISION__";
>   $version =3D sprintf "This is Cons %s%s " .
> !         '($Id: cons.pl,v 1.126 2000/11/09 16:26:03 knight Exp $)'. "\n",
>           $ver_num, $ver_rev;
>  =20
>   # Cons: A Software Construction Tool.
> --- 13,26 ----
>   # Regression tests keep the code honest by checking for warnings
>   # and "use strict" failures.
>  =20
> ! # $Id: cons.pl 1.3 2001/01/13 05:38:16 sasha Exp $
>  =20
>   use vars qw( $ver_num $ver_rev $version );
>  =20
>   $ver_num =3D "__VERSION__";
>   $ver_rev =3D "__REVISION__";
>   $version =3D sprintf "This is Cons %s%s " .
> !         '($Id: cons.pl 1.3 2001/01/13 05:38:16 sasha Exp $)'. "\n",
>           $ver_num, $ver_rev;
>  =20
>   # Cons: A Software Construction Tool.
> ***************
> *** 179,190 ****
> --- 179,208 ----
>  =20
>   );
>  =20
> + # stash the path to cons.
> + $param::conspath =3D $0;
> +=20
>   # Simplify program name, if it is a path.
>   {
>       my ($vol, $dir, $file) =3D =
> File::Spec->splitpath(File::Spec->canonpath($0));
>       $0 =3D $file;
>   }
>  =20
> + # make it an absolute path to cons.
> + if (!File::Spec->file_name_is_absolute($param::conspath)) {
> +     my ($vol, $dir, $file) =3D =
> File::Spec->splitpath($param::conspath);
> +     my $oldcwd =3D Cwd::cwd();
> +     my $newcwd =3D File::Spec->catpath($vol, $dir, undef);
> +     chdir($newcwd);
> +     my ($cvol, $cdir, $cfile) =3D =
> File::Spec->splitpath(Cwd::cwd().$dir::SEPARATOR);
> +     $param::conspath =3D File::Spec->catpath($cvol,$cdir,$file);
> +=20
> +     chdir($oldcwd);
> + }
> + # regularize path
> + $param::conspath =3D~ s,$dir::MATCH_SEPARATOR,$dir::SEPARATOR,g;
> +=20
> +=20
>   # Default parameters.
>   $param::topfile =3D 'Construct';    # Top-level construction file.
>   $param::install =3D 1;              # Show installations
> ***************
> *** 241,246 ****
> --- 259,267 ----
>       'CXXFLAGS'       =3D> '%CFLAGS',
>       'CXXCOM'         =3D> '%CXX %CXXFLAGS %_IFLAGS /c %< /Fo%>',
>       'INCDIRPREFIX'   =3D> '/I',
> +     'RC'             =3D> 'rc',  # ok, so it doesn't really exist on =
> UNIX...
> +     'RCFLAGS'        =3D> '',
> +     'RCCOM'          =3D> '%RC %RCFLAGS %_IFLAGS -o %> %<',
>       'LINK'           =3D> 'link',
>       'LINKCOM'        =3D> '%LINK %LDFLAGS /out:%> %< %_LDIRS %LIBS',
>       'LINKMODULECOM'  =3D> '%LD /r /o %> %<',
> ***************
> *** 478,492 ****
>   # Build the supplied target patterns.
>   my $tgt;
>   for $tgt (map($dir::top->lookup($_), @targets)) {
> !     if ($target_top && ! $tgt->is_under($target_top)) {
>       # A -t option was used, and this target is not underneath
>       # the directory where we were invoked via -t.
>       # If the target is a directory and the -t directory
>       # is underneath it, then build the -t directory.
> !     if (ref $tgt ne "dir" || ! $target_top->is_under($tgt)) {
> !         next;
>       }
> -     $tgt =3D $target_top;
>       }
>       buildtoptarget($tgt);
>   }
> --- 499,519 ----
>   # Build the supplied target patterns.
>   my $tgt;
>   for $tgt (map($dir::top->lookup($_), @targets)) {
> ! #    if ($target_top && ! $tgt->is_under($target_top)) {
> !      if (!File::Spec->file_name_is_absolute($tgt->path) &&
> !     $target_top && ! $tgt->is_under($target_top)) {
> ! =09
>       # A -t option was used, and this target is not underneath
>       # the directory where we were invoked via -t.
>       # If the target is a directory and the -t directory
>       # is underneath it, then build the -t directory.
> ! #   if (ref $tgt ne "dir" || ! $target_top->is_under($tgt)) {
> ! #       next;
> ! #   }
> ! #   $tgt =3D $target_top;
> !     if (ref $tgt eq "dir" &&  $target_top->is_under($tgt)) {
> !             $tgt =3D $target_top;
>       }
>       }
>       buildtoptarget($tgt);
>   }
> ***************
> *** 1277,1312 ****
>   # b: return full path, but strip any suffix (a.k.a. return basename)
>   # s: return only the suffix (or an empty string, if no suffix is =
> there)
>   # a: return the absolute path to the file
>   # no option: return full path to file
>   sub _variant {
> !     my($opt, $file) =3D @_;
> !     $opt =3D '' if ! defined $opt;
> !     if ($opt eq 'f') { return $file->{entry}; }
> !     elsif ($opt eq 'd') { return $file->{dir}->path; }
> !     elsif ($opt eq 'F') {
> !     my $subst =3D $file->{entry};
> !     $subst =3D~ s/\.[^\.]+$//;
> !     return $subst;
>       }
>       elsif ($opt eq 'b') {
> !     my $subst =3D $file->path;
> !     $subst =3D~ s/\.[^\.]+$//;
> !     return $subst;
> !     }
>       elsif ($opt eq 's') {
> !     my $subst =3D $file->{entry};
> !     $subst =3D~ m/(\.[^\.]+)$/;
> !     return $1;
> !     }
>       elsif ($opt eq 'a') {
> !     my $path =3D $file->path;
> !     if (! File::Spec->file_name_is_absolute($path)) {
> !         $path =3D File::Spec->catfile(Cwd::cwd(), $path);
> !     }
> !     return $path;
>       }
> !     else { return $file->path; }
> ! }
>  =20
>   # For the signature of a basic command, we don't bother
>   # including the command itself. This is not strictly correct,
> --- 1304,1353 ----
>   # b: return full path, but strip any suffix (a.k.a. return basename)
>   # s: return only the suffix (or an empty string, if no suffix is =
> there)
>   # a: return the absolute path to the file
> + # S: return the absolute path to the source file.
>   # no option: return full path to file
>   sub _variant {
> !     my $opt =3D shift;
> !     my $tgt =3D shift;
> !     my $isrfile =3D shift;
> ! =20
> !     if ($opt eq 'f') { return $tgt->{entry}; }
> !     elsif ($opt eq 'd') {=20
> !       return $isrfile ? $tgt->rfile->{dir}->path : $tgt->{dir}->path;
>       }
> +     elsif ($opt eq 'F') {
> +       my $subst =3D $tgt->{entry};
> +       $subst =3D~ s/\.[^\.]+$//;
> +       return $subst;
> +       }
>       elsif ($opt eq 'b') {
> !       my $subst =3D $isrfile ? $tgt->rpath : $tgt->path;
> !       $subst =3D~ s/\.[^\.]+$//;
> !       return $subst;
> !       }
>       elsif ($opt eq 's') {
> !       my $file =3D $tgt->{entry};
> !       $file =3D~ m/(\.[^\.]+)$/;
> !       return $1;
> !       }
>       elsif ($opt eq 'a') {
> !       my $cwd =3D Cwd::cwd();
> !       my $path =3D $isrfile ? $tgt->rpath : $tgt->path;
> !       $cwd .=3D $dir::SEPARATOR.$path;
> !       return $cwd;
> !     }
> !     elsif ($opt eq 'S') {
> !       my $cwd =3D Cwd::cwd();
> !       # regularize path
> !       $cwd =3D~ s,$dir::MATCH_SEPARATOR,$dir::SEPARATOR,g;
> !       $cwd .=3D $dir::SEPARATOR.$tgt->srcpath;
> !       return $cwd;
> !     }
> !     else {
> !       my $path =3D $isrfile ? $tgt->rpath : $tgt->path;
> !       return $path;
>       }
> !   }
>  =20
>   # For the signature of a basic command, we don't bother
>   # including the command itself. This is not strictly correct,
> ***************
> *** 1335,1361 ****
>       $com =3D~ s/%[()]//g;
>  =20
>       # Deal with %n, n=3D1,9 and variants.
> !     while ($com =3D~ /%([1-9])(:([fdbsFa]?))?/) {
>           my($match) =3D $&;
>           my($src) =3D $src1[$1];
> !         my($subst) =3D _variant($3, $src1[$1]->rfile);
>           undef $src[$1];
>           $com =3D~ s/$match/$subst/;
>       }
>  =20
>       # Deal with %0 aka %> and variants.
> !     while ($com =3D~ /%[0>](:([fdbsFa]?))?/) {
>           my($match) =3D $&;
> !         my($subst) =3D _variant($2, $tgt);
>           $com =3D~ s/$match/$subst/;
>       }
>  =20
>       # Deal with %< (all sources except %n's already used)
> !     while ($com =3D~ /%<(:([fdbsFa]?))?/) {
>           my($match) =3D $&;
>           my @list =3D ();
>           foreach (@src) {
> !             push(@list, _variant($2, $_->rfile)) if $_;
>           }
>           my($subst) =3D join(' ', @list);
>           $com =3D~ s/$match/$subst/;
> --- 1376,1402 ----
>       $com =3D~ s/%[()]//g;
>  =20
>       # Deal with %n, n=3D1,9 and variants.
> !     while ($com =3D~ /%([1-9])(:([fdbsFaS]?))?/) {
>           my($match) =3D $&;
>           my($src) =3D $src1[$1];
> !         my($subst) =3D _variant($3, $src1[$1],1);
>           undef $src[$1];
>           $com =3D~ s/$match/$subst/;
>       }
>  =20
>       # Deal with %0 aka %> and variants.
> !     while ($com =3D~ /%[0>](:([fdbsFaS]?))?/) {
>           my($match) =3D $&;
> !         my($subst) =3D _variant($2, $tgt,0);
>           $com =3D~ s/$match/$subst/;
>       }
>  =20
>       # Deal with %< (all sources except %n's already used)
> !     while ($com =3D~ /%<(:([fdbsFaS]?))?/) {
>           my($match) =3D $&;
>           my @list =3D ();
>           foreach (@src) {
> !             push(@list, _variant($2, $_, 1)) if $_;
>           }
>           my($subst) =3D join(' ', @list);
>           $com =3D~ s/$match/$subst/;
> ***************
> *** 1438,1444 ****
>         # Can't fork on Win32
>         #---------------------
>         if ($main::_WIN32) {
> !         system($com);
>           if ($?) {
>             my ($b0, $b1) =3D ($? & 0xFF, $? >> 8);
>             my $err =3D $b1 || $?;
> --- 1479,1506 ----
>         # Can't fork on Win32
>         #---------------------
>         if ($main::_WIN32) {
> !=20
> ! # Tony's fix for The following character string is too long:
> !           if ($com !~ /^$env->{LINK} /) {
> !               system($com);
> !           } else {
> !               my @link_line =3D split(/\s+/, $com);
> !               shift @link_line;
> !=20
> !               # Create temporary file, write command line to it
> !               my $linkopts =3D tempname();
> !=20
> !               open(LINKOPTS, ">$linkopts") || die("$0: can't open $linkopts
>  =
> ($!)\n");
> !               print LINKOPTS join(' ', @link_line), "\n";
> !               close LINKOPTS;
> ! #           File::Slurp::overwrite_file( $linkopts,"@link_line");
> !               my $link_command =3D "link.exe address@hidden";
> !             main::showcom($link_command);
> !               system($link_command );
> !               unlink($linkopts);
> !           }
> ! #       system($com);
> !=20
>           if ($?) {
>             my ($b0, $b1) =3D ($? & 0xFF, $? >> 8);
>             my $err =3D $b1 || $?;
> ***************
> *** 1449,1454 ****
> --- 1511,1520 ----
>             return undef;
>           }
>         } else {
> +         #
> +         # Unix
> +         #
> +       =09
>           my($pid) =3D fork();
>           die("$0: unable to fork child process ($!)\n") if !defined $pid;
>           if (!$pid) {
> ***************
> *** 1494,1499 ****
> --- 1560,1579 ----
>       $_[0]->{comsig}
>   }
>  =20
> + # Return temporary file name
> + sub tempname {
> +     my $tempdir;
> +     my $temppath;
> +     # Find temporary directory by inspecting
> +     # TMP environment variable
> +     require "POSIX.pm";
> +     $tempdir =3D '.' unless (($tempdir =3D $ENV{'TMP'}) && -d =
> $tempdir);
> +     # Generate names until we find the one that does not exist
> +     do {
> +             $temppath =3D $tempdir . POSIX::tmpnam();
> +     } while (-f $temppath);
> +     $temppath;
> + }
>   =0C
>   # Create a linked module.
>   package build::command::link;
> ***************
> *** 2342,2347 ****
> --- 2422,2430 ----
>           # Top-relative names begin with #.
>           $dir =3D $dir::top;
>       }
> +     elsif ($entry =3D~ s/^\!//) {
> +         $dir =3D $dir::cwd->srcdir;
> +     }
>       } else {
>       my $dirsref;
>       ($dir, $dirsref, $entry) =3D _parse_path($dir, $entry);
> ***************
> *** 2372,2377 ****
> --- 2455,2463 ----
>       if ($entry =3D~ s/^#//) {
>           # Top-relative names begin with #.
>           $dir =3D $dir::top;
> +     }
> +     elsif ($entry =3D~ s/^\!//) {
> +         $dir =3D $dir::cwd->srcdir;
>       }
>       } else {
>       my $dirsref;
> 
> ------=_NextPart_000_000E_01C0BBAE.DEAC47B0--
> 
> 
> _______________________________________________
> address@hidden
> http://mail.gnu.org/mailman/listinfo/cons-discuss
> Cons URL: http://www.dsmit.com/cons/
>