]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Implement support for Is_Link_Once flag on entities
authorEric Botcazou <ebotcazou@adacore.com>
Mon, 25 Aug 2025 20:45:47 +0000 (22:45 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Fri, 19 Sep 2025 09:26:11 +0000 (11:26 +0200)
gcc/ada/ChangeLog:

* gcc-interface/gigi.h (create_var_decl): Add LINKONCE_FLAG boolean
parameter.
(create_subprog_decl): Likewise.
* gcc-interface/decl.cc (gnat_to_gnu_entity): Adjust calls to
create_var_decl and create_subprog_decl.
(elaborate_expression_1): Likewise.
* gcc-interface/trans.cc (gigi): Likewise.
(build_raise_check): Likewise.
(Subprogram_Body_to_gnu): Likewise.
(create_temporary): Likewise.
(Exception_Handler_to_gnu): Likewise.
(Compilation_Unit_to_gnu): Likewise.
(gnat_to_gnu): Likewise.
(use_alias_for_thunk_p): Return false for a one-only target.
* gcc-interface/utils.cc (maybe_pad_type): Adjust call to
create_var_decl.
(create_var_decl): Add LINKONCE_FLAG boolean parameter.
(create_subprog_decl): Likewise.

gcc/ada/gcc-interface/decl.cc
gcc/ada/gcc-interface/gigi.h
gcc/ada/gcc-interface/trans.cc
gcc/ada/gcc-interface/utils.cc

index 8dbc72e3d5ffd289b48adf892a83dcccc4a44bab..9ade3fd8c4e9719b9f85a294e9504b6f63923ac2 100644 (file)
@@ -648,7 +648,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        /* Build a CONST_DECL for debugging purposes exclusively.  */
        gnu_decl
          = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
-                            gnu_expr, true, Is_Public (gnat_entity),
+                            gnu_expr, true,
+                            Is_Public (gnat_entity),
+                            Is_Link_Once (gnat_entity),
                             false, false, false, artificial_p,
                             debug_info_p, NULL, gnat_entity);
       }
@@ -1196,6 +1198,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                    create_var_decl (gnu_entity_name, NULL_TREE,
                                     TREE_TYPE (gnu_expr), gnu_expr,
                                     const_flag, Is_Public (gnat_entity),
+                                    Is_Link_Once (gnat_entity),
                                     imported_p, static_flag, volatile_flag,
                                     artificial_p, debug_info_p, attr_list,
                                     gnat_entity, false);
@@ -1518,7 +1521,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
            tree gnu_new_var
              = create_var_decl (create_concat_name (gnat_entity, "ALIGN"),
                                 NULL_TREE, gnu_new_type, NULL_TREE,
-                                false, false, false, false, false,
+                                false, false, false, false, false, false,
                                 true, debug_info_p && definition, NULL,
                                 gnat_entity);
 
@@ -1580,8 +1583,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                   = create_var_decl (concat_name (gnu_entity_name, "UNC"),
                                      NULL_TREE, gnu_type, gnu_expr,
                                      const_flag, Is_Public (gnat_entity),
-                                     imported_p || !definition, static_flag,
-                                     volatile_flag, true,
+                                     Is_Link_Once (gnat_entity),
+                                     imported_p || !definition,
+                                     static_flag, volatile_flag, true,
                                      debug_info_p && definition,
                                      NULL, gnat_entity);
                gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_unc_var);
@@ -1627,8 +1631,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        gnu_decl
          = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
                             gnu_expr, const_flag, Is_Public (gnat_entity),
-                            imported_p || !definition, static_flag,
-                            volatile_flag, artificial_p,
+                            Is_Link_Once (gnat_entity),
+                            imported_p || !definition,
+                            static_flag, volatile_flag, artificial_p,
                             debug_info_p && definition, attr_list,
                             gnat_entity);
        DECL_BY_REF_P (gnu_decl) = used_by_ref;
