Commit b7539c3b by Arnaud Charlet

[multiple changes]

2011-10-14  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Check_Premature_Freezing): If an untagged type
	is a generic actual, it is a subtype of a type that was frozen
	by the instantiation, and even if not marked frozen it does not
	affect the construction of the dispatch table.

2011-10-14  Robert Dewar  <dewar@adacore.com>

	* make.adb, mlib-utl.adb, sem_util.adb, sem_ch4.adb: Minor code
	reformatting.
	* s-rident.ads: Add missing Compiler_Unit pragma.

From-SVN: r179989
parent 85ff2938
2011-10-14 Ed Schonberg <schonberg@adacore.com>
* exp_disp.adb (Check_Premature_Freezing): If an untagged type
is a generic actual, it is a subtype of a type that was frozen
by the instantiation, and even if not marked frozen it does not
affect the construction of the dispatch table.
2011-10-14 Robert Dewar <dewar@adacore.com>
* make.adb, mlib-utl.adb, sem_util.adb, sem_ch4.adb: Minor code
reformatting.
* s-rident.ads: Add missing Compiler_Unit pragma.
2011-10-14 Gary Dismukes <dismukes@adacore.com>
* sem_res.adb: Minor reformatting.
......
......@@ -3771,12 +3771,16 @@ package body Exp_Disp is
-- Start of processing for Check_Premature_Freezing
begin
-- Note that if the type is a (subtype of) a generic actual, the
-- actual will have been frozen by the instantiation.
if Present (N)
and then Is_Private_Type (Typ)
and then No (Full_View (Typ))
and then not Is_Generic_Type (Typ)
and then not Is_Tagged_Type (Typ)
and then not Is_Frozen (Typ)
and then not Is_Generic_Actual_Type (Typ)
then
Error_Msg_Sloc := Sloc (Subp);
Error_Msg_NE
......
......@@ -4603,7 +4603,7 @@ package body Make is
procedure Library_Phase
(Stand_Alone_Libraries : in out Boolean;
Library_Rebuilt : in out Boolean)
Library_Rebuilt : in out Boolean)
is
Depth : Natural;
Current : Natural;
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2010, AdaCore --
-- Copyright (C) 2002-2011, AdaCore --
-- --
-- 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- --
......@@ -553,8 +553,7 @@ package body MLib.Utl is
Write_RF (Opening'Address, 1);
end if;
Write_RF
(Objects (J).all'Address, Objects (J).all'Length);
Write_RF (Objects (J).all'Address, Objects (J).all'Length);
-- Closing quote for GNU linker
......
......@@ -41,6 +41,8 @@
-- so we can do the instantiation under control of Discard_Names to remove
-- the tables.
pragma Compiler_Unit;
generic
package System.Rident is
pragma Preelaborate;
......
......@@ -3114,63 +3114,61 @@ package body Sem_Ch4 is
if Present (Next_Actual (Act2)) then
return;
end if;
elsif Op_Name = Name_Op_Add
or else Op_Name = Name_Op_Subtract
or else Op_Name = Name_Op_Multiply
or else Op_Name = Name_Op_Divide
or else Op_Name = Name_Op_Mod
or else Op_Name = Name_Op_Rem
or else Op_Name = Name_Op_Expon
then
Find_Arithmetic_Types (Act1, Act2, Op_Id, N);
-- Otherwise action depends on operator
elsif Op_Name = Name_Op_And
or else Op_Name = Name_Op_Or
or else Op_Name = Name_Op_Xor
then
Find_Boolean_Types (Act1, Act2, Op_Id, N);
case Op_Name is
when Name_Op_Add |
Name_Op_Subtract |
Name_Op_Multiply |
Name_Op_Divide |
Name_Op_Mod |
Name_Op_Rem |
Name_Op_Expon =>
Find_Arithmetic_Types (Act1, Act2, Op_Id, N);
elsif Op_Name = Name_Op_Lt
or else Op_Name = Name_Op_Le
or else Op_Name = Name_Op_Gt
or else Op_Name = Name_Op_Ge
then
Find_Comparison_Types (Act1, Act2, Op_Id, N);
when Name_Op_And |
Name_Op_Or |
Name_Op_Xor =>
Find_Boolean_Types (Act1, Act2, Op_Id, N);
elsif Op_Name = Name_Op_Eq
or else Op_Name = Name_Op_Ne
then
Find_Equality_Types (Act1, Act2, Op_Id, N);
when Name_Op_Lt |
Name_Op_Le |
Name_Op_Gt |
Name_Op_Ge =>
Find_Comparison_Types (Act1, Act2, Op_Id, N);
elsif Op_Name = Name_Op_Concat then
Find_Concatenation_Types (Act1, Act2, Op_Id, N);
when Name_Op_Eq |
Name_Op_Ne =>
Find_Equality_Types (Act1, Act2, Op_Id, N);
-- Is this else null correct, or should it be an abort???
when Name_Op_Concat =>
Find_Concatenation_Types (Act1, Act2, Op_Id, N);
else
null;
end if;
-- Is this when others, or should it be an abort???
when others =>
null;
end case;
-- Unary operator case
else
if Op_Name = Name_Op_Subtract
or else Op_Name = Name_Op_Add
or else Op_Name = Name_Op_Abs
then
Find_Unary_Types (Act1, Op_Id, N);
case Op_Name is
when Name_Op_Subtract |
Name_Op_Add |
Name_Op_Abs =>
Find_Unary_Types (Act1, Op_Id, N);
elsif
Op_Name = Name_Op_Not
then
Find_Negation_Types (Act1, Op_Id, N);
when Name_Op_Not =>
Find_Negation_Types (Act1, Op_Id, N);
-- Is this else null correct, or should it be an abort???
-- Is this when others correct, or should it be an abort???
else
null;
end if;
when others =>
null;
end case;
end if;
end Analyze_Operator_Call;
......
......@@ -3910,8 +3910,8 @@ package body Sem_Util is
end if;
end loop;
-- This loop checks the form of the prefix for an entity,
-- using recursion to deal with intermediate components.
-- This loop checks the form of the prefix for an entity, using
-- recursion to deal with intermediate components.
loop
-- Check for Y where Y is an entity
......@@ -3925,7 +3925,6 @@ package body Sem_Util is
elsif
Nkind_In (Expr, N_Selected_Component, N_Indexed_Component)
then
Expr := Prefix (Expr);
Off := True;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment