diff options
| -rw-r--r-- | src/ChangeLog | 9 | ||||
| -rw-r--r-- | src/doc/msgs/s2-us.msgs | 6 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 25 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 2 | ||||
| -rw-r--r-- | src/interp/i-eval.boot | 24 | ||||
| -rw-r--r-- | src/testsuite/interpreter/sf-2799773.input | 5 |
6 files changed, 61 insertions, 10 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 132b5c67..ab27ae25 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,14 @@ 2009-06-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + Fix SF/2799773 + * interp/c-util.boot (diagnoseUnknownType): Diagnose duplicate + fields in Record or Union, or duplicate constants in Enumeration. + * interp/i-eval.boot (checkRecordOrUnionFields): New. + (evaluateType): Use it. + * testsuite/interpreter/sf-2799773.input: New. + +2009-06-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + * algebra/kl.spad.pamphlet (name$Kernel): Remove. * algebra/d01weights.spad.pamphlet: Adjust. * algebra/fs2expxp.spad.pamphlet: Likewise. diff --git a/src/doc/msgs/s2-us.msgs b/src/doc/msgs/s2-us.msgs index d3e2ca8c..9f6cc921 100644 --- a/src/doc/msgs/s2-us.msgs +++ b/src/doc/msgs/s2-us.msgs @@ -355,6 +355,12 @@ S2IL0028 S2IL0029 No .ao files were found when %2 was unarchived into directory %1. The file %2 was not compiled. +S2IL0030 + The Record or Union field %1bp is specified more than once. +S2IL0031 + Enumeration constants must be identifiers. +S2IL0032 + You cannot repeat enumeration constants, e.g. %1pb S2IM0001 The previous declaration of %1b as %2bp is incompatible with its new use as a function. If you do not want the old value, issue %b )clear prop diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index d5e78051..e8e11234 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -40,7 +40,7 @@ module c_-util where clearReplacement: %Symbol -> %Thing replaceSimpleFunctions: %Form -> %Form foldExportedFunctionReferences: %List -> %List - diagnoseUknownType: (%Mode,%Env) -> %Form + diagnoseUnknownType: (%Mode,%Env) -> %Form --% @@ -432,7 +432,7 @@ isKnownCategory(c,e) == --TRACE isKnownCategory ++ Returns non-nil if `t' is a known type in the environement `e'. -diagnoseUknownType(t,e) == +diagnoseUnknownType(t,e) == atom t => t in '($ constant) => t t' := assoc(t,getDomainsInScope e) => t' @@ -445,21 +445,34 @@ diagnoseUknownType(t,e) == '"is not known to name a type"],nil) [ctor,:args] := t ctor = "Mapping" => - for t' in args repeat diagnoseUknownType(t',e) + for t' in args repeat diagnoseUnknownType(t',e) t ctor = "Record" => - for [.,.,t'] in args repeat diagnoseUknownType(t',e) + for [[.,n,t'],:fields] in tails args repeat + diagnoseUnknownType(t',e) + for [.,=n,.] in fields repeat + stackSemanticError(['"Field", :bright n, + '"declared more than once."], nil) t ctor = "Union" => if args is [[":",:.],:.] then - for [.,.,t'] in args repeat diagnoseUknownType(t',e) + for [[.,n,t'],:fields] in tails args repeat + diagnoseUnknownType(t',e) + for [.,=n,.] in fields repeat + stackSemanticError(['"Field", :bright n, + '"declared more than once."], nil) else - for t' in args repeat diagnoseUknownType(t',e) + for t' in args repeat diagnoseUnknownType(t',e) t ctor = "Enumeration" => for t' in args repeat IDENTP t' => nil stackSemanticError(['"Enumerators must be symbols."], nil) + -- Make sure we don't have repeated symbolic values + for [sym,:syms] in tails args repeat + MEMQ(sym,syms) => + stackSemanticError(['"Symbolic value ", :bright sym, + '"is listed twice"], nil) t ctor = "[||]" => t ctor in $BuiltinConstructorNames => t -- ??? check Record and Union fields diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index f14ba01d..817517ef 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1849,7 +1849,7 @@ modeEqualSubst(m1,m,e) == compCat(form is [functorName,:argl],m,e) == fn:= GETL(functorName,"makeFunctionList") or return nil - diagnoseUknownType(form,e) + diagnoseUnknownType(form,e) [funList,e]:= FUNCALL(fn,form,form,e) catForm:= ["Join",'(SetCategory),["CATEGORY","domain",: diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 91499994..527a36c3 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -1,5 +1,7 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -120,6 +122,13 @@ evaluateType0 form == IDENTP form and (constructor? form or form in $BuiltinConstructorNames) => throwEvalTypeMsg("S2IE0003",[form,form]) +++ Check for duplicate fields in a Union or Record domain form. +checkRecordOrUnionFields body == + for [[.,n,.],:fields] in tails body repeat + for field in fields | field is [.,=n,.] repeat + throwKeyedMsg("S2IL0030",[n]) + body + evaluateType form == -- Takes a parsed, unabbreviated type and evaluates it, replacing -- type valued variables with their values, and calling bottomUp @@ -142,11 +151,20 @@ evaluateType form == [op,:[evaluateType arg for arg in argl]] op='Union => argl and first argl is [x,.,.] and member(x,'(_: Declare)) => - [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]] + [op, : checkRecordOrUnionFields + [[":",sel,evaluateType type] for ['_:,sel,type] in argl]] [op,:[evaluateType arg for arg in argl]] op='Record => - [op,:[['_:,sel,evaluateType type] for ['_:,sel,type] in argl]] - op='Enumeration => form + [op, : checkRecordOrUnionFields + [['_:,sel,evaluateType type] for ['_:,sel,type] in argl]] + op='Enumeration => + -- only symbols, and they must not be repeated. + for arg in argl repeat + IDENTP arg => nil + throwKeyedMsg("S2IL0031",nil) + for [arg,:args] in tails argl repeat + MEMQ(arg,args) => throwKeyedMsg("S2IL0032",[arg]) + form evaluateFormAsType form IDENTP form and niladicConstructorFromDB form => evaluateType [form] IDENTP form and (constructor? form or form in $BuiltinConstructorNames) => diff --git a/src/testsuite/interpreter/sf-2799773.input b/src/testsuite/interpreter/sf-2799773.input new file mode 100644 index 00000000..c22b4dfa --- /dev/null +++ b/src/testsuite/interpreter/sf-2799773.input @@ -0,0 +1,5 @@ +-- Contributed by Yue Li +-- Issue: OpenAxiom failed to check for duplicate fields +-- in Record or Unions. + +r : Record(a: Integer, a: Symbol) := [1, 's] --- expectred: error |