aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog24
-rw-r--r--gcc/ada/adadecode.c18
-rw-r--r--gcc/ada/errout.ads4
-rw-r--r--gcc/ada/freeze.adb118
-rw-r--r--gcc/ada/sem_ch10.adb4
-rw-r--r--gcc/ada/sem_prag.adb8
6 files changed, 140 insertions, 36 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a961439..2e90cfb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2012-01-23 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * freeze.adb (Check_Current_Instance): Issue an
+ error when the prefix of 'Unchecked_Access or 'Access does not
+ denote a legal aliased view of a type.
+ (Freeze_Record_Type): Do not halt the processing of record components
+ once the Has_Controlled_Component is set as this bypasses the remaining
+ checks.
+ (Is_Aliased_View_Of_Type): New routine.
+
+2012-01-23 Thomas Quinot <quinot@adacore.com>
+
+ * errout.ads, freeze.adb: Minor reformatting.
+
+2012-01-23 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch10.adb, sem_prag.adb: Remove redundant apostrophes in error
+ messages.
+
+2012-01-23 Olivier Hainque <hainque@adacore.com>
+
+ * adadecode.c (__gnat_decode): Deal with empty input early,
+ preventing potential erroneous memory access later on.
+
2012-01-21 Eric Botcazou <ebotcazou@adacore.com>
PR ada/46192
diff --git a/gcc/ada/adadecode.c b/gcc/ada/adadecode.c
index 1c48856..2569481 100644
--- a/gcc/ada/adadecode.c
+++ b/gcc/ada/adadecode.c
@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
- * Copyright (C) 2001-2011, Free Software Foundation, Inc. *
+ * Copyright (C) 2001-2012, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@@ -42,7 +42,7 @@
#include <stdio.h>
#include <ctype.h>
-#include "adaint.h"
+#include "adaint.h" /* for a macro version of xstrdup. */
#ifndef ISDIGIT
#define ISDIGIT(c) isdigit(c)
@@ -162,8 +162,20 @@ __gnat_decode (const char *coded_name, char *ada_name, int verbose)
int in_task = 0;
int body_nested = 0;
+ /* Deal with empty input early. This allows assuming non-null length
+ later on, simplifying coding. In principle, it should be our callers
+ business not to call here for empty inputs. It is easy enough to
+ allow it, however, and might allow simplifications upstream so is not
+ a bad thing per se. We need a guard in any case. */
+
+ if (*coded_name == '\0')
+ {
+ *ada_name = '\0';
+ return;
+ }
+
/* Check for library level subprogram. */
- if (has_prefix (coded_name, "_ada_"))
+ else if (has_prefix (coded_name, "_ada_"))
{
strcpy (ada_name, coded_name + 5);
lib_subprog = 1;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index ea83a8a..dc444f0 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -445,7 +445,7 @@ package Errout is
Error_Msg_Qual_Level : Int renames Err_Vars.Error_Msg_Qual_Level;
-- Number of levels of qualification required for type name (see the
- -- description of the } insertion character. Note that this value does
+ -- description of the } insertion character). Note that this value does
-- note get reset by any Error_Msg call, so the caller is responsible
-- for resetting it.
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 2fcd835..974e08e 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -1592,14 +1592,93 @@ package body Freeze is
procedure Check_Current_Instance (Comp_Decl : Node_Id) is
- Rec_Type : constant Entity_Id :=
- Scope (Defining_Identifier (Comp_Decl));
-
- Decl : constant Node_Id := Parent (Rec_Type);
+ function Is_Aliased_View_Of_Type (Typ : Entity_Id) return Boolean;
+ -- Determine whether Typ is compatible with the rules for aliased
+ -- views of types as defined in RM 3.10 in the various dialects.
function Process (N : Node_Id) return Traverse_Result;
-- Process routine to apply check to given node
+ -----------------------------
+ -- Is_Aliased_View_Of_Type --
+ -----------------------------
+
+ function Is_Aliased_View_Of_Type (Typ : Entity_Id) return Boolean is
+ Typ_Decl : constant Node_Id := Parent (Typ);
+
+ begin
+ -- Common case
+
+ if Nkind (Typ_Decl) = N_Full_Type_Declaration
+ and then Limited_Present (Type_Definition (Typ_Decl))
+ then
+ return True;
+
+ -- The following paragraphs describe what a legal aliased view of
+ -- a type is in the various dialects of Ada.
+
+ -- Ada 95
+
+ -- The current instance of a limited type, and a formal parameter
+ -- or generic formal object of a tagged type.
+
+ -- Ada 95 limited type
+ -- * Type with reserved word "limited"
+ -- * A protected or task type
+ -- * A composite type with limited component
+
+ elsif Ada_Version <= Ada_95 then
+ return Is_Limited_Type (Typ);
+
+ -- Ada 2005
+
+ -- The current instance of a limited tagged type, a protected
+ -- type, a task type, or a type that has the reserved word
+ -- "limited" in its full definition ... a formal parameter or
+ -- generic formal object of a tagged type.
+
+ -- Ada 2005 limited type
+ -- * Type with reserved word "limited", "synchronized", "task"
+ -- or "protected"
+ -- * A composite type with limited component
+ -- * A derived type whose parent is a non-interface limited type
+
+ elsif Ada_Version = Ada_2005 then
+ return
+ (Is_Limited_Type (Typ) and then Is_Tagged_Type (Typ))
+ or else
+ (Is_Derived_Type (Typ)
+ and then not Is_Interface (Etype (Typ))
+ and then Is_Limited_Type (Etype (Typ)));
+
+ -- Ada 2012 and beyond
+
+ -- The current instance of an immutably limited type ... a formal
+ -- parameter or generic formal object of a tagged type.
+
+ -- Ada 2012 limited type
+ -- * Type with reserved word "limited", "synchronized", "task"
+ -- or "protected"
+ -- * A composite type with limited component
+ -- * A derived type whose parent is a non-interface limited type
+ -- * An incomplete view
+
+ -- Ada 2012 immutably limited type
+ -- * Explicitly limited record type
+ -- * Record extension with "limited" present
+ -- * Non-formal limited private type that is either tagged
+ -- or has at least one access discriminant with a default
+ -- expression
+ -- * Task type, protected type or synchronized interface
+ -- * Type derived from immutably limited type
+
+ else
+ return
+ Is_Immutably_Limited_Type (Typ)
+ or else Is_Incomplete_Type (Typ);
+ end if;
+ end Is_Aliased_View_Of_Type;
+
-------------
-- Process --
-------------
@@ -1628,24 +1707,15 @@ package body Freeze is
procedure Traverse is new Traverse_Proc (Process);
- -- Start of processing for Check_Current_Instance
-
- begin
- -- In Ada 95, the (imprecise) rule is that the current instance
- -- of a limited type is aliased. In Ada 2005, limitedness must be
- -- explicit: either a tagged type, or a limited record.
+ -- Local variables
- if Is_Limited_Type (Rec_Type)
- and then (Ada_Version < Ada_2005 or else Is_Tagged_Type (Rec_Type))
- then
- return;
+ Rec_Type : constant Entity_Id :=
+ Scope (Defining_Identifier (Comp_Decl));
- elsif Nkind (Decl) = N_Full_Type_Declaration
- and then Limited_Present (Type_Definition (Decl))
- then
- return;
+ -- Start of processing for Check_Current_Instance
- else
+ begin
+ if not Is_Aliased_View_Of_Type (Rec_Type) then
Traverse (Comp_Decl);
end if;
end Check_Current_Instance;
@@ -2158,18 +2228,16 @@ package body Freeze is
(Etype (Comp)))))
then
Set_Has_Controlled_Component (Rec);
- exit;
end if;
if Has_Unchecked_Union (Etype (Comp)) then
Set_Has_Unchecked_Union (Rec);
end if;
- if Has_Per_Object_Constraint (Comp) then
-
- -- Scan component declaration for likely misuses of current
- -- instance, either in a constraint or a default expression.
+ -- Scan component declaration for likely misuses of current
+ -- instance, either in a constraint or a default expression.
+ if Has_Per_Object_Constraint (Comp) then
Check_Current_Instance (Parent (Comp));
end if;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 5c65ab0..4d0514d 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -3339,7 +3339,7 @@ package body Sem_Ch10 is
procedure License_Error is
begin
Error_Msg_N
- ("?license of with'ed unit & may be inconsistent",
+ ("?license of withed unit & may be inconsistent",
Name (Item));
end License_Error;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 8ac54a5..d1e20b6 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -8256,7 +8256,7 @@ package body Sem_Prag is
if Citem = N then
Error_Pragma_Arg
- ("argument of pragma% is not with'ed unit", Arg);
+ ("argument of pragma% is not withed unit", Arg);
end if;
Next (Arg);
@@ -8334,7 +8334,7 @@ package body Sem_Prag is
if Citem = N then
Set_Error_Posted (N);
Error_Pragma_Arg
- ("argument of pragma% is not with'ed unit", Arg);
+ ("argument of pragma% is not withed unit", Arg);
end if;
Next (Arg);
@@ -14203,7 +14203,7 @@ package body Sem_Prag is
if Citem = N then
Error_Pragma_Arg
- ("argument of pragma% is not with'ed unit", Arg_Node);
+ ("argument of pragma% is not withed unit", Arg_Node);
end if;
Next (Arg_Node);
generated by cgit v1.1 at 2025-02-27 19:41:51 +0000