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