aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog9
-rw-r--r--src/doc/msgs/s2-us.msgs6
-rw-r--r--src/interp/c-util.boot25
-rw-r--r--src/interp/compiler.boot2
-rw-r--r--src/interp/i-eval.boot24
-rw-r--r--src/testsuite/interpreter/sf-2799773.input5
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