@@ -1675,6 +1680,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
            tree gnu_corr_var
              = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
                                 gnu_expr, true, Is_Public (gnat_entity),
+                                Is_Link_Once (gnat_entity),
                                 !definition, static_flag, volatile_flag,
                                 artificial_p, debug_info_p && definition,
                                 attr_list, gnat_entity, false);
@@ -1780,7 +1786,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
              tree gnu_literal
                = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
                                   gnu_type, gnu_value, true, false, false,
-                                  false, false, artificial_p, false,
+                                  false, false, false, artificial_p, false,
                                   NULL, gnat_literal);
              save_gnu_tree (gnat_literal, gnu_literal, false);
              gnu_list
@@ -3749,7 +3755,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                      = create_var_decl (create_concat_name (gnat_entity,
                                                             "XVZ"),
                                         NULL_TREE, sizetype, gnu_size_unit,
-                                        true, false, false, false, false,
+                                        true, false, false, false, false, false,
                                         true, true, NULL, gnat_entity, false);
                }
 
@@ -4295,8 +4301,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
            gnu_decl
              = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
                                 gnu_address, false, Is_Public (gnat_entity),
-                                extern_flag, false, false, artificial_p,
-                                debug_info_p, NULL, gnat_entity);
+                                Is_Link_Once (gnat_entity), extern_flag,
+                                false, false, artificial_p, debug_info_p,
+                                NULL, gnat_entity);
            DECL_BY_REF_P (gnu_decl) = 1;
          }
 
@@ -4325,6 +4332,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                = create_subprog_decl (gnu_entity_name, gnu_ext_name,
                                       gnu_type, gnu_param_list, inline_status,
                                       Is_Public (gnat_entity) || imported_p,
+                                      Is_Link_Once (gnat_entity),
                                       extern_flag, artificial_p, debug_info_p,
                                       definition && imported_p, attr_list,
                                       gnat_entity);
@@ -7557,8 +7565,7 @@ static tree
 elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
                        bool definition, bool need_for_debug)
 {
-  const bool expr_public_p = Is_Public (gnat_entity);
-  const bool expr_global_p = expr_public_p || global_bindings_p ();
+  const bool expr_global_p = Is_Public (gnat_entity) || global_bindings_p ();
   bool expr_variable_p, use_variable;
 
   /* If GNU_EXPR contains a placeholder, just return it.  We rely on the fact
@@ -7608,7 +7615,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
   if (need_for_debug
       && gnat_encodings != DWARF_GNAT_ENCODINGS_ALL
       && (TREE_CONSTANT (gnu_expr)
-         || (!expr_public_p
+         || (!Is_Public (gnat_entity)
              && DECL_P (gnu_expr)
              && !DECL_IGNORED_P (gnu_expr))))
     need_for_debug = false;
@@ -7627,7 +7634,8 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s,
       tree gnu_decl
        = create_var_decl (create_concat_name (gnat_entity, s), NULL_TREE,
                           TREE_TYPE (gnu_expr), gnu_expr, true,
-                          expr_public_p, !definition && expr_global_p,
+                          Is_Public (gnat_entity), Is_Link_Once (gnat_entity),
+                          !definition && expr_global_p,
                           expr_global_p, false, true,
                           Needs_Debug_Info (gnat_entity),
                           NULL, gnat_entity, false);
index 442647c8aa71391e1485dad81f1d8d892c1a76ca..cb6a6a1a148bfa44ef9509c5b9801fde8ba82ba0 100644 (file)
@@ -679,6 +679,9 @@ extern tree create_type_decl (tree name, tree type, bool artificial_p,
    definition to be made visible outside of the current compilation unit, for
    instance variable definitions in a package specification.
 
+   LINKONCE_FLAG is true if the entity can be defined in multiple compilation
+   units without generating a linker error.
+
    EXTERN_FLAG is true when processing an external variable declaration (as
    opposed to a definition: no storage is to be allocated for the variable).
 
@@ -696,8 +699,8 @@ extern tree create_type_decl (tree name, tree type, bool artificial_p,
    GNAT_NODE is used for the position of the decl.  */
 extern tree create_var_decl (tree name, tree asm_name, tree type, tree init,
                             bool const_flag, bool public_flag,
-                            bool extern_flag, bool static_flag,
-                            bool volatile_flag,
+                            bool linkonce_flag, bool extern_flag,
+                            bool static_flag, bool volatile_flag,
                             bool artificial_p, bool debug_info_p,
                             struct attrib *attr_list, Node_Id gnat_node,
                             bool const_decl_allowed_p = true);
@@ -730,6 +733,9 @@ extern tree create_label_decl (tree name, Node_Id gnat_node);
    PUBLIC_FLAG is true if this is for a reference to a public entity or for a
    definition to be made visible outside of the current compilation unit.
 
+   LINKONCE_FLAG is true if the entity can be defined in multiple compilation
+   units without generating a linker error.
+
    EXTERN_FLAG is true when processing an external subprogram declaration.
 
    ARTIFICIAL_P is true if the subprogram was generated by the compiler.
@@ -744,10 +750,11 @@ extern tree create_label_decl (tree name, Node_Id gnat_node);
 extern tree create_subprog_decl (tree name, tree asm_name, tree type,
                                 tree param_decl_list,
                                 enum inline_status_t inline_status,
-                                bool public_flag, bool extern_flag,
-                                bool artificial_p, bool debug_info_p,
-                                bool definition, struct attrib *attr_list,
-                                Node_Id gnat_node);
+                                bool public_flag, bool linkonce_flag,
+                                bool extern_flag, bool artificial_p,
+                                bool debug_info_p, bool definition,
+                                struct attrib *attr_list = NULL,
+                                Node_Id gnat_node = Empty);
 
 /* Given a subprogram declaration DECL, its assembler name and its type,
    finish constructing the subprogram declaration from ASM_NAME and TYPE.  */
