[WWcvs] pg: Produce error messages if a letter is used more than once in an ordering.

[dpvc v. a. <we...@ma...>]

Log Message:
-----------
Produce error messages if a letter is used more than once in an ordering.

Modified Files:
--------------
    pg/macros:
        contextOrdering.pl

Revision Data
-------------
Index: contextOrdering.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextOrdering.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lmacros/contextOrdering.pl -Lmacros/contextOrdering.pl -u -r1.2 -r1.3
--- macros/contextOrdering.pl
+++ macros/contextOrdering.pl
@@ -91,10 +91,13 @@
   $context->functions->clear();
   $context->strings->clear();
   $context->operators->add(
-   '>' => {precedence => 1.5, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP'},
-   '=' => {precedence => 1.7, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP'},
+   '>' => {precedence => 1.5, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP::ordering'},
+   '=' => {precedence => 1.7, associativity => 'left', type => 'bin', class => 'context::Ordering::BOP::ordering'},
   );
-  $context->{value}{String} = "context::Ordering::Value::String";
+  $context->{parser}{String}  = "context::Ordering::Parser::String";
+  $context->{parser}{Value}   = "context::Ordering::Parser::Value";
+  $context->{parser}{BOP}     = "context::Ordering::Parser::BOP";
+  $context->{value}{String}   = "context::Ordering::Value::String";
   $context->{value}{Ordering} = "context::Ordering::Value::Ordering";
   $context->strings->add('='=>{hidden=>1},'>'=>{hidden=>1});
   $context->{error}{msg}{"Variable '%s' is not defined in this context"} = "'%s' is not defined in this context";
@@ -165,21 +168,29 @@
 #  nested List.
 #
 
-package context::Ordering::BOP;
+package context::Ordering::BOP::ordering;
 our @ISA = ('Parser::BOP');
 
 sub class {"Ordering"}
 
 sub isOrdering {
   my $self = shift; my $obj = shift; my $class = $obj->class;
-  return ($class eq 'Value' && $obj->{value}->class eq 'Ordering') ||
-         ($class eq 'Ordering') || $obj->{def}{isLetter};
+  return $class eq 'Ordering' || $obj->{def}{isLetter};
 }
 
 sub _check {
   my $self = shift;
-  return if $self->isOrdering($self->{lop}) && $self->isOrdering($self->{rop});
-  $self->Error("Operators of %s must be letters",$self->{bop});
+  $self->Error("Operators of %s must be letters",$self->{bop})
+    unless $self->isOrdering($self->{lop}) && $self->isOrdering($self->{rop});
+  $self->{letters} = $self->{lop}{letters}; # we modify {lop}{letters} this way, but that doesn't matter
+  foreach my $x (keys %{$self->{rop}{letters}}) {
+    if (defined($self->{letters}{$x})) {
+      $self->{ref} = $self->{rop}{letters}{$x};
+      $self->Error("Letters can appear only once in an ordering");
+    }
+    $self->{letters}{$x} = $self->{rop}{letters}{$x};
+  }
+  $self->{equation}{letters} = $self->{letters};  # removed by context::Ordering::Parser::BOP;
 }
 
 sub _eval {
@@ -197,6 +208,7 @@
   return $self->{lop}->TeX." ".$self->{bop}." ".$self->{rop}->TeX;
 }
 
+
 #############################################################
 #
 #  This is the Value object used to implement the list That represents
@@ -248,7 +260,7 @@
 #  the ordering)
 #
 sub cmp_equal {
-  my $self = shift;  my $ans = $_[0];
+  my $self = shift; my $ans = $_[0];
   $ans->{typeMatch} = $ans->{firstElement} = $self;
   $self = $ans->{correct_value} = Value::List->make($self);
   $ans->{student_value} = Value::List->make($ans->{student_value})
@@ -284,6 +296,71 @@
 
 #############################################################
 #
+#  Override Parser classes so that we can check for repeated letters
+#
+
+package context::Ordering::Parser::String;
+our @ISA = ('Parser::String');
+
+#
+#  Save the letters positional reference
+#
+sub new {
+  my $self = shift;
+  $self = $self->SUPER::new(@_);
+  $self->{letters}{$self->{value}} = $self->{ref} if $self->{def}{isLetter};
+  return $self;
+}
+
+#########################
+
+package context::Ordering::Parser::Value;
+our @ISA = ('Parser::Value');
+
+#
+#  Move letters to Value object
+#
+sub new {
+  my $self = shift;
+  $self = $self->SUPER::new(@_);
+  if (defined($self->{value}{letters})) {
+    $self->{letters} = $self->{value}{letters};
+    delete $self->{value}{letters};
+  }
+  return $self;
+}
+
+#
+#  Return Ordering class if the object is one
+#
+sub class {
+  my $self = shift;
+  return "Ordering" if $self->{value}->classMatch('Ordering');
+  return $self->SUPER::class;
+}
+
+#########################
+
+package context::Ordering::Parser::BOP;
+our @ISA = ('Parser::BOP');
+
+#
+#  If a BOP is constant and so reduced automatically we will lose the
+#  letters hash, so it is stored temporarily in the equation by _check(),
+#  and replaced here.  A hack, but that avoids adding letters to the
+#  Ordering object in eval() and having them remain there after parsing.
+#
+sub new {
+  my $self = shift;
+  $self = $self->SUPER::new(@_);
+  $self->{letters} = $self->{equation}{letters} unless defined $self->{letters} || $self->class ne 'Ordering';
+  delete $self->{equation}{letters};
+  return $self;
+}
+
+
+#############################################################
+#
 #  This overrides the cmp_equal method to make sure that
 #  Ordering lists are put into nested lists (since the
 #  underlying ordering is a list, we don't want the
@@ -300,3 +377,7 @@
     if Value::classMatch($ans->{student_value},'Ordering');
   return $self->SUPER::cmp_equal(@_);
 }
+
+#############################################################
+
+1;