mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-19 22:31:07 +08:00
[multiple changes]
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. From-SVN: r183407
This commit is contained in:
Arnaud Charlet
parent
daecebc805
commit
e1308fa85f
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
-- Local variables
|
||||
|
||||
Rec_Type : constant Entity_Id :=
|
||||
Scope (Defining_Identifier (Comp_Decl));
|
||||
|
||||
-- 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.
|
||||
|
||||
if Is_Limited_Type (Rec_Type)
|
||||
and then (Ada_Version < Ada_2005 or else Is_Tagged_Type (Rec_Type))
|
||||
then
|
||||
return;
|
||||
|
||||
elsif Nkind (Decl) = N_Full_Type_Declaration
|
||||
and then Limited_Present (Type_Definition (Decl))
|
||||
then
|
||||
return;
|
||||
|
||||
else
|
||||
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;
|
||||
|
||||
-- Scan component declaration for likely misuses of current
|
||||
-- instance, either in a constraint or a default expression.
|
||||
|
||||
if Has_Per_Object_Constraint (Comp) then
|
||||
|
||||
-- Scan component declaration for likely misuses of current
|
||||
-- instance, either in a constraint or a default expression.
|
||||
|
||||
Check_Current_Instance (Parent (Comp));
|
||||
end if;
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user