index cf1a290e95ffe01e8ed6defd8453d4e5982d7bad..e80002e31113e7beb3ffcae6c9048b6da8d8b5bc 100644 (file)
@@ -427,14 +427,14 @@ gigi (Node_Id gnat_root,
   gcc_assert (t == boolean_false_node);
   t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
                       boolean_type_node, t, true, false, false, false, false,
-                      true, false, NULL, gnat_literal);
+                      false, true, false, NULL, gnat_literal);
   save_gnu_tree (gnat_literal, t, false);
   gnat_literal = Next_Literal (gnat_literal);
   t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node);
   gcc_assert (t == boolean_true_node);
   t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
                       boolean_type_node, t, true, false, false, false, false,
-                      true, false, NULL, gnat_literal);
+                      false, true, false, NULL, gnat_literal);
   save_gnu_tree (gnat_literal, t, false);
 
   /* Declare the building blocks of function nodes.  */
@@ -446,24 +446,24 @@ gigi (Node_Id gnat_root,
     = create_subprog_decl (get_identifier ("__gnat_malloc"), NULL_TREE,
                           build_function_type_list (ptr_type_node, sizetype,
                                                     NULL_TREE),
-                          NULL_TREE, is_default, true, true, true, false,
-                          false, NULL, Empty);
+                          NULL_TREE, is_default, true, false, true, true,
+                          false, false);
   DECL_IS_MALLOC (malloc_decl) = 1;
 
   free_decl
     = create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE,
                           build_function_type_list (void_type_node,
                                                     ptr_type_node, NULL_TREE),
