"Fossies" - the Fresh Open Source Software Archive

Member "automake-1.16.3/lib/Automake/Condition.pm" (19 Nov 2020, 15177 Bytes) of package /linux/misc/automake-1.16.3.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Condition.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 1.16.2_vs_1.16.3.

    1 # Copyright (C) 1997-2020 Free Software Foundation, Inc.
    2 
    3 # This program is free software; you can redistribute it and/or modify
    4 # it under the terms of the GNU General Public License as published by
    5 # the Free Software Foundation; either version 2, or (at your option)
    6 # any later version.
    7 
    8 # This program is distributed in the hope that it will be useful,
    9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 # GNU General Public License for more details.
   12 
   13 # You should have received a copy of the GNU General Public License
   14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
   15 
   16 package Automake::Condition;
   17 
   18 use 5.006;
   19 use strict;
   20 use warnings FATAL => 'all';
   21 
   22 use Carp;
   23 use Exporter;
   24 
   25 our @ISA = qw (Exporter);
   26 our @EXPORT_OK = qw (TRUE FALSE reduce_and reduce_or);
   27 
   28 =head1 NAME
   29 
   30 Automake::Condition - record a conjunction of conditionals
   31 
   32 =head1 SYNOPSIS
   33 
   34   use Automake::Condition;
   35 
   36   # Create a condition to represent "COND1 and not COND2".
   37   my $cond = new Automake::Condition "COND1_TRUE", "COND2_FALSE";
   38   # Create a condition to represent "not COND3".
   39   my $other = new Automake::Condition "COND3_FALSE";
   40 
   41   # Create a condition to represent
   42   #   "COND1 and not COND2 and not COND3".
   43   my $both = $cond->merge ($other);
   44 
   45   # Likewise, but using a list of conditional strings
   46   my $both2 = $cond->merge_conds ("COND3_FALSE");
   47 
   48   # Strip from $both any subconditions which are in $other.
   49   # This is the opposite of merge.
   50   $cond = $both->strip ($other);
   51 
   52   # Return the list of conditions ("COND1_TRUE", "COND2_FALSE"):
   53   my @conds = $cond->conds;
   54 
   55   # Is $cond always true?  (Not in this example)
   56   if ($cond->true) { ... }
   57 
   58   # Is $cond always false? (Not in this example)
   59   if ($cond->false) { ... }
   60 
   61   # Return the list of conditionals as a string:
   62   #  "COND1_TRUE COND2_FALSE"
   63   my $str = $cond->string;
   64 
   65   # Return the list of conditionals as a human readable string:
   66   #  "COND1 and !COND2"
   67   my $str = $cond->human;
   68 
   69   # Return the list of conditionals as a AC_SUBST-style string:
   70   #  "@COND1_TRUE@@COND2_FALSE@"
   71   my $subst = $cond->subst_string;
   72 
   73   # Is $cond true when $both is true?  (Yes in this example)
   74   if ($cond->true_when ($both)) { ... }
   75 
   76   # Is $cond redundant w.r.t. {$other, $both}?
   77   # (Yes in this example)
   78   if ($cond->redundant_wrt ($other, $both)) { ... }
   79 
   80   # Does $cond imply any of {$other, $both}?
   81   # (Not in this example)
   82   if ($cond->implies_any ($other, $both)) { ... }
   83 
   84   # Remove superfluous conditionals assuming they will eventually
   85   # be multiplied together.
   86   # (Returns @conds = ($both) in this example, because
   87   # $other and $cond are implied by $both.)
   88   @conds = Automake::Condition::reduce_and ($other, $both, $cond);
   89 
   90   # Remove superfluous conditionals assuming they will eventually
   91   # be summed together.
   92   # (Returns @conds = ($cond, $other) in this example, because
   93   # $both is a subset condition of $cond: $cond is true whenever $both
   94   # is true.)
   95   @conds = Automake::Condition::reduce_or ($other, $both, $cond);
   96 
   97   # Invert a Condition.  This returns a list of Conditions.
   98   @conds = $both->not;
   99 
  100 =head1 DESCRIPTION
  101 
  102 A C<Condition> is a conjunction of conditionals (i.e., atomic conditions
  103 defined in F<configure.ac> by C<AM_CONDITIONAL>.  In Automake they
  104 are used to represent the conditions into which F<Makefile> variables and
  105 F<Makefile> rules are defined.
  106 
  107 If the variable C<VAR> is defined as
  108 
  109   if COND1
  110     if COND2
  111       VAR = value
  112     endif
  113   endif
  114 
  115 then it will be associated a C<Condition> created with
  116 the following statement.
  117 
  118   new Automake::Condition "COND1_TRUE", "COND2_TRUE";
  119 
  120 Remember that a C<Condition> is a I<conjunction> of conditionals, so
  121 the above C<Condition> means C<VAR> is defined when C<COND1>
  122 B<and> C<COND2> are true. There is no way to express disjunctions
  123 (i.e., I<or>s) with this class (but see L<DisjConditions>).
  124 
  125 Another point worth to mention is that each C<Condition> object is
  126 unique with respect to its conditionals.  Two C<Condition> objects
  127 created for the same set of conditionals will have the same address.
  128 This makes it easy to compare C<Condition>s: just compare the
  129 references.
  130 
  131   my $c1 = new Automake::Condition "COND1_TRUE", "COND2_TRUE";
  132   my $c2 = new Automake::Condition "COND1_TRUE", "COND2_TRUE";
  133   $c1 == $c2;  # True!
  134 
  135 =head2 Methods
  136 
  137 =over 4
  138 
  139 =item C<$cond = new Automake::Condition [@conds]>
  140 
  141 Return a C<Condition> objects for the conjunctions of conditionals
  142 listed in C<@conds> as strings.
  143 
  144 An item in C<@conds> should be either C<"FALSE">, C<"TRUE">, or have
  145 the form C<"NAME_FALSE"> or C<"NAME_TRUE"> where C<NAME> can be
  146 anything (in practice C<NAME> should be the name of a conditional
  147 declared in F<configure.ac> with C<AM_CONDITIONAL>, but it's not
  148 C<Automake::Condition>'s responsibility to ensure this).
  149 
  150 An empty C<@conds> means C<"TRUE">.
  151 
  152 As explained previously, the reference (object) returned is unique
  153 with respect to C<@conds>.  For this purpose, duplicate elements are
  154 ignored, and C<@conds> is rewritten as C<("FALSE")> if it contains
  155 C<"FALSE"> or two contradictory conditionals (such as C<"NAME_FALSE">
  156 and C<"NAME_TRUE">.)
  157 
  158 Therefore the following two statements create the same object (they
  159 both create the C<"FALSE"> condition).
  160 
  161   my $c3 = new Automake::Condition "COND1_TRUE", "COND1_FALSE";
  162   my $c4 = new Automake::Condition "COND2_TRUE", "FALSE";
  163   $c3 == $c4;   # True!
  164   $c3 == FALSE; # True!
  165 
  166 =cut
  167 
  168 # Keys in this hash are conditional strings. Values are the
  169 # associated object conditions.  This is used by 'new' to reuse
  170 # Condition objects with identical conditionals.
  171 our %_condition_singletons;
  172 # Do NOT reset this hash here.  It's already empty by default,
  173 # and any setting would otherwise occur AFTER the 'TRUE' and 'FALSE'
  174 # constants definitions.
  175 #   %_condition_singletons = ();
  176 
  177 sub new ($;@)
  178 {
  179   my ($class, @conds) = @_;
  180   my $self = {
  181     hash => {},
  182   };
  183   bless $self, $class;
  184 
  185   for my $cond (@conds)
  186     {
  187       # Catch some common programming errors:
  188       # - A Condition passed to new
  189       confess "'$cond' is a reference, expected a string" if ref $cond;
  190       # - A Condition passed as a string to new
  191       confess "'$cond' does not look like a condition" if $cond =~ /::/;
  192     }
  193 
  194   # Accept strings like "FOO BAR" as shorthand for ("FOO", "BAR").
  195   @conds = map { split (' ', $_) } @conds;
  196 
  197   for my $cond (@conds)
  198     {
  199       next if $cond eq 'TRUE';
  200 
  201       # Detect cases when @conds can be simplified to FALSE.
  202       if (($cond eq 'FALSE' && $#conds > 0)
  203       || ($cond =~ /^(.*)_TRUE$/ && exists $self->{'hash'}{"${1}_FALSE"})
  204       || ($cond =~ /^(.*)_FALSE$/ && exists $self->{'hash'}{"${1}_TRUE"}))
  205     {
  206       return &FALSE;
  207     }
  208 
  209       $self->{'hash'}{$cond} = 1;
  210     }
  211 
  212   my $key = $self->string;
  213   if (exists $_condition_singletons{$key})
  214     {
  215       return $_condition_singletons{$key};
  216     }
  217   $_condition_singletons{$key} = $self;
  218   return $self;
  219 }
  220 
  221 =item C<$newcond = $cond-E<gt>merge (@otherconds)>
  222 
  223 Return a new condition which is the conjunction of
  224 C<$cond> and C<@otherconds>.
  225 
  226 =cut
  227 
  228 sub merge ($@)
  229 {
  230   my ($self, @otherconds) = @_;
  231   new Automake::Condition (map { $_->conds } ($self, @otherconds));
  232 }
  233 
  234 =item C<$newcond = $cond-E<gt>merge_conds (@conds)>
  235 
  236 Return a new condition which is the conjunction of C<$cond> and
  237 C<@conds>, where C<@conds> is a list of conditional strings, as
  238 passed to C<new>.
  239 
  240 =cut
  241 
  242 sub merge_conds ($@)
  243 {
  244   my ($self, @conds) = @_;
  245   new Automake::Condition $self->conds, @conds;
  246 }
  247 
  248 =item C<$newcond = $cond-E<gt>strip ($minuscond)>
  249 
  250 Return a new condition which has all the conditionals of C<$cond>
  251 except those of C<$minuscond>.  This is the opposite of C<merge>.
  252 
  253 =cut
  254 
  255 sub strip ($$)
  256 {
  257   my ($self, $minus) = @_;
  258   my @res = grep { not $minus->_has ($_) } $self->conds;
  259   return new Automake::Condition @res;
  260 }
  261 
  262 =item C<@list = $cond-E<gt>conds>
  263 
  264 Return the set of conditionals defining C<$cond>, as strings.  Note that
  265 this might not be exactly the list passed to C<new> (or a
  266 concatenation of such lists if C<merge> was used), because of the
  267 cleanup mentioned in C<new>'s description.
  268 
  269 For instance C<$c3-E<gt>conds> will simply return C<("FALSE")>.
  270 
  271 =cut
  272 
  273 sub conds ($ )
  274 {
  275   my ($self) = @_;
  276   my @conds = keys %{$self->{'hash'}};
  277   return ("TRUE") unless @conds;
  278   return sort @conds;
  279 }
  280 
  281 # Undocumented, shouldn't be needed outside of this class.
  282 sub _has ($$)
  283 {
  284   my ($self, $cond) = @_;
  285   return exists $self->{'hash'}{$cond};
  286 }
  287 
  288 =item C<$cond-E<gt>false>
  289 
  290 Return 1 iff this condition is always false.
  291 
  292 =cut
  293 
  294 sub false ($ )
  295 {
  296   my ($self) = @_;
  297   return $self->_has ('FALSE');
  298 }
  299 
  300 =item C<$cond-E<gt>true>
  301 
  302 Return 1 iff this condition is always true.
  303 
  304 =cut
  305 
  306 sub true ($ )
  307 {
  308   my ($self) = @_;
  309   return 0 == keys %{$self->{'hash'}};
  310 }
  311 
  312 =item C<$cond-E<gt>string>
  313 
  314 Build a string which denotes the condition.
  315 
  316 For instance using the C<$cond> definition from L<SYNOPSYS>,
  317 C<$cond-E<gt>string> will return C<"COND1_TRUE COND2_FALSE">.
  318 
  319 =cut
  320 
  321 sub string ($ )
  322 {
  323   my ($self) = @_;
  324 
  325   return $self->{'string'} if defined $self->{'string'};
  326 
  327   my $res = '';
  328   if ($self->false)
  329     {
  330       $res = 'FALSE';
  331     }
  332   else
  333     {
  334       $res = join (' ', $self->conds);
  335     }
  336   $self->{'string'} = $res;
  337   return $res;
  338 }
  339 
  340 =item C<$cond-E<gt>human>
  341 
  342 Build a human readable string which denotes the condition.
  343 
  344 For instance using the C<$cond> definition from L<SYNOPSYS>,
  345 C<$cond-E<gt>string> will return C<"COND1 and !COND2">.
  346 
  347 =cut
  348 
  349 sub _to_human ($ )
  350 {
  351   my ($s) = @_;
  352   if ($s =~ /^(.*)_(TRUE|FALSE)$/)
  353     {
  354       return (($2 eq 'FALSE') ? '!' : '') . $1;
  355     }
  356   else
  357     {
  358       return $s;
  359     }
  360 }
  361 
  362 sub human ($ )
  363 {
  364   my ($self) = @_;
  365 
  366   return $self->{'human'} if defined $self->{'human'};
  367 
  368   my $res = '';
  369   if ($self->false)
  370     {
  371       $res = 'FALSE';
  372     }
  373   else
  374     {
  375       $res = join (' and ', map { _to_human $_ } $self->conds);
  376     }
  377   $self->{'human'} = $res;
  378   return $res;
  379 }
  380 
  381 =item C<$cond-E<gt>subst_string>
  382 
  383 Build a C<AC_SUBST>-style string for output in F<Makefile.in>.
  384 
  385 For instance using the C<$cond> definition from L<SYNOPSYS>,
  386 C<$cond-E<gt>subst_string> will return C<"@COND1_TRUE@@COND2_FALSE@">.
  387 
  388 =cut
  389 
  390 sub subst_string ($ )
  391 {
  392   my ($self) = @_;
  393 
  394   return $self->{'subst_string'} if defined $self->{'subst_string'};
  395 
  396   my $res = '';
  397   if ($self->false)
  398     {
  399       $res = '#';
  400     }
  401   elsif (! $self->true)
  402     {
  403       $res = '@' . join ('@@', sort $self->conds) . '@';
  404     }
  405   $self->{'subst_string'} = $res;
  406   return $res;
  407 }
  408 
  409 =item C<$cond-E<gt>true_when ($when)>
  410 
  411 Return 1 iff C<$cond> is true when C<$when> is true.
  412 Return 0 otherwise.
  413 
  414 Using the definitions from L<SYNOPSYS>, C<$cond> is true
  415 when C<$both> is true, but the converse is wrong.
  416 
  417 =cut
  418 
  419 sub true_when ($$)
  420 {
  421   my ($self, $when) = @_;
  422 
  423   # Nothing is true when FALSE (not even FALSE itself, but it
  424   # shouldn't hurt if you decide to change that).
  425   return 0 if $self->false || $when->false;
  426 
  427   # If we are true, we stay true when $when is true :)
  428   return 1 if $self->true;
  429 
  430   # $SELF is true under $WHEN if each conditional component of $SELF
  431   # exists in $WHEN.
  432   foreach my $cond ($self->conds)
  433     {
  434       return 0 unless $when->_has ($cond);
  435     }
  436   return 1;
  437 }
  438 
  439 =item C<$cond-E<gt>redundant_wrt (@conds)>
  440 
  441 Return 1 iff C<$cond> is true for any condition in C<@conds>.
  442 If @conds is empty, return 1 iff C<$cond> is C<FALSE>.
  443 Return 0 otherwise.
  444 
  445 =cut
  446 
  447 sub redundant_wrt ($@)
  448 {
  449   my ($self, @conds) = @_;
  450 
  451   foreach my $cond (@conds)
  452     {
  453       return 1 if $self->true_when ($cond);
  454     }
  455   return $self->false;
  456 }
  457 
  458 =item C<$cond-E<gt>implies_any (@conds)>
  459 
  460 Return 1 iff C<$cond> implies any of the conditions in C<@conds>.
  461 Return 0 otherwise.
  462 
  463 =cut
  464 
  465 sub implies_any ($@)
  466 {
  467   my ($self, @conds) = @_;
  468 
  469   foreach my $cond (@conds)
  470     {
  471       return 1 if $cond->true_when ($self);
  472     }
  473   return 0;
  474 }
  475 
  476 =item C<$cond-E<gt>not>
  477 
  478 Return a negation of C<$cond> as a list of C<Condition>s.
  479 This list should be used to construct a C<DisjConditions>
  480 (we cannot return a C<DisjConditions> from C<Automake::Condition>,
  481 because that would make these two packages interdependent).
  482 
  483 =cut
  484 
  485 sub not ($ )
  486 {
  487   my ($self) = @_;
  488   return @{$self->{'not'}} if defined $self->{'not'};
  489   my @res =
  490     map { new Automake::Condition &conditional_negate ($_) } $self->conds;
  491   $self->{'not'} = [@res];
  492   return @res;
  493 }
  494 
  495 =item C<$cond-E<gt>multiply (@conds)>
  496 
  497 Assumption: C<@conds> represent a disjunction of conditions.
  498 
  499 Return the result of multiplying C<$cond> with that disjunction.
  500 The result will be a list of conditions suitable to construct a
  501 C<DisjConditions>.
  502 
  503 =cut
  504 
  505 sub multiply ($@)
  506 {
  507   my ($self, @set) = @_;
  508   my %res = ();
  509   for my $cond (@set)
  510     {
  511       my $ans = $self->merge ($cond);
  512       $res{$ans} = $ans;
  513     }
  514 
  515   # FALSE can always be removed from a disjunction.
  516   delete $res{FALSE};
  517 
  518   # Now, $self is a common factor of the remaining conditions.
  519   # If one of the conditions is $self, we can discard the rest.
  520   return ($self, ())
  521     if exists $res{$self};
  522 
  523   return (values %res);
  524 }
  525 
  526 =back
  527 
  528 =head2 Other helper functions
  529 
  530 =over 4
  531 
  532 =item C<TRUE>
  533 
  534 The C<"TRUE"> conditional.
  535 
  536 =item C<FALSE>
  537 
  538 The C<"FALSE"> conditional.
  539 
  540 =cut
  541 
  542 use constant TRUE => new Automake::Condition "TRUE";
  543 use constant FALSE => new Automake::Condition "FALSE";
  544 
  545 =item C<reduce_and (@conds)>
  546 
  547 Return a subset of @conds with the property that the conjunction of
  548 the subset is the same as the conjunction of @conds.  For example, if
  549 both C<COND1_TRUE COND2_TRUE> and C<COND1_TRUE> are in the list,
  550 discard the latter.  If the input list is empty, return C<(TRUE)>.
  551 
  552 =cut
  553 
  554 sub reduce_and (@)
  555 {
  556   my (@conds) = @_;
  557   my @ret = ();
  558   my $cond;
  559   while (@conds > 0)
  560     {
  561       $cond = shift @conds;
  562 
  563       # FALSE is absorbent.
  564       return FALSE
  565     if $cond == FALSE;
  566 
  567       if (! $cond->redundant_wrt (@ret, @conds))
  568     {
  569       push (@ret, $cond);
  570     }
  571     }
  572 
  573   return TRUE if @ret == 0;
  574   return @ret;
  575 }
  576 
  577 =item C<reduce_or (@conds)>
  578 
  579 Return a subset of @conds with the property that the disjunction of
  580 the subset is equivalent to the disjunction of @conds.  For example,
  581 if both C<COND1_TRUE COND2_TRUE> and C<COND1_TRUE> are in the list,
  582 discard the former.  If the input list is empty, return C<(FALSE)>.
  583 
  584 =cut
  585 
  586 sub reduce_or (@)
  587 {
  588   my (@conds) = @_;
  589   my @ret = ();
  590   my $cond;
  591   while (@conds > 0)
  592     {
  593       $cond = shift @conds;
  594 
  595       next
  596        if $cond == FALSE;
  597       return TRUE
  598        if $cond == TRUE;
  599 
  600       push (@ret, $cond)
  601        unless $cond->implies_any (@ret, @conds);
  602     }
  603 
  604   return FALSE if @ret == 0;
  605   return @ret;
  606 }
  607 
  608 =item C<conditional_negate ($condstr)>
  609 
  610 Negate a conditional string.
  611 
  612 =cut
  613 
  614 sub conditional_negate ($)
  615 {
  616   my ($cond) = @_;
  617 
  618   $cond =~ s/TRUE$/TRUEO/;
  619   $cond =~ s/FALSE$/TRUE/;
  620   $cond =~ s/TRUEO$/FALSE/;
  621 
  622   return $cond;
  623 }
  624 
  625 =back
  626 
  627 =head1 SEE ALSO
  628 
  629 L<Automake::DisjConditions>.
  630 
  631 =head1 HISTORY
  632 
  633 C<AM_CONDITIONAL>s and supporting code were added to Automake 1.1o by
  634 Ian Lance Taylor <ian@cygnus.org> in 1997.  Since then it has been
  635 improved by Tom Tromey <tromey@redhat.com>, Richard Boulton
  636 <richard@tartarus.org>, Raja R Harinath <harinath@cs.umn.edu>,
  637 Akim Demaille <akim@epita.fr>, and  Alexandre Duret-Lutz <adl@gnu.org>.
  638 
  639 =cut
  640 
  641 1;