Merge allof object schemas for reading

source/JSONSchema-Core-Tests/JSONSchemaTests.class.st

@@ -5,6 +5,55 @@ Class {
 	#package : 'JSONSchema-Core-Tests'
 }
 
+{ #category : 'tests' }
+JSONSchemaTests >> testAllOfCompositionMergesRequiredAcrossBranches [
+	| definition schema |
+	definition := JSONSchemaDefinition new
+		allOf: {
+			(JSONSchemaDefinition new properties: { 'name' -> (JSONSchemaDefinition new typeString: 'string'; yourself) } asDictionary; required: #('name'); yourself).
+			(JSONSchemaDefinition new properties: { 'id' -> (JSONSchemaDefinition new typeString: 'integer'; yourself) } asDictionary; required: #('id'); yourself) };
+		yourself.
+	schema := definition asJSONSchema.
+	self should: [ schema readString: '{"name":"Rex"}' ] raise: JSONTypeError
+]
+
+{ #category : 'tests' }
+JSONSchemaTests >> testAllOfCompositionOfObjectSchemasMergesPropertiesForReading [
+	"A bare allOf of object-shaped branches (no direct type/properties keyword) resolves
+	to JSONSchemaAnyObject via #asJSONSchema since nothing sets schemaClass for a bare
+	allOf - a real-world 'extends' pattern (e.g. OpenAPI's Pet = allOf[NewPet, {id}]).
+	Reading against it must merge all branches' properties, not raw-passthrough."
+	| definition schema result |
+	definition := JSONSchemaDefinition new
+		allOf: {
+			(JSONSchemaDefinition new properties: { 'name' -> (JSONSchemaDefinition new typeString: 'string'; yourself) } asDictionary; yourself).
+			(JSONSchemaDefinition new properties: { 'id' -> (JSONSchemaDefinition new typeString: 'integer'; yourself) } asDictionary; yourself) };
+		yourself.
+	schema := definition asJSONSchema.
+	self assert: schema class equals: JSONSchemaAnyObject.
+	result := schema readString: '{"id":42,"name":"Rex"}'.
+	self assert: result class equals: NeoJSONObject.
+	self assert: result id equals: 42.
+	self assert: result name equals: 'Rex'
+]
+
+{ #category : 'tests' }
+JSONSchemaTests >> testAllOfCompositionWithNonObjectBranchFallsBackToPassthrough [
+	"Not every allOf is an object composition (e.g. mixing an object schema with a bare
+	string schema has no sensible single merged reading target) - must stay a raw
+	passthrough rather than guess, exactly like before this fix."
+	| definition schema result |
+	definition := JSONSchemaDefinition new
+		allOf: {
+			(JSONSchemaDefinition new properties: { 'name' -> (JSONSchemaDefinition new typeString: 'string'; yourself) } asDictionary; yourself).
+			(JSONSchemaDefinition new typeString: 'string'; yourself) };
+		yourself.
+	schema := definition asJSONSchema.
+	self assert: schema mergedAllOfObjectSchema isNil.
+	result := schema readString: '{"name":"Rex"}'.
+	self assert: result class equals: Dictionary
+]
+
 { #category : 'tests' }
 JSONSchemaTests >> testMultipleConstraintsOnAnyObject [
 	| schema |
@@ -59,6 +108,19 @@ JSONSchemaTests >> testPatternWithNonCapturingGroupIsSupported [
 	self should: [ schema validate: '999' ] raise: JSONConstraintError
 ]
 
+{ #category : 'tests' }
+JSONSchemaTests >> testReadDoesNotApplyFormatConstraintToNonStringValues [
+	"Regression: JSONPrimitiveSchema>>read: used to call every attached constraint's
+	validate: unconditionally, without first checking validateType: (unlike JSONSchema>>
+	validate:, which correctly gates on it). JSONSchemaFormatConstraint>>validateType:
+	says format only applies to strings, but its validate: still got called on any value -
+	crashing for numeric formats like int32/int64 (format validateString: anInteger)."
+	| schema |
+	schema := JSONSchema fromString: '{"type":"integer","format":"int64"}'.
+	self shouldnt: [ schema readString: '42' ] raise: Error.
+	self assert: (schema readString: '42') equals: 42
+]
+
 { #category : 'tests' }
 JSONSchemaTests >> testSchemaReadArray [
 

source/JSONSchema-Core/JSONPrimitiveSchema.class.st

@@ -91,9 +91,16 @@ JSONPrimitiveSchema >> nullable: aBoolean [
 
 { #category : 'reading' }
 JSONPrimitiveSchema >> read: anObject [
+	"Gate constraint validation by validateType: (matching JSONSchema>>validate:'s own
+	pattern) instead of calling every constraint unconditionally - e.g.
+	JSONSchemaFormatConstraint>>validateType: says format only applies to strings, but
+	an unconditional validate: still reached it for any value, crashing for numeric
+	formats like int32/int64 (format validateString: anInteger)."
 	| value |
 	value := self readFormatted: anObject.
-	self constraints do: [ :each | each validate: value ].
+	self constraints
+		select: [ :constraint | constraint validateType: value ]
+		thenDo: [ :constraint | constraint validate: value ].
 	^ value
 ]
 

source/JSONSchema-Core/JSONSchemaAnyObject.class.st

@@ -1,42 +1,99 @@
 Class {
 	#name : 'JSONSchemaAnyObject',
 	#superclass : 'JSONSchemaBasicObject',
+	#instVars : [
+		'mergedAllOfObject'
+	],
 	#category : 'JSONSchema-Core-Model',
 	#package : 'JSONSchema-Core',
 	#tag : 'Model'
 }
 
 { #category : 'instance creation' }
-JSONSchemaAnyObject class >> typeName [ 
+JSONSchemaAnyObject class >> typeName [
 	^ #any
 ]
 
 { #category : 'visiting' }
-JSONSchemaAnyObject >> acceptJSONSchema: aVisitor [ 
-	^ aVisitor visitAnyObject: self 
+JSONSchemaAnyObject >> acceptJSONSchema: aVisitor [
+	^ aVisitor visitAnyObject: self
+]
+
+{ #category : 'allOf reading' }
+JSONSchemaAnyObject >> allOfConstraint [
+	^ self constraints detect: [ :c | c isKindOf: JSONSchemaAllOfConstraint ] ifNone: [ nil ]
+]
+
+{ #category : 'allOf reading' }
+JSONSchemaAnyObject >> mergeObjectSchemas: schemas [
+	"Merges properties (union - later branches win on key conflicts), required (union),
+	additionalProperties (false wins if any branch forbids extras, default true otherwise),
+	and instanceClass (first non-default one found) across several object schemas into one
+	real JSONSchemaObject, so reading gets real per-property type coercion."
+	| merged mergedProperties mergedRequired |
+	merged := JSONSchemaObject new.
+	mergedProperties := Dictionary new.
+	mergedRequired := OrderedCollection new.
+	schemas do: [ :schema |
+		schema properties ifNotNil: [ mergedProperties addAll: schema properties ].
+		schema required ifNotNil: [ mergedRequired addAll: schema required ].
+		(schema additionalProperties isKindOf: JSONSchemaBooleanFalse) ifTrue: [
+			merged additionalProperties: schema additionalProperties ].
+		(schema instanceClass ~~ schema defaultInstanceClass) ifTrue: [
+			merged instanceClass: schema instanceClass ] ].
+	merged properties: mergedProperties.
+	merged required: mergedRequired asArray.
+	^ merged
+]
+
+{ #category : 'allOf reading' }
+JSONSchemaAnyObject >> mergedAllOfObjectSchema [
+	"If this schema resolves from a bare allOf composition of only object-shaped branches
+	(the common 'extends' pattern, e.g. Pet = allOf[NewPet, {id}] - #asJSONSchema never
+	sets schemaClass for a bare allOf, so it degrades to JSONSchemaAnyObject), build and
+	cache a real JSONSchemaObject merging all branches so reading gets real per-property
+	type coercion instead of a raw passthrough. Answers nil when allOf is absent or any
+	branch is not object-shaped (a mixed/primitive allOf has no sensible single merged
+	reading target, and is left as the existing raw passthrough)."
+	| constraint resolvedBranches |
+	mergedAllOfObject ifNotNil: [ ^ mergedAllOfObject ].
+	constraint := self allOfConstraint.
+	constraint ifNil: [ ^ nil ].
+	resolvedBranches := constraint allOf collect: [ :definition | constraint resolveVisitor visitSchemaSpec: definition ].
+	(resolvedBranches allSatisfy: [ :schema | schema isKindOf: JSONSchemaObject ]) ifFalse: [ ^ nil ].
+	^ mergedAllOfObject := self mergeObjectSchemas: resolvedBranches
 ]
 
 { #category : 'reading-primitive data' }
 JSONSchemaAnyObject >> read: anObject [
-	^ anObject
+	"Delegate to a merged object schema for a bare allOf-of-objects composition (see
+	#mergedAllOfObjectSchema); otherwise unchanged - a genuine any/no-type schema."
+	| merged |
+	merged := self mergedAllOfObjectSchema.
+	^ merged ifNotNil: [ merged read: anObject ] ifNil: [ anObject ]
 ]
 
 { #category : 'reading' }
 JSONSchemaAnyObject >> read: string object: object [
 	| json |
 	json := (NeoJSONReader on: string readStream) next .
-	json isDictionary ifFalse: [ 
+	json isDictionary ifFalse: [
 		JSONTypeError signal: 'json type is not object' ].
-	json keysAndValuesDo: [ :key :value | 
-		object 
-			jsonSchemaAt: key asSymbol 
+	json keysAndValuesDo: [ :key :value |
+		object
+			jsonSchemaAt: key asSymbol
 			put: value ].
 	^ object
 ]
 
 { #category : 'reading' }
-JSONSchemaAnyObject >> readUsing: aReader [ 
-	^ aReader next
+JSONSchemaAnyObject >> readUsing: aReader [
+	"Delegate to a merged object schema for a bare allOf-of-objects composition (see
+	#mergedAllOfObjectSchema) so reading gets real per-property type coercion instead of
+	a raw passthrough; otherwise unchanged - a genuine any/no-type schema."
+	| merged |
+	merged := self mergedAllOfObjectSchema.
+	^ merged ifNotNil: [ merged readUsing: aReader ] ifNil: [ aReader next ]
 ]
 
 { #category : 'writing' }
@@ -46,6 +103,6 @@ JSONSchemaAnyObject >> write: anObject [
 ]
 
 { #category : 'writing' }
-JSONSchemaAnyObject >> write: anObject on: aWriter [ 
+JSONSchemaAnyObject >> write: anObject on: aWriter [
 	aWriter nextPut: anObject
 ]