-                          NULL_TREE, is_default, true, true, true, false,
-                          false, NULL, Empty);
+                          NULL_TREE, is_default, true, false, true, true,
+                          false, false);
 
   realloc_decl
     = create_subprog_decl (get_identifier ("__gnat_realloc"), NULL_TREE,
                           build_function_type_list (ptr_type_node,
                                                     ptr_type_node, sizetype,
                                                     NULL_TREE),
-                          NULL_TREE, is_default, true, true, true, false,
-                          false, NULL, Empty);
+                          NULL_TREE, is_default, true, false, true, true,
+                          false, false);
 
   /* This is used for 64-bit multiplication with overflow checking.  */
   tree int64_type = gnat_type_for_size (64, 0);
@@ -471,8 +471,8 @@ gigi (Node_Id gnat_root,
     = create_subprog_decl (get_identifier ("__gnat_mulv64"), NULL_TREE,
                           build_function_type_list (int64_type, int64_type,
                                                     int64_type, NULL_TREE),
-                          NULL_TREE, is_default, true, true, true, false,
-                          false, NULL, Empty);
+                          NULL_TREE, is_default, true, false, true, true,
+                          false, false);
   strub_make_callable (mulv64_decl);
 
   tree uint64_type = gnat_type_for_size (64, 1);
@@ -480,8 +480,8 @@ gigi (Node_Id gnat_root,
     = create_subprog_decl (get_identifier ("__gnat_uns_mulv64"), NULL_TREE,
                           build_function_type_list (uint64_type, uint64_type,
                                                     uint64_type, NULL_TREE),
-                          NULL_TREE, is_default, true, true, true, false,
-                          false, NULL, Empty);
+                          NULL_TREE, is_default, true, false, true, true,
+                          false, false);
   strub_make_callable (uns_mulv64_decl);
 
   if (Enable_128bit_Types)
@@ -493,8 +493,8 @@ gigi (Node_Id gnat_root,
                                                         int128_type,
                                                         int128_type,
                                                         NULL_TREE),
-                              NULL_TREE, is_default, true, true, true, false,
-                              false, NULL, Empty);
+                              NULL_TREE, is_default, true, false, true, true,
+                              false, false);
       strub_make_callable (mulv128_decl);
 
       tree uint128_type = gnat_type_for_size (128, 1);
@@ -504,8 +504,8 @@ gigi (Node_Id gnat_root,
                                                         uint128_type,
                                                         uint128_type,
                                                         NULL_TREE),
-                              NULL_TREE, is_default, true, true, true, false,
-                              false, NULL, Empty);
+                              NULL_TREE, is_default, true, false, true, true,
+                              false, false);
       strub_make_callable (uns_mulv128_decl);
     }
 
