]> gcc.gnu.org Git - gcc.git/commitdiff
[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 5 Dec 2012 11:15:35 +0000 (12:15 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 5 Dec 2012 11:15:35 +0000 (12:15 +0100)
2012-12-05  Thomas Quinot  <quinot@adacore.com>

* par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
get_scos.adb: Generation of SCOs for aspects.

2012-12-05  Thomas Quinot  <quinot@adacore.com>

* sem_prag.adb (Check_Precondition_Postcondition): Remove
redundant call to Set_SCO_Pragma_Enabled (the pragma will be
rewritten into a pragma Check later on, and the call will be
made when processing the rewritten pragma).
(Analyze_Pragma, case Pragma_Check): Omit call to
Set_SCO_Pragma_Enabled if Split_PPC is set.

2012-12-05  Olivier Hainque  <hainque@adacore.com>

* tracebak.c: Add partial support for Lynx178.

2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>

* sem_attr.adb (Analyze_Attribute): Improve
the error message related to loop assertions.

2012-12-05  Gary Dismukes  <dismukes@adacore.com>

* atree.ads: Minor reformatting.

From-SVN: r194211

gcc/ada/ChangeLog
gcc/ada/atree.ads
gcc/ada/get_scos.adb
gcc/ada/par_sco.adb
gcc/ada/put_scos.adb
gcc/ada/put_scos.ads
gcc/ada/scos.ads
gcc/ada/sem_attr.adb
gcc/ada/sem_prag.adb
gcc/ada/tracebak.c

index c0e6d1aa15e61cf545e8dd0ab025c9d967210536..c323d7cf4aa553e70dbd9dc03bae3d592c0b1396 100644 (file)
@@ -1,3 +1,30 @@
+2012-12-05  Thomas Quinot  <quinot@adacore.com>
+
+       * par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
+       get_scos.adb: Generation of SCOs for aspects.
+
+2012-12-05  Thomas Quinot  <quinot@adacore.com>
+
+       * sem_prag.adb (Check_Precondition_Postcondition): Remove
+       redundant call to Set_SCO_Pragma_Enabled (the pragma will be
+       rewritten into a pragma Check later on, and the call will be
+       made when processing the rewritten pragma).
+       (Analyze_Pragma, case Pragma_Check): Omit call to
+       Set_SCO_Pragma_Enabled if Split_PPC is set.
+
+2012-12-05  Olivier Hainque  <hainque@adacore.com>
+
+       * tracebak.c: Add partial support for Lynx178.
+
+2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_attr.adb (Analyze_Attribute): Improve
+       the error message related to loop assertions.
+
+2012-12-05  Gary Dismukes  <dismukes@adacore.com>
+
+       * atree.ads: Minor reformatting.
+
 2012-12-05  Robert Dewar  <dewar@adacore.com>
 
        * atree.ads, par-ch4.adb, sem_attr.adb, sem_ch13.adb: Minor
index e685ead0049aa1f99cafd9a7fd80c8c5db4c16e0..d503dc2a66082446cabec07fa4d9acaa82f769a3 100644 (file)
@@ -107,7 +107,7 @@ package Atree is
 
    --                 Note: the required parentheses surrounding conditional
    --                 and quantified expressions count as a level of parens
-   --                 for this purposes, so e.g. in X := (if A then B else C);
+   --                 for this purpose, so e.g. in X := (if A then B else C);
    --                 Paren_Count for the right side will be 1.
 
    --   Comes_From_Source
index 4fb00102929d29265f4b82edaf0867ceca2e4d86..0020bea086809033bd3181d5d2eef9acac681ed4 100644 (file)
@@ -28,8 +28,8 @@ pragma Ada_2005;
 --  read SCO information from ALI files (Xcov and sco_test). Ada 2005
 --  constructs may therefore be used freely (and are indeed).
 
+with Namet;  use Namet;
 with SCOs;   use SCOs;
-with Snames; use Snames;
 with Types;  use Types;
 
 with Ada.IO_Exceptions; use Ada.IO_Exceptions;
@@ -203,6 +203,8 @@ procedure Get_SCOs is
    N   : Natural;
    --  Scratch buffer, and index into it
 
+   Nam : Name_Id;
+
 --  Start of processing for Get_Scos
 
 begin
@@ -308,7 +310,6 @@ begin
             declare
                Typ : Character;
                Key : Character;
-               Pid : Pragma_Id;
 
             begin
                Key := 'S';
@@ -327,7 +328,7 @@ begin
                --  Loop through items on one line
 
                loop
-                  Pid := Unknown_Pragma;
+                  Nam := No_Name;
                   Typ := Nextc;
 
                   case Typ is
@@ -348,25 +349,16 @@ begin
                         Skipc;
                         if Typ = 'P' or else Typ = 'p' then
                            if Nextc not in '1' .. '9' then
-                              N := 1;
+                              Name_Len := 0;
                               loop
-                                 Buf (N) := Getc;
+                                 Name_Len := Name_Len + 1;
+                                 Name_Buffer (Name_Len) := Getc;
                                  exit when Nextc = ':';
-                                 N := N + 1;
                               end loop;
 
-                              Skipc;
-
-                              begin
-                                 Pid :=
-                                   Pragma_Id'Value ("pragma_" & Buf (1 .. N));
-                              exception
-                                 when Constraint_Error =>
+                              Skipc;  --  Past ':'
 
-                                    --  Pid remains set to Unknown_Pragma
-
-                                    null;
-                              end;
+                              Nam := Name_Find;
                            end if;
                         end if;
                   end case;
@@ -379,13 +371,13 @@ begin
                   end if;
 
                   SCO_Table.Append
-                    ((C1          => Key,
-                      C2          => Typ,
-                      From        => Loc1,
-                      To          => Loc2,
-                      Last        => At_EOL,
-                      Pragma_Sloc => No_Location,
-                      Pragma_Name => Pid));
+                    ((C1                 => Key,
+                      C2                 => Typ,
+                      From               => Loc1,
+                      To                 => Loc2,
+                      Last               => At_EOL,
+                      Pragma_Sloc        => No_Location,
+                      Pragma_Aspect_Name => Nam));
 
                   if Key = '>' then
                      Key := 'S';
@@ -397,8 +389,21 @@ begin
 
          --  Decision entry
 
-         when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
+         when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
             Dtyp := C;
+
+            if C = 'A' then
+               Name_Len := 0;
+               while Nextc /= ' ' loop
+                  Name_Len := Name_Len + 1;
+                  Name_Buffer (Name_Len) := Getc;
+               end loop;
+               Nam := Name_Find;
+
+            else
+               Nam := No_Name;
+            end if;
+
             Skip_Spaces;
 
             --  Output header
@@ -416,12 +421,13 @@ begin
                end if;
 
                SCO_Table.Append
-                 ((C1     => Dtyp,
-                   C2     => ' ',
-                   From   => Loc,
-                   To     => No_Source_Location,
-                   Last   => False,
-                   others => <>));
+                 ((C1                 => Dtyp,
+                   C2                 => ' ',
+                   From               => Loc,
+                   To                 => No_Source_Location,
+                   Last               => False,
+                   Pragma_Aspect_Name => Nam,
+                   others             => <>));
             end;
 
             --  Loop through terms in complex expression
index 2fdd6c5e8e9203adac8579391557bea3d8dd10fb..4ce6951a755212a9a0202402bb57a47930cfce8e 100644 (file)
@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Debug;    use Debug;
 with Errout;   use Errout;
@@ -125,13 +126,13 @@ package body Par_SCO is
    --  Calls above procedure for each element of the list L
 
    procedure Set_Table_Entry
-     (C1          : Character;
-      C2          : Character;
-      From        : Source_Ptr;
-      To          : Source_Ptr;
-      Last        : Boolean;
-      Pragma_Sloc : Source_Ptr := No_Location;
-      Pragma_Name : Pragma_Id  := Unknown_Pragma);
+     (C1                 : Character;
+      C2                 : Character;
+      From               : Source_Ptr;
+      To                 : Source_Ptr;
+      Last               : Boolean;
+      Pragma_Sloc        : Source_Ptr := No_Location;
+      Pragma_Aspect_Name : Name_Id    := No_Name);
    --  Append an entry to SCO_Table with fields set as per arguments
 
    type Dominant_Info is record
@@ -487,15 +488,22 @@ package body Par_SCO is
          Loc : Source_Ptr := No_Location;
          --  Node whose Sloc is used for the decision
 
+         Nam : Name_Id := No_Name;
+         --  For the case of an aspect, aspect name
+
       begin
          case T is
-            when 'I' | 'E' | 'W' =>
+            when 'I' | 'E' | 'W' | 'a' =>
 
-               --  For IF, EXIT, WHILE, the token SLOC can be found from
-               --  the SLOC of the parent of the expression.
+               --  For IF, EXIT, WHILE, or aspects, the token SLOC is that of
+               --  the parent of the expression.
 
                Loc := Sloc (Parent (N));
 
+               if T = 'a' then
+                  Nam := Chars (Identifier (Parent (N)));
+               end if;
+
             when 'G' | 'P' =>
 
                --  For entry guard, the token sloc is from the N_Entry_Body.
@@ -533,12 +541,20 @@ package body Par_SCO is
          end case;
 
          Set_Table_Entry
-           (C1          => T,
-            C2          => ' ',
-            From        => Loc,
-            To          => No_Location,
-            Last        => False,
-            Pragma_Sloc => Pragma_Sloc);
+           (C1                 => T,
+            C2                 => ' ',
+            From               => Loc,
+            To                 => No_Location,
+            Last               => False,
+            Pragma_Sloc        => Pragma_Sloc,
+            Pragma_Aspect_Name => Nam);
+
+         --  For an aspect specification, which will be rewritten into a
+         --  pragma, enter a hash table entry now.
+
+         if T = 'a' then
+            Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last);
+         end if;
       end Output_Header;
 
       ------------------------------
@@ -731,6 +747,8 @@ package body Par_SCO is
       procedure Populate_SCO_Instance_Table is
         new Sinput.Iterate_On_Instances (Record_Instance);
 
+      SCO_Index : Nat;
+
    begin
       if Debug_Flag_Dot_OO then
          dsco;
@@ -796,6 +814,24 @@ package body Par_SCO is
          end;
       end loop;
 
+      --  Stamp out SCO entries for decisions in disabled constructs (pragmas
+      --  or aspects).
+
+      SCO_Index := 1;
+      while SCO_Index <= SCO_Table.Last loop
+         if Is_Decision (SCO_Table.Table (SCO_Index).C1)
+           and then SCO_Pragma_Disabled
+                      (SCO_Table.Table (SCO_Index).Pragma_Sloc)
+         then
+            loop
+               SCO_Table.Table (SCO_Index).C1 := ASCII.NUL;
+               exit when SCO_Table.Table (SCO_Index).Last;
+               SCO_Index := SCO_Index + 1;
+            end loop;
+         end if;
+         SCO_Index := SCO_Index + 1;
+      end loop;
+
       --  Now the tables are all setup for output to the ALI file
 
       Write_SCOs_To_ALI_File;
@@ -824,8 +860,30 @@ package body Par_SCO is
          declare
             T : SCO_Table_Entry renames SCO_Table.Table (Index);
          begin
-            pragma Assert (T.C1 = 'S');
-            return T.C2 = 'p';
+            case T.C1 is
+               when 'S' =>
+                  --  Pragma statement
+
+                  return T.C2 = 'p';
+
+               when 'A' =>
+                  --  Aspect decision (enabled)
+
+                  return False;
+
+               when 'a' =>
+                  --  Aspect decision (not enabled)
+
+                  return True;
+
+               when ASCII.NUL =>
+                  --  Nullified disabled SCO
+
+                  return True;
+
+               when others =>
+                  raise Program_Error;
+            end case;
          end;
 
       else
@@ -976,13 +1034,28 @@ package body Par_SCO is
             T : SCO_Table_Entry renames SCO_Table.Table (Index);
 
          begin
-            --  Called multiple times for the same sloc (need to allow for
-            --  C2 = 'P') ???
+            --  Note: may be called multiple times for the same sloc, so
+            --  account for the fact that the entry may already have been
+            --  marked enabled.
+
+            case T.C1 is
+               --  Aspect (decision SCO)
+
+               when 'a' =>
+                  T.C1 := 'A';
 
-            pragma Assert (T.C1 = 'S'
-                             and then
-                           (T.C2 = 'p' or else T.C2 = 'P'));
-            T.C2 := 'P';
+               when 'A' =>
+                  null;
+
+               --  Pragma (statement SCO)
+
+               when 'S' =>
+                  pragma Assert (T.C2 = 'p' or else T.C2 = 'P');
+                  T.C2 := 'P';
+
+               when others =>
+                  raise Program_Error;
+            end case;
          end;
       end if;
    end Set_SCO_Pragma_Enabled;
@@ -992,23 +1065,23 @@ package body Par_SCO is
    ---------------------
 
    procedure Set_Table_Entry
-     (C1          : Character;
-      C2          : Character;
-      From        : Source_Ptr;
-      To          : Source_Ptr;
-      Last        : Boolean;
-      Pragma_Sloc : Source_Ptr := No_Location;
-      Pragma_Name : Pragma_Id  := Unknown_Pragma)
+     (C1                 : Character;
+      C2                 : Character;
+      From               : Source_Ptr;
+      To                 : Source_Ptr;
+      Last               : Boolean;
+      Pragma_Sloc        : Source_Ptr := No_Location;
+      Pragma_Aspect_Name : Name_Id    := No_Name)
    is
    begin
       SCO_Table.Append
-        ((C1          => C1,
-          C2          => C2,
-          From        => To_Source_Location (From),
-          To          => To_Source_Location (To),
-          Last        => Last,
-          Pragma_Sloc => Pragma_Sloc,
-          Pragma_Name => Pragma_Name));
+        ((C1                 => C1,
+          C2                 => C2,
+          From               => To_Source_Location (From),
+          To                 => To_Source_Location (To),
+          Last               => Last,
+          Pragma_Sloc        => Pragma_Sloc,
+          Pragma_Aspect_Name => Pragma_Aspect_Name));
    end Set_Table_Entry;
 
    ------------------------
@@ -1133,6 +1206,9 @@ package body Par_SCO is
       procedure Traverse_One (N : Node_Id);
       --  Traverse one declaration or statement
 
+      procedure Traverse_Aspects (N : Node_Id);
+      --  Helper for Traverse_One: traverse N's aspect specifications
+
       -------------------------
       -- Set_Statement_Entry --
       -------------------------
@@ -1156,21 +1232,21 @@ package body Par_SCO is
                         To := No_Location;
                      end if;
                      Set_Table_Entry
-                       (C1          => '>',
-                        C2          => Current_Dominant.K,
-                        From        => From,
-                        To          => To,
-                        Last        => False,
-                        Pragma_Sloc => No_Location,
-                        Pragma_Name => Unknown_Pragma);
+                       (C1                 => '>',
+                        C2                 => Current_Dominant.K,
+                        From               => From,
+                        To                 => To,
+                        Last               => False,
+                        Pragma_Sloc        => No_Location,
+                        Pragma_Aspect_Name => No_Name);
                   end;
                end if;
             end if;
 
             declare
-               SCE         : SC_Entry renames SC.Table (J);
-               Pragma_Sloc : Source_Ptr := No_Location;
-               Pragma_Name : Pragma_Id  := Unknown_Pragma;
+               SCE                : SC_Entry renames SC.Table (J);
+               Pragma_Sloc        : Source_Ptr := No_Location;
+               Pragma_Aspect_Name : Name_Id    := No_Name;
             begin
                --  For the case of a statement SCO for a pragma controlled by
                --  Set_SCO_Pragma_Enabled, set Pragma_Sloc so that the SCO (and
@@ -1181,20 +1257,22 @@ package body Par_SCO is
                   Pragma_Sloc := SCE.From;
                   Condition_Pragma_Hash_Table.Set
                     (Pragma_Sloc, SCO_Table.Last + 1);
-                  Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
+                  Pragma_Aspect_Name := Pragma_Name (SCE.N);
+                  pragma Assert (Pragma_Aspect_Name /= No_Name);
 
                elsif SCE.Typ = 'P' then
-                  Pragma_Name := Get_Pragma_Id (Sinfo.Pragma_Name (SCE.N));
+                  Pragma_Aspect_Name := Pragma_Name (SCE.N);
+                  pragma Assert (Pragma_Aspect_Name /= No_Name);
                end if;
 
                Set_Table_Entry
-                 (C1          => 'S',
-                  C2          => SCE.Typ,
-                  From        => SCE.From,
-                  To          => SCE.To,
-                  Last        => (J = SC_Last),
-                  Pragma_Sloc => Pragma_Sloc,
-                  Pragma_Name => Pragma_Name);
+                 (C1                 => 'S',
+                  C2                 => SCE.Typ,
+                  From               => SCE.From,
+                  To                 => SCE.To,
+                  Last               => (J = SC_Last),
+                  Pragma_Sloc        => Pragma_Sloc,
+                  Pragma_Aspect_Name => Pragma_Aspect_Name);
             end;
          end loop;
 
@@ -1293,6 +1371,76 @@ package body Par_SCO is
          SD.Append ((Empty, L, T, Current_Pragma_Sloc));
       end Process_Decisions_Defer;
 
+      ----------------------
+      -- Traverse_Aspects --
+      ----------------------
+
+      procedure Traverse_Aspects (N : Node_Id) is
+         AN : Node_Id;
+         AE : Node_Id;
+
+      begin
+         AN := First (Aspect_Specifications (N));
+         while Present (AN) loop
+            AE := Expression (AN);
+
+            case Get_Aspect_Id (Chars (Identifier (AN))) is
+
+               --  Aspects rewritten into pragmas controlled by a Check_Policy:
+               --  Current_Pragma_Sloc must be set to the sloc of the aspect
+               --  specification. The corresponding pragma will have the same
+               --  sloc.
+
+               when Aspect_Pre               |
+                    Aspect_Precondition      |
+                    Aspect_Post              |
+                    Aspect_Postcondition     =>
+
+                  --  SCOs are generated before semantic analysis/expansion:
+                  --  PPCs are not split yet.
+
+                  pragma Assert (not Split_PPC (AN));
+
+                  --  A Pre/Post aspect will be rewritten into a pragma
+                  --  Precondition/Postcondition with the same sloc.
+
+                  pragma Assert (Current_Pragma_Sloc = No_Location);
+
+                  Current_Pragma_Sloc := Sloc (AN);
+
+                  --  Create the decision as potentially disabled aspect ('a').
+                  --  Set_SCO_Pragma_Enabled will subsequently switch to 'A'.
+
+                  Process_Decisions_Defer (AE, 'a');
+                  Current_Pragma_Sloc := No_Location;
+
+               --  Aspects whose checks are generated in client units,
+               --  regardless of whether or not the check is activated in the
+               --  unit which contains the declaration.
+
+               when Aspect_Predicate         |
+                    Aspect_Static_Predicate  |
+                    Aspect_Dynamic_Predicate |
+                    Aspect_Invariant         |
+                    Aspect_Type_Invariant    =>
+
+                  Process_Decisions_Defer (AE, 'A');
+
+               --  Other aspects: just process any decision nested in the
+               --  aspect expression.
+
+               when others =>
+
+                  if Has_Decision (AE) then
+                     Process_Decisions_Defer (AE, 'X');
+                  end if;
+
+            end case;
+
+            Next (AN);
+         end loop;
+      end Traverse_Aspects;
+
       ------------------
       -- Traverse_One --
       ------------------
@@ -1825,6 +1973,9 @@ package body Par_SCO is
                end if;
          end case;
 
+         --  Process aspects if present
+
+         Traverse_Aspects (N);
       end Traverse_One;
 
    --  Start of processing for Traverse_Declarations_Or_Statements
index 05184d7a985b7cc2ffe985d68bb811403a211f24..e9b03fc8294ff5ecb367d6e6a9f54bf9305186fa 100644 (file)
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Namet;   use Namet;
 with Opt;     use Opt;
-with Par_SCO; use Par_SCO;
 with SCOs;    use SCOs;
-with Snames;  use Snames;
 
 procedure Put_SCOs is
    Current_SCO_Unit : SCO_Unit_Index := 0;
@@ -195,18 +194,10 @@ begin
 
                               if Sent.C1 = 'S'
                                 and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
-                                and then Sent.Pragma_Name /= Unknown_Pragma
+                                and then Sent.Pragma_Aspect_Name /= No_Name
                               then
-                                 --  Strip leading "PRAGMA_"
-
-                                 declare
-                                    Pnam : constant String :=
-                                             Sent.Pragma_Name'Img;
-                                 begin
-                                    Output_String
-                                      (Pnam (Pnam'First + 7 .. Pnam'Last));
-                                    Write_Info_Char (':');
-                                 end;
+                                 Write_Info_Name (Sent.Pragma_Aspect_Name);
+                                 Write_Info_Char (':');
                               end if;
                            end if;
 
@@ -240,57 +231,55 @@ begin
 
                   --  Decision
 
-                  when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
+                  when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
                      Start := Start + 1;
 
-                     --  For disabled pragma, or nested decision therein, skip
-                     --  decision output.
+                     Write_SCO_Initiate (U);
+                     Write_Info_Char (T.C1);
 
-                     if SCO_Pragma_Disabled (T.Pragma_Sloc) then
-                        while not SCO_Table.Table (Start).Last loop
-                           Start := Start + 1;
-                        end loop;
+                     if T.C1 = 'A' then
+                        Write_Info_Name (T.Pragma_Aspect_Name);
+                     end if;
+
+                     if T.C1 /= 'X' then
+                        Write_Info_Char (' ');
+                        Output_Source_Location (T.From);
+                     end if;
 
-                     --  For all other cases output decision line
+                     --  Loop through table entries for this decision
 
-                     else
-                        Write_SCO_Initiate (U);
-                        Write_Info_Char (T.C1);
+                     loop
+                        declare
+                           T : SCO_Table_Entry
+                                 renames SCO_Table.Table (Start);
 
-                        if T.C1 /= 'X' then
+                        begin
                            Write_Info_Char (' ');
-                           Output_Source_Location (T.From);
-                        end if;
 
-                        --  Loop through table entries for this decision
+                           if T.C1 = '!' or else
+                              T.C1 = '&' or else
+                              T.C1 = '|'
+                           then
+                              Write_Info_Char (T.C1);
+                              Output_Source_Location (T.From);
 
-                        loop
-                           declare
-                              T : SCO_Table_Entry
-                                    renames SCO_Table.Table (Start);
+                           else
+                              Write_Info_Char (T.C2);
+                              Output_Range (T);
+                           end if;
 
-                           begin
-                              Write_Info_Char (' ');
+                           exit when T.Last;
+                           Start := Start + 1;
+                        end;
+                     end loop;
 
-                              if T.C1 = '!' or else
-                                 T.C1 = '&' or else
-                                 T.C1 = '|'
-                              then
-                                 Write_Info_Char (T.C1);
-                                 Output_Source_Location (T.From);
+                     Write_Info_Terminate;
 
-                              else
-                                 Write_Info_Char (T.C2);
-                                 Output_Range (T);
-                              end if;
+                  when ASCII.NUL =>
 
-                              exit when T.Last;
-                              Start := Start + 1;
-                           end;
-                        end loop;
+                     --  Nullified entry: skip
 
-                        Write_Info_Terminate;
-                     end if;
+                     null;
 
                   when others =>
                      raise Program_Error;
index d8d77202b7d529ee9aa1421d7e5ca6e2e4df58cf..323e65284588376fe95dc1cdb80b5efb17ea93fb 100644 (file)
@@ -2,11 +2,11 @@
 --                                                                          --
 --                         GNAT COMPILER COMPONENTS                         --
 --                                                                          --
---                             P U T _ S C O S                               --
+--                              P U T _ S C O S                             --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---             Copyright (C) 2009, Free Software Foundation, Inc.           --
+--          Copyright (C) 2009-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- --
@@ -28,6 +28,7 @@
 --  the ALI file. The interface allows control over the destination of the
 --  output, so that this routine can also be used for debugging purposes.
 
+with Namet; use Namet;
 with Types; use Types;
 
 generic
@@ -43,6 +44,9 @@ generic
    --  Initiates write of new line to output file, the parameter is the
    --  keyword character for the line.
 
+   with procedure Write_Info_Name (Nam : Name_Id) is <>;
+   --  Outputs one name
+
    with procedure Write_Info_Nat (N : Nat) is <>;
    --  Writes image of N to output file with no leading or trailing blanks
 
index 076a66ef3c96c164ad03bd21ce8963170ad657f8..0082099afb487be3218ab6901ea21f0c8c7a971b 100644 (file)
 --  the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
 --  is used in the ALI file.
 
-with Snames; use Snames;
---  Note: used for Pragma_Id only, no other feature from Snames should be used,
---  as a simplified version is maintained in Xcov.
-
-with Types;  use Types;
+with Namet; use Namet;
+with Types; use Types;
 
 with GNAT.Table;
 
@@ -248,18 +245,21 @@ package SCOs is
 
    --      C* sloc expression
 
-   --    Here * is one of the following characters:
+   --    Here * is one of the following:
 
-   --      E  decision in EXIT WHEN statement
-   --      G  decision in entry guard
-   --      I  decision in IF statement or if expression
-   --      P  decision in pragma Assert/Check/Pre_Condition/Post_Condition
-   --      W  decision in WHILE iteration scheme
-   --      X  decision appearing in some other expression context
+   --      E       decision in EXIT WHEN statement
+   --      G       decision in entry guard
+   --      I       decision in IF statement or if expression
+   --      P       decision in pragma Assert / Check / Pre/Post_Condition
+   --      A[name] decision in aspect Pre/Post (aspect name optional)
+   --      W       decision in WHILE iteration scheme
+   --      X       decision in some other expression context
 
    --    For E, G, I, P, W, sloc is the source location of the EXIT, ENTRY, IF,
    --    PRAGMA or WHILE token, respectively
 
+   --    For A sloc is the source location of the aspect identifier
+
    --    For X, sloc is omitted
 
    --    The expression is a prefix polish form indicating the structure of
@@ -369,10 +369,12 @@ package SCOs is
       Pragma_Sloc : Source_Ptr := No_Location;
       --  For the statement SCO for a pragma, or for any expression SCO nested
       --  in a pragma Debug/Assert/PPC, location of PRAGMA token (used for
-      --  control of SCO output, value not recorded in ALI file).
+      --  control of SCO output, value not recorded in ALI file). For the
+      --  decision SCO for an aspect, or for any expression SCO nested in an
+      --  aspect, location of aspect identifier token (likewise).
 
-      Pragma_Name : Pragma_Id := Unknown_Pragma;
-      --  For the statement SCO for a pragma, gives the pragma name
+      Pragma_Aspect_Name : Name_Id := No_Name;
+      --  For the SCO for a pragma/aspect, gives the pragma/apsect name
    end record;
 
    package SCO_Table is new GNAT.Table (
@@ -382,6 +384,11 @@ package SCOs is
      Table_Initial        => 500,
      Table_Increment      => 300);
 
+   Is_Decision : constant array (Character) of Boolean :=
+     ('E' | 'G' | 'I' | 'P' | 'A' | 'W' | 'X' => True,
+      others                                  => False);
+   --  Indicates which C1 values correspond to decisions
+
    --  The SCO_Table_Entry values appear as follows:
 
    --    Statements
@@ -432,7 +439,20 @@ package SCOs is
    --    SCO contexts, the only pragmas with decisions are Assert, Check,
    --    dyadic Debug, Precondition and Postcondition). These entries will
    --    be omitted in output if the pragma is disabled (see comments for
-   --    statement entries).
+   --    statement entries). This is achieved by setting C1 to NUL for all
+   --    SCO entries of the decision.
+
+   --    Decision (ASPECT)
+   --      C1   = 'A'
+   --      C2   = ' '
+   --      From = aspect identifier
+   --      To   = No_Source_Location
+   --      Last = unused
+
+   --    Note: when the parse tree is first scanned, we unconditionally build a
+   --    pragma decision entry for any decision in an aspect (Pre/Post/
+   --    [Type_]Invariant/[Static_|Dynamic_]Predicate). Entries for disabled
+   --    Pre/Post aspects will be omitted from output.
 
    --    Decision (Expression)
    --      C1   = 'X'
