I used [this generator algorithm][1] for DAGs (by Szabolcs):

    {vertices, edges} = {7, 10};
    elems = RandomSample@PadRight[ConstantArray[1, edges], vertices (vertices-1)/2];
    adj = Take[FoldList[RotateLeft, elems, Range[0, vertices-2]], All, 
               vertices]~LowerTriangularize~-1;
    g = AdjacencyGraph[adj, DirectedEdges -> True];
    EdgeList@g

>     {2 -> 1, 3 -> 1, 3 -> 2, 4 -> 1, 4 -> 2, 4 -> 3, 5 -> 1, 5 -> 2, 5 -> 3, 5 -> 4}
    
Removing redundant edges iteratively:

    new = Graph[Flatten[If[GraphDistance[EdgeDelete[g, #], First@#, 
                Last@#] < Infinity, {}, #] & /@ EdgeList@g], 
             VertexLabels -> "Name", ImagePadding -> 10];
    Row@{HighlightGraph[g, new, VertexLabels -> "Name", ImagePadding -> 10], new}

![Mathematica graphics](https://i.sstatic.net/1ULXj.png)

For some graphs, the remaining graph is simply the path graph of the topologically sorted vertices:

    g = Graph[{2->1, 3->1, 3->2, 4->1, 4->2, 4->3, 5->1, 5->2, 5->3, 5->4}];

![Mathematica graphics](https://i.sstatic.net/pnxZ3.png)

Note that this method removes unconnected singletons.

----------
## Adjacency matrix version ##

Here is a version that works directly on adjacency matrices. This should be faster than working on huge `Graph` objects directly.

The `removableQ` function recursively tests if the node `from` has an alternative route to `to` than the direct one, by collecting children nodes. The moment the function finds another edge terminating at `to`, exits from the loop, as it is unnecessary to check further.

    removableQ[m_, {from_, to_}] := Module[{children},
       children = Flatten@Position[m[[from]], 1];
       If[MemberQ[children, to], Throw@to, 
        Do[removableQ[m, {i, to}], {i, children}]; None]
       ];

The wrapper `reduce` iterates through all edges in the matrix:

    reduce[adj_] := Module[{edgeList = Position[adj, 1], rem},
       rem = DeleteCases[{First@#, 
            Catch@removableQ[ReplacePart[adj, # -> 0], #]} & /@ 
          edgeList, {_, None}];
       ReplacePart[adj, Thread[rem -> 0]]
       ];

Let's call `reduce` on a random DAG's adjecency matrix:

    g = DirectedGraph[RandomGraph[{6, 10}], "Acyclic"];
    EdgeList@g

>     {1 -> 3, 1 -> 4, 1 -> 5, 1 -> 6, 2 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 4 -> 6, 5 -> 6}

    adj = Normal@AdjacencyMatrix@g
    new = reduce@adj;
    Row@{g, AdjacencyGraph@new}

![Mathematica graphics](https://i.sstatic.net/vDmFu.png)

Note that this method does not remove unconnected singletons.



  [1]: http://mathematica.stackexchange.com/questions/608/how-to-generate-random-directed-acyclic-graphs