1# -*-perl-*- hey - emacs - this is a perl file 2 3# Copyright (c) 2021, PostgreSQL Global Development Group 4 5# src/tools/msvc/pgflex.pl 6 7use strict; 8use warnings; 9 10use File::Basename; 11 12# silence flex bleatings about file path style 13$ENV{CYGWIN} = 'nodosfilewarning'; 14 15# assume we are in the postgres source root 16 17do './src/tools/msvc/buildenv.pl' if -e 'src/tools/msvc/buildenv.pl'; 18 19my ($flexver) = `flex -V`; # grab first line 20$flexver = (split(/\s+/, $flexver))[1]; 21$flexver =~ s/[^0-9.]//g; 22my @verparts = split(/\./, $flexver); 23unless ($verparts[0] == 2 24 && ($verparts[1] > 5 || ($verparts[1] == 5 && $verparts[2] >= 31))) 25{ 26 print "WARNING! Flex install not found, or unsupported Flex version.\n"; 27 print "echo Attempting to build without.\n"; 28 exit 0; 29} 30 31my $input = shift; 32if ($input !~ /\.l$/) 33{ 34 print "Input must be a .l file\n"; 35 exit 1; 36} 37elsif (!-e $input) 38{ 39 print "Input file $input not found\n"; 40 exit 1; 41} 42 43(my $output = $input) =~ s/\.l$/.c/; 44 45# get flex flags from make file 46my $makefile = dirname($input) . "/Makefile"; 47my ($mf, $make); 48open($mf, '<', $makefile); 49local $/ = undef; 50$make = <$mf>; 51close($mf); 52my $basetarg = basename($output); 53my $flexflags = ($make =~ /^$basetarg:\s*FLEXFLAGS\s*=\s*(\S.*)/m ? $1 : ''); 54 55system("flex $flexflags -o$output $input"); 56if ($? == 0) 57{ 58 59 # Check for "%option reentrant" in .l file. 60 my $lfile; 61 open($lfile, '<', $input) || die "opening $input for reading: $!"; 62 my $lcode = <$lfile>; 63 close($lfile); 64 if ($lcode =~ /\%option\sreentrant/) 65 { 66 67 # Reentrant scanners usually need a fix to prevent 68 # "unused variable" warnings with older flex versions. 69 system("perl src\\tools\\fix-old-flex-code.pl $output"); 70 } 71 else 72 { 73 74 # For non-reentrant scanners we need to fix up the yywrap 75 # macro definition to keep the MS compiler happy. 76 # For reentrant scanners (like the core scanner) we do not 77 # need to (and must not) change the yywrap definition. 78 my $cfile; 79 open($cfile, '<', $output) || die "opening $output for reading: $!"; 80 my $ccode = <$cfile>; 81 close($cfile); 82 $ccode =~ s/yywrap\(n\)/yywrap()/; 83 open($cfile, '>', $output) || die "opening $output for writing: $!"; 84 print $cfile $ccode; 85 close($cfile); 86 } 87 if ($flexflags =~ /\s-b\s/) 88 { 89 my $lexback = "lex.backup"; 90 open($lfile, '<', $lexback) || die "opening $lexback for reading: $!"; 91 my $lexbacklines = <$lfile>; 92 close($lfile); 93 my $linecount = $lexbacklines =~ tr /\n/\n/; 94 if ($linecount != 1) 95 { 96 print "Scanner requires backup, see lex.backup.\n"; 97 exit 1; 98 } 99 unlink $lexback; 100 } 101 102 exit 0; 103 104} 105else 106{ 107 exit $? >> 8; 108} 109