index 836c278621e7c9c7aa51648d368ca6c9276147fa..94cbd9e730a51867fc706bef8e6630fbb8cba380 100644 (file)
@@ -3847,7 +3847,8 @@ package body Sem_Attr is
 
          if not In_Loop_Assertion then
             Error_Attr
-              ("attribute % must appear within pragma Loop_Assertion", N);
+              ("attribute % must appear within pragma Loop_Variant or " &
+               "Loop_Invariant", N);
          end if;
 
          --  A Loop_Entry that applies to a given loop statement shall not
index ec7f3b95d979cdcadde57753acbef2f815fa2efe..ddd84822ce179f0a15f0ef09dc5266c08a8013d6 100644 (file)
@@ -2181,13 +2181,6 @@ package body Sem_Prag is
               (Get_Pragma_Arg (Arg2), Standard_String);
          end if;
 
-         --  For a pragma in the extended main source unit, record enabled
-         --  status in SCO (note: there is never any SCO for an instance).
-
-         if Check_Enabled (Pname) then
-            Set_SCO_Pragma_Enabled (Loc);
-         end if;
-
          --  If we are within an inlined body, the legality of the pragma
          --  has been checked already.
 
@@ -7407,7 +7400,7 @@ package body Sem_Prag is
 
             Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
 
