From 0986e80068addc5c884d06580412ff2331436814 Mon Sep 17 00:00:00 2001
From: hornik <hornik@00db46b3-68df-0310-9c12-caf00c1e9a41>
Date: Mon, 5 Aug 2024 06:19:26 +0000
Subject: [PATCH] Tweaks.

git-svn-id: https://svn.r-project.org/R/trunk@86978 00db46b3-68df-0310-9c12-caf00c1e9a41
---
 src/library/utils/R/citation.R | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/src/library/utils/R/citation.R b/src/library/utils/R/citation.R
index 3a13422b770..976e2b2dada 100644
--- a/src/library/utils/R/citation.R
+++ b/src/library/utils/R/citation.R
@@ -197,6 +197,11 @@ person_field_names <-
 function(x, i, j)
 {
     y <- unclass(x)[i]
+    if(!all(ok <- lengths(y) > 0L)) {
+        warning(gettext("subscript out of bounds"),
+                domain = NA)
+        y <- y[ok]
+    }
     if(missing(j)) {
         class(y) <- class(x)
     } else {
@@ -229,7 +234,7 @@ function(x, i, j, value)
 {
     y <- unclass(x)
     if(missing(j))
-        y[i] <- as.person(value)
+        y[i] <- if(is.null(value)) NULL else as.person(value)
     else {
         j <- match.arg(j, person_field_names)
         s <- seq_along(x)
@@ -255,7 +260,7 @@ function(x, i, j, value)
     i <- s[[i]]
     y <- unclass(x)
     if(missing(j))
-        y[i] <- as.person(value)
+        y[i] <- if(is.null(value)) NULL else as.person(value)
     else {
         j <- match.arg(j, person_field_names)
         if(j == "role")
@@ -269,9 +274,12 @@ function(x, i, j, value)
 .person_elt_fld_gets <-
 function(x, j, v)
 {
-    x[[j]] <- if(.is_not_nonempty_text(v))
-                  NULL
-              else as.character(v)
+    x[j] <- list(if(.is_not_nonempty_text(v))
+                     NULL
+                 else as.character(v))
+    if(all(vapply(x, is.null, NA)))
+        stop(gettext("must have some non-empty fields"),
+             domain = NA)
     x
 }
         
@@ -769,7 +777,8 @@ function(x, i, j, drop = TRUE)
     i <- s[i]
     y <- unclass(x)[i]
     if(!all(ok <- lengths(y) > 0L)) {
-        warning("subscript out of bounds")
+        warning(gettext("subscript out of bounds"),
+                domain = NA)
         y <- y[ok]
     }
     if(missing(j)) {
@@ -813,7 +822,7 @@ function(x, i, j, value)
 {
     y <- unclass(x)
     if(missing(j)) {
-        y[i] <- as.bibentry(value)
+        y[i] <- if(is.null(value)) NULL else as.bibentry(value)
     } else {
         stopifnot(is.character(j),
                   length(j) == 1L)
@@ -839,7 +848,7 @@ function(x, i, j, value)
     i <- s[[i]]
     y <- unclass(x)    
     if(missing(j)) {
-        y[i] <- as.bibentry(value)
+        y[i] <- if(is.null(value)) NULL else as.bibentry(value)
     } else {
         stopifnot(is.character(j),
                   length(j) == 1L)