@@ -526,7 +526,7 @@ gigi (Node_Id gnat_root,
       (get_identifier ("__gnat_set_exception_parameter"), NULL_TREE,
        build_function_type_list (void_type_node, ptr_type_node, ptr_type_node,
                                 NULL_TREE),
-       NULL_TREE, is_default, true, true, true, false, false, NULL, Empty);
+       NULL_TREE, is_default, true, false, true, true, false, false);
 
   /* Hooks to call when entering/leaving an exception handler.  */
   ftype = build_function_type_list (ptr_type_node,
@@ -534,8 +534,7 @@ gigi (Node_Id gnat_root,
   begin_handler_decl
     = create_subprog_decl (get_identifier ("__gnat_begin_handler_v1"),
                           NULL_TREE, ftype, NULL_TREE,
-                          is_default, true, true, true, false, false, NULL,
-                          Empty);
+                          is_default, true, false, true, true, false, false);
   /* __gnat_begin_handler_v1 is not a dummy procedure, but we arrange
      for it not to throw.  */
   TREE_NOTHROW (begin_handler_decl) = 1;
@@ -546,23 +545,20 @@ gigi (Node_Id gnat_root,
   end_handler_decl
     = create_subprog_decl (get_identifier ("__gnat_end_handler_v1"), NULL_TREE,
                           ftype, NULL_TREE,
-                          is_default, true, true, true, false, false, NULL,
-                          Empty);
+                          is_default, true, false, true, true, false, false);
 
   ftype = build_function_type_list (void_type_node, ptr_type_node, NULL_TREE);
   unhandled_except_decl
     = create_subprog_decl (get_identifier ("__gnat_unhandled_except_handler"),
                           NULL_TREE, ftype, NULL_TREE,
-                          is_default, true, true, true, false, false, NULL,
-                          Empty);
+                          is_default, true, false, true, true, false, false);
 
   /* Indicate that it never returns.  */
   ftype = build_qualified_type (ftype, TYPE_QUAL_VOLATILE);
   reraise_zcx_decl
     = create_subprog_decl (get_identifier ("__gnat_reraise_zcx"), NULL_TREE,
                           ftype, NULL_TREE,
-                          is_default, true, true, true, false, false, NULL,
-                          Empty);
+                          is_default, true, false, true, true, false, false);
   set_call_expr_flags (reraise_zcx_decl, ECF_NORETURN | ECF_XTHROW);
 
   /* Dummy objects to materialize "others" and "all others" in the exception
@@ -572,21 +568,21 @@ gigi (Node_Id gnat_root,
     = create_var_decl (get_identifier ("OTHERS"),
                       get_identifier ("__gnat_others_value"),
                       char_type_node, NULL_TREE,
-                      true, false, true, false, false, true, false,
+                      true, false, false, true, false, false, true, false,
                       NULL, Empty);
 
   all_others_decl
     = create_var_decl (get_identifier ("ALL_OTHERS"),
                       get_identifier ("__gnat_all_others_value"),
                       char_type_node, NULL_TREE,
-                      true, false, true, false, false, true, false,
+                      true, false, false, true, false, false, true, false,
                       NULL, Empty);
 
   unhandled_others_decl
     = create_var_decl (get_identifier ("UNHANDLED_OTHERS"),
                       get_identifier ("__gnat_unhandled_others_value"),
                       char_type_node, NULL_TREE,
-                      true, false, true, false, false, true, false,
+                      true, false, false, true, false, false, true, false,
                       NULL, Empty);
 
   /* If in no exception handlers mode, all raise statements are redirected to
@@ -601,8 +597,7 @@ gigi (Node_Id gnat_root,
       tree decl
        = create_subprog_decl
          (get_identifier ("__gnat_last_chance_handler"), NULL_TREE, ftype,
-          NULL_TREE, is_default, true, true, true, false, false, NULL,
-          Empty);
+          NULL_TREE, is_default, true, false, true, true, false, false);
       for (i = 0; i < (int) ARRAY_SIZE (gnat_raise_decls); i++)
        gnat_raise_decls[i] = decl;
     }
@@ -764,8 +759,8 @@ build_raise_check (int check, enum exception_info_kind kind)
   ftype = build_qualified_type (ftype, TYPE_QUAL_VOLATILE);
   result
     = create_subprog_decl (get_identifier (Name_Buffer), NULL_TREE, ftype,
-                          NULL_TREE, is_default, true, true, true, false,
-                          false, NULL, Empty);
+                          NULL_TREE, is_default, true, false, true, true,
+                          false, false);
   strub_make_callable (result);
   set_call_expr_flags (result, ECF_NORETURN | ECF_XTHROW);
 
@@ -4054,7 +4049,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
          gnu_return_var
            = create_var_decl (get_identifier ("RETVAL"), NULL_TREE,
                               gnu_return_type, NULL_TREE,
-                              false, false, false, false, false,
+                              false, false, false, false, false, false,
                               true, false, NULL, gnat_subprog);
          TREE_VALUE (gnu_return_var_elmt) = gnu_return_var;
        }
@@ -4590,7 +4585,7 @@ create_temporary (const char *prefix, tree type)
   tree gnu_temp
     = create_var_decl (create_tmp_var_name (prefix), NULL_TREE,
                      type, NULL_TREE,
-                     false, false, false, false, false,
+                     false, false, false, false, false, false,
                      true, false, NULL, Empty);
   return gnu_temp;
 }
@@ -5873,7 +5868,7 @@ Exception_Handler_to_gnu (Node_Id gnat_node)
   tree exc_ptr
     = create_var_decl (get_identifier ("EXPTR"), NULL_TREE,
                       ptr_type_node, gnu_current_exc_ptr,
-                      true, false, false, false, false, true, true,
+                      true, false, false, false, false, false, true, true,
                       NULL, gnat_node);
 
   tree prev_gnu_incoming_exc_ptr = gnu_incoming_exc_ptr;
@@ -5888,7 +5883,7 @@ Exception_Handler_to_gnu (Node_Id gnat_node)
                       ptr_type_node,
                       build_call_n_expr (begin_handler_decl, 1,
                                          exc_ptr),
-                      true, false, false, false, false,
+                      true, false, false, false, false, false,
                       true, true, NULL, gnat_node);
 
   /* Declare and initialize the choice parameter, if present.  */
@@ -5938,7 +5933,7 @@ Exception_Handler_to_gnu (Node_Id gnat_node)
                           build_call_expr (builtin_decl_explicit
                                            (BUILT_IN_EH_POINTER),
                                            1, integer_zero_node),
-                          true, false, false, false, false,
+                          true, false, false, false, false, false,
                           true, true, NULL, gnat_node);
 
       /* CODE: __gnat_end_handler_v1 (EXPTR, EXCLN, EXPRP);  */
@@ -5984,7 +5979,7 @@ Compilation_Unit_to_gnu (Node_Id gnat_node)
     = create_subprog_decl
       (create_concat_name (gnat_unit_entity, body_p ? "elabb" : "elabs"),
        NULL_TREE, void_ftype, NULL_TREE,
-       is_default, true, false, false, true, false, NULL, gnat_unit);
+       is_default, true, false, false, false, true, false, NULL, gnat_unit);
   struct elab_info *info;
 
   vec_safe_push (gnu_elab_proc_stack, gnu_elab_proc_decl);
@@ -7217,7 +7212,7 @@ gnat_to_gnu (Node_Id gnat_node)
                                 (Entity (Prefix (gnat_node)),
                                  attr == Attr_Elab_Body ? "elabb" : "elabs"),
                                 NULL_TREE, void_ftype, NULL_TREE, is_default,
-                                true, true, true, true, false, NULL,
+                                true, false, true, true, true, false, NULL,
                                 gnat_node);
 
        gnu_result = Attribute_to_gnu (gnat_node, &gnu_result_type, attr);
@@ -11332,7 +11327,7 @@ static bool
 use_alias_for_thunk_p (tree target)
 {
   /* We cannot generate a local call in this case.  */
-  if (DECL_EXTERNAL (target))
+  if (DECL_EXTERNAL (target) || DECL_ONE_ONLY (target))
     return false;
 
   /* The call is already local in this case.  */
index b311232691fbb17df5c3ce4124a3035b038df7aa..eff58b1075195aacd4c4f65b616b25c7d6149dd0 100644 (file)
@@ -1850,7 +1850,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
             is a compilation artifact.  */
          size_unit
            = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
-                             size_unit, true, global_bindings_p (),
+                             size_unit, true, global_bindings_p (), false,
                              !definition && global_bindings_p (), false,
                              false, true, true, NULL, gnat_entity, false);
          TYPE_SIZE_UNIT (record) = size_unit;
@@ -2995,6 +2995,9 @@ create_type_decl (tree name, tree type, bool artificial_p, bool debug_info_p,
    definition to be made visible outside of the current compilation unit, for
    instance variable definitions in a package specification.
 
+   LINKONCE_FLAG is true if the entity can be defined in multiple compilation
+   units without generating a linker error.
+
    EXTERN_FLAG is true when processing an external variable declaration (as
    opposed to a definition: no storage is to be allocated for the variable).
 
@@ -3013,10 +3016,11 @@ create_type_decl (tree name, tree type, bool artificial_p, bool debug_info_p,
 
 tree
 create_var_decl (tree name, tree asm_name, tree type, tree init,
-                bool const_flag, bool public_flag, bool extern_flag,
-                bool static_flag, bool volatile_flag, bool artificial_p,
-                bool debug_info_p, struct attrib *attr_list,
-                Node_Id gnat_node, bool const_decl_allowed_p)
+                bool const_flag, bool public_flag, bool linkonce_flag,
+                bool extern_flag, bool static_flag, bool volatile_flag,
+                bool artificial_p, bool debug_info_p,
+                struct attrib *attr_list, Node_Id gnat_node,
+                bool const_decl_allowed_p)
 {
   /* Whether the object has static storage duration, either explicitly or by
      virtue of being declared at the global level.  */
@@ -3047,9 +3051,8 @@ create_var_decl (tree name, tree asm_name, tree type, tree init,
      and may be used for scalars in general but not for aggregates.  */
   tree var_decl
     = build_decl (input_location,
-                 (constant_p
-                  && const_decl_allowed_p
-                  && !AGGREGATE_TYPE_P (type) ? CONST_DECL : VAR_DECL),
+                 constant_p && const_decl_allowed_p && !AGGREGATE_TYPE_P (type)
+                 ? CONST_DECL : VAR_DECL,
                  name, type);
 
   /* Detect constants created by the front-end to hold 'reference to function
@@ -3131,6 +3134,13 @@ create_var_decl (tree name, tree asm_name, tree type, tree init,
             != null_pointer_node))
     DECL_IGNORED_P (var_decl) = 1;
 
+  /* Note that make_decl_one_only forces TREE_PUBLIC on the DECL.  */
+  if (linkonce_flag && VAR_P (var_decl))
+    {
+      gcc_checking_assert (TREE_PUBLIC (var_decl));
+      make_decl_one_only (var_decl, var_decl);
+    }
+
   /* ??? Some attributes cannot be applied to CONST_DECLs.  */
   if (VAR_P (var_decl))
     process_attributes (&var_decl, &attr_list, true, gnat_node);
@@ -3667,6 +3677,9 @@ create_label_decl (tree name, Node_Id gnat_node)
    PUBLIC_FLAG is true if this is for a reference to a public entity or for a
    definition to be made visible outside of the current compilation unit.
 
+   LINKONCE_FLAG is true if the entity can be defined in multiple compilation
+   units without generating a linker error.
+
    EXTERN_FLAG is true when processing an external subprogram declaration.
 
    ARTIFICIAL_P is true if the subprogram was generated by the compiler.
@@ -3682,9 +3695,9 @@ create_label_decl (tree name, Node_Id gnat_node)
 tree
 create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list,
                     enum inline_status_t inline_status, bool public_flag,
-                    bool extern_flag, bool artificial_p, bool debug_info_p,
-                    bool definition, struct attrib *attr_list,
-                    Node_Id gnat_node)
+                    bool linkonce_flag, bool extern_flag, bool artificial_p,
+                    bool debug_info_p, bool definition,
+                    struct attrib *attr_list, Node_Id gnat_node)
 {
   tree subprog_decl = build_decl (input_location, FUNCTION_DECL, name, type);
   DECL_ARGUMENTS (subprog_decl) = param_decl_list;
@@ -3737,6 +3750,13 @@ create_subprog_decl (tree name, tree asm_name, tree type, tree param_decl_list,
       gcc_unreachable ();
     }
 
+  /* Note that make_decl_one_only forces TREE_PUBLIC on the DECL.  */
+  if (linkonce_flag)
+    {
+      gcc_checking_assert (TREE_PUBLIC (subprog_decl));
+      make_decl_one_only (subprog_decl, subprog_decl);
+    }
+
   process_attributes (&subprog_decl, &attr_list, true, gnat_node);
 
   /* Once everything is processed, finish the subprogram declaration.  */