-            if Check_On then
+            if Check_On and then not Split_PPC (N) then
                Set_SCO_Pragma_Enabled (Loc);
             end if;
 
index 2c8335de68b16e585eed6f2fd7714b1553cb4f5b..01b96548baf9b4dc6409173d0d457510bb5833b4 100644 (file)
@@ -287,9 +287,10 @@ __gnat_backtrace (void **array,
 #error Unhandled darwin architecture.
 #endif
 
-/*------------------------ PPC AIX/Older Darwin -------------------------*/
+/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/
 #elif ((defined (_POWER) && defined (_AIX)) || \
-(defined (__ppc__) && defined (__APPLE__)))
+       (defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \
+       (defined (__ppc__) && defined (__APPLE__)))
 
 #define USE_GENERIC_UNWINDER
 
@@ -307,9 +308,23 @@ struct layout
    should to feature a null backchain, AIX might expose a null return
    address instead.  */
 
+/* Then LynxOS-178 features yet another variation, with return_address
+   == &__start, which we only add conditionally as this symbol is not
+   necessarily present elsewhere.  Beware that &bla returns the
+   address of a descriptor when "bla" is a function.  Getting the code
+   address requires an extra dereference.  */
+
+#if defined (__Lynx__)
+extern void __start();
+#define EXTRA_STOP_CONDITION(CURRENT) ((CURRENT)->return_address == *(void**)&__start)
+#else
+#define EXTRA_STOP_CONDITION(CURRENT) (0)
+#endif
+
 #define STOP_FRAME(CURRENT, TOP_STACK) \
   (((void *) (CURRENT) < (TOP_STACK)) \
-   || (CURRENT)->return_address == NULL)
+   || (CURRENT)->return_address == NULL \
+   || EXTRA_STOP_CONDITION(CURRENT))
 
 /* The PPC ABI has an interesting specificity: the return address saved by a
    function is located in it's caller's frame, and the save operation only
This page took 0.106035 seconds and 5 git